gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Sun Jul 28 10:58:27 EDT 2019
Updated via https://github.com/Gnucash/gnucash/commit/5de4b27b (commit)
via https://github.com/Gnucash/gnucash/commit/8cd7c6f7 (commit)
via https://github.com/Gnucash/gnucash/commit/32692721 (commit)
via https://github.com/Gnucash/gnucash/commit/c81e9354 (commit)
via https://github.com/Gnucash/gnucash/commit/955a5651 (commit)
via https://github.com/Gnucash/gnucash/commit/e506b7c3 (commit)
from https://github.com/Gnucash/gnucash/commit/e3a695d0 (commit)
commit 5de4b27b2510d0ec8fcc859adf172018fdc89c1e
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jul 28 14:37:19 2019 +0800
[balsheet-eg] dedupe functions
diff --git a/gnucash/report/business-reports/balsheet-eg.scm b/gnucash/report/business-reports/balsheet-eg.scm
index d1b5cf2ae..ccec8c5ae 100644
--- a/gnucash/report/business-reports/balsheet-eg.scm
+++ b/gnucash/report/business-reports/balsheet-eg.scm
@@ -37,8 +37,8 @@
(use-modules (gnucash gettext))
(use-modules (gnucash report eguile-gnc))
(use-modules (gnucash report eguile-utilities))
+(use-modules (gnucash report eguile-html-utilities))
-(use-modules (ice-9 regex)) ; for regular expressions
(use-modules (ice-9 local-eval)) ; for the-environment
(use-modules (srfi srfi-13)) ; for extra string functions
@@ -47,38 +47,6 @@
(define debugging? #f)
-;;; these could go into a separate module..........
-;;;
-;; Useful routines to use in the template
-(define (escape-html s1)
- ;; convert string s1 to escape HTML special characters < > and &
- ;; i.e. convert them to < > and & respectively.
- ;; Maybe there's a way to do this in one go... (but order is important)
- (set! s1 (regexp-substitute/global #f "&" s1 'pre "&" 'post))
- (set! s1 (regexp-substitute/global #f "<" s1 'pre "<" 'post))
- (regexp-substitute/global #f ">" s1 'pre ">" 'post))
-
-(define (nl->br str)
- ;; replace newlines with <br>
- (regexp-substitute/global #f "\n" str 'pre "<br />" 'post))
-
-(define (nbsp str)
- ;; replace spaces with (non-breaking spaces)
- ;; (yes, I know <nobr> is non-standard, but webkit splits e.g. "-£40.00" between
- ;; the '-' and the '£' without it.)
- (string-append "<nobr>" (regexp-substitute/global #f " " str 'pre " " 'post) "</nobr>"))
-
-(define (dump x) (escape-html (object->string x)))
-(define (ddump x) (display (dump x)))
-
-(define (string-repeat s n)
- ;; return a string made of n copies of string s
- ;; (there's probably a better way)
- (let ((s2 ""))
- (do ((i 1 (1+ i))) ((> i n))
- (set! s2 (string-append s2 s)))
- s2))
-
(define (debug . args)
(if debugging?
(for arg in args do
@@ -92,28 +60,6 @@
(display cols)
(display "\"> </td></tr>\n"))
-(define (empty-cells n)
- ;; Display n empty table cells
- (display (string-repeat "<td class=\"empty\"></td>" n)))
-
-(define (indent-cells n)
- ;; Display n empty table cells with width attribute for indenting
- ;; (the s are just there in case CSS isn't working)
- (display (string-repeat "<td min-width=\"32\" class=\"indent\"> </td>" n)))
-
-;; 'Safe' versions of cdr and cadr that don't crash
-;; if the list is empty (is there a better way?)
-(define (safe-cdr l)
- (if (null? l)
- '()
- (cdr l)))
-(define (safe-cadr l)
- (if (null? l)
- '()
- (if (null? (cdr l))
- '()
- (cadr l))))
-
(define (add-to-cc cc com num neg?)
; add a numeric and commodity to a commodity-collector,
; changing sign if required
commit 8cd7c6f7556c62c561c2b13820206811a5ddc0f7
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jul 28 22:13:38 2019 +0800
[taxinvoice-eg] fix html
<nobr> has never been standard. Don't need it because (nbsp ...) will
insert <span white-space=nowrap> tags.
diff --git a/gnucash/report/business-reports/taxinvoice.eguile.scm b/gnucash/report/business-reports/taxinvoice.eguile.scm
index ed82b336c..9a8036273 100644
--- a/gnucash/report/business-reports/taxinvoice.eguile.scm
+++ b/gnucash/report/business-reports/taxinvoice.eguile.scm
@@ -341,7 +341,7 @@
?>
<tr valign="top">
<?scm (if opt-col-date (begin ?>
- <td align="center" ><nobr><?scm:d (nbsp (qof-print-date (gncEntryGetDate entry))) ?></nobr></td>
+ <td align="center" ><?scm:d (nbsp (qof-print-date (gncEntryGetDate entry))) ?></td>
<?scm )) ?>
<td align="left"><?scm:d (gncEntryGetDescription entry) ?></td>
<!-- td align="left">< ?scm:d (gncEntryGetNotes entry) ?></td -->
commit 326927215c8481f5b9024e1ec9fe121c2bff7d0f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jul 28 14:36:22 2019 +0800
[eguile-html-utilities] dedupe, fix html
* prefer srfi-13 over regex
* instead of <nobr> use <span style="white-space:nowrap">
* reuse functions defined in eguile-gnc and eguile-utilities
* compact functions
* move make-regexp toplevel to ensure one compilation
diff --git a/gnucash/report/report-system/eguile-html-utilities.scm b/gnucash/report/report-system/eguile-html-utilities.scm
index 8a7030bab..d123f6109 100644
--- a/gnucash/report/report-system/eguile-html-utilities.scm
+++ b/gnucash/report/report-system/eguile-html-utilities.scm
@@ -32,29 +32,24 @@
(gnc:module-load "gnucash/report/report-system" 0)
(gnc:module-load "gnucash/app-utils" 0)
+(use-modules (gnucash report eguile-gnc))
(use-modules (ice-9 regex)) ; for regular expressions
(use-modules (srfi srfi-13)) ; for extra string functions
-(define-public (escape-html s1)
- ;; Convert string s1 to escape HTML special characters < > and &
- ;; i.e. convert them to < > and & respectively.
- ;; Maybe there's a way to do this in one go... (but order is important)
- (set! s1 (regexp-substitute/global #f "&" s1 'pre "&" 'post))
- (set! s1 (regexp-substitute/global #f "<" s1 'pre "<" 'post))
- (regexp-substitute/global #f ">" s1 'pre ">" 'post))
+(define (string-repeat s n)
+ ;; return a string made of n copies of string s
+ (string-join (make-list n s) ""))
(define-public (nl->br str)
;; Replace newlines with <br>
- (regexp-substitute/global #f "\n" str 'pre "<br>" 'post))
+ (string-substitute-alist str '((#\newline . "<br/>"))))
(define-public (nbsp str)
;; Replace spaces with (non-breaking spaces)
- ;; (yes, I know <nobr> is non-standard, but webkit splits e.g. "-£40.00" between
- ;; the '-' and the '£' without it.)
- (string-append
- "<nobr>"
- (regexp-substitute/global #f " " str 'pre " " 'post)
- "</nobr>"))
+ (string-append
+ "<span style=\"white-space:nowrap;\">"
+ (string-substitute-alist str '((#\space . " ")))
+ "</span>"))
(define-public (empty-cells n)
;; Display n empty table cells
@@ -63,7 +58,8 @@
(define-public (indent-cells n)
;; Display n empty table cells with width attribute for indenting
;; (the s are just there in case CSS isn't working)
- (display (string-repeat "<td min-width=\"32\" class=\"indent\"> </td>" n)))
+ (display
+ (string-repeat "<td min-width=\"32\" class=\"indent\"> </td>" n)))
(define-public (negstyle item)
;; apply styling for negative amounts
@@ -86,9 +82,13 @@
(define-public (display-comm-coll-total comm-coll negative?)
;; Display the total(s) of a commodity collector as HTML
(for-each
- (lambda (pair)
- (display (nbsp (gnc:monetary->string pair))))
- (comm-coll 'format gnc:make-gnc-monetary negative?)))
+ (lambda (pair)
+ (display (nbsp (gnc:monetary->string pair))))
+ (comm-coll 'format gnc:make-gnc-monetary negative?)))
+
+;; (thanks to Peter Brett for this regexp and the use of match:prefix)
+(define fontre
+ (make-regexp "([[:space:]]+(bold|semi-bold|book|regular|medium|light))?([[:space:]]+(normal|roman|italic|oblique))?([[:space:]]+(condensed))?[[:space:]]+([[:digit:]]+)" regexp/icase))
(define-public (font-name-to-style-info font-name)
;;; Convert a font name as return by a font option to CSS format.
@@ -98,31 +98,28 @@
(font-weight "normal")
(font-style "normal")
(font-size "medium")
- (match "")
- ; (thanks to Peter Brett for this regexp and the use of match:prefix)
- (fontre (make-regexp "([[:space:]]+(bold|semi-bold|book|regular|medium|light))?([[:space:]]+(normal|roman|italic|oblique))?([[:space:]]+(condensed))?[[:space:]]+([[:digit:]]+)" regexp/icase))
(match (regexp-exec fontre font-name)))
- (if match
- (begin
- ; font name parsed OK -- assemble the bits for CSS
- (set! font-family (match:prefix match))
- (if (match:substring match 2)
- ; weight given -- some need translating
+ (when match
+ ;; font name parsed OK -- assemble the bits for CSS
+ (set! font-family (match:prefix match))
+ (if (match:substring match 2)
+ ;; weight given -- some need translating
(let ((weight (match:substring match 2)))
(cond
- ((string-ci=? weight "bold") (set! font-weight "bold"))
- ((string-ci=? weight "semi-bold") (set! font-weight "600"))
- ((string-ci=? weight "light") (set! font-weight "200")))))
- (if (match:substring match 4)
- ; style
+ ((string-ci=? weight "bold") (set! font-weight "bold"))
+ ((string-ci=? weight "semi-bold") (set! font-weight "600"))
+ ((string-ci=? weight "light") (set! font-weight "200")))))
+ (if (match:substring match 4)
+ ;; style
(let ((style (match:substring match 4)))
(cond
- ((string-ci=? style "italic") (set! font-style "italic"))
- ((string-ci=? style "oblique") (set! font-style "oblique")))))
- ; ('condensed' is ignored)
- (if (match:substring match 7)
- ; size is in points
- (set! font-size (string-append (match:substring match 7) "pt")))))
- ; construct the result (the order of these is important)
- (string-append "font: " font-weight " " font-style " " font-size " \"" font-family "\";")))
+ ((string-ci=? style "italic") (set! font-style "italic"))
+ ((string-ci=? style "oblique") (set! font-style "oblique")))))
+ ;; ('condensed' is ignored)
+ (if (match:substring match 7)
+ ;; size is in points
+ (set! font-size (string-append (match:substring match 7) "pt"))))
+ ;; construct the result (the order of these is important)
+ (string-append "font: " font-weight " " font-style
+ " " font-size " \"" font-family "\";")))
commit c81e9354f742ed9bd5b5d2035e0feae6e6642ebe
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jul 28 14:30:58 2019 +0800
[eguile-gnc] fix whitespace
diff --git a/gnucash/report/report-system/eguile-gnc.scm b/gnucash/report/report-system/eguile-gnc.scm
index 977a4cce7..1731ca6ae 100644
--- a/gnucash/report/report-system/eguile-gnc.scm
+++ b/gnucash/report/report-system/eguile-gnc.scm
@@ -134,44 +134,40 @@
;; display either code or text
(define (display-it t code?)
(if code?
- (display t)
- (display-text t)))
+ (display t)
+ (display-text t)))
(define stop textstop) ; text to output at end of current section
;; switch between code and text modes
(define (switch-mode code? dmodifier?)
(display stop)
- (if code?
- (begin ; code mode to text mode
- (display textstart)
- (set! stop textstop))
- (begin ; text mode to code mode
- (if dmodifier?
- (begin
- (display dcodestart)
- (set! stop dcodestop))
- (begin
- (display codestart)
- (set! stop codestop))))))
+ (cond
+ (code? (display textstart)
+ (set! stop textstop))
+ (dmodifier? (display dcodestart)
+ (set! stop dcodestop))
+ (else (display codestart)
+ (set! stop codestop))))
;; recursively process input stream
(define (loop inp needle other code? line)
- (if (equal? line "")
+ (when (string-null? line)
(set! line (read-line inp 'concat)))
- (if (not (eof-object? line))
- (let ((match (regexp-exec needle line)))
- (if match
- (let ((dmodifier? #f))
- (display-it (match:prefix match) code?)
- (if (not code?)
- ; switching from text to code -- check for modifier
- (set! dmodifier? (match:substring match 1)))
- (switch-mode code? dmodifier?)
- (loop inp other needle (not code?) (match:suffix match)))
- (begin ; no match - output whole line and continue
- (display-it line code?)
- (loop inp needle other code? ""))))))
+ (unless (eof-object? line)
+ (cond
+ ((regexp-exec needle line)
+ => (lambda (rmatch)
+ (let ((dmodifier? #f))
+ (display-it (match:prefix rmatch) code?)
+ (unless code?
+ ;; switching from text to code -- check for modifier
+ (set! dmodifier? (match:substring rmatch 1)))
+ (switch-mode code? dmodifier?)
+ (loop inp other needle (not code?) (match:suffix rmatch)))))
+ (else ; no match - output whole line and continue
+ (display-it line code?)
+ (loop inp needle other code? "")))))
(display textstart)
(loop (current-input-port) startre endre #f "")
@@ -182,7 +178,7 @@
;; Evaluate input containing Scheme code, trapping errors
;; e.g. (display "Text ")(display (+ x 2))(display ".") -> Text 42.
;; Parameters:
-;; env - environment in which to do the evaluation;
+;; env - environment in which to do the evaluation;
;; if #f, (the-environment) will be used
(define (script->output env)
; Placeholder for the normal stack and error stack in case of an error
@@ -195,7 +191,7 @@
; Capture the current stack, so we can detect from where we
; need to display the stack trace
(set! good-stack (make-stack #t))
- (local-eval s-expression (or env (the-environment)))
+ (local-eval s-expression (or env (the-environment)))
(set! s-expression (read)))))
; Error handler to display any errors while evaluating the template
@@ -221,7 +217,10 @@
(error-length (stack-length error-stack)))
; Show the backtrace. Remove one extra from the "first"
; argument, since that is an index, not a count.
- (display-backtrace error-stack (current-output-port) (- (- error-length remove-top) 1) (- (- error-length remove-top) remove-bottom)))
+ (display-backtrace error-stack
+ (current-output-port)
+ (- (- error-length remove-top) 1)
+ (- (- error-length remove-top) remove-bottom)))
(display "</pre><br>"))
; This handler will be called by catch before unwinding the
@@ -249,15 +248,18 @@
;; Process a template file and return the result as a string
(define (eguile-file-to-string infile environment)
- (if (not (access? infile R_OK))
- (format #f (_ "Template file \"~a\" can not be read") infile)
- (let ((script (with-input-from-file
- infile
- (lambda () (with-output-to-string template->script)))))
+ (cond
+ ((not (access? infile R_OK))
+ (format #f (_ "Template file \"~a\" can not be read") infile))
+ (else
+ (let ((script (with-input-from-file infile
+ (lambda ()
+ (with-output-to-string template->script)))))
(with-output-to-string
- (lambda () (with-input-from-string
- script
- (lambda () (script->output environment))))))))
+ (lambda ()
+ (with-input-from-string script
+ (lambda ()
+ (script->output environment)))))))))
(export eguile-file-to-string)
commit 955a5651d8b18db4b096fbec0f98a891959d4c3e
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jul 28 14:30:30 2019 +0800
[eguile-gnc] use string-for-each instead of regex
diff --git a/gnucash/report/report-system/eguile-gnc.scm b/gnucash/report/report-system/eguile-gnc.scm
index 9a9e130c8..977a4cce7 100644
--- a/gnucash/report/report-system/eguile-gnc.scm
+++ b/gnucash/report/report-system/eguile-gnc.scm
@@ -88,17 +88,24 @@
(use-modules (ice-9 local-eval)) ; for the-environment
(use-modules (gnucash app-utils)) ; for _
+(define-public (string-substitute-alist str sub-alist)
+ (with-output-to-string
+ (lambda ()
+ (string-for-each
+ (lambda (c)
+ (display
+ (or (assv-ref sub-alist c)
+ c)))
+ str))))
+
;; This is needed for displaying error messages -- note that it assumes that
;; the output is HTML, which is a pity, because otherwise this module is
;; non-specific -- it is designed to output a mixture of Guile and any other
;; sort of text. Oh well.
-(define (escape-html s1)
- ;; convert string s1 to escape HTML special characters < > and &
- ;; i.e. convert them to < > and & respectively.
- ;; Maybe there's a way to do this in one go... (but order is important)
- (set! s1 (regexp-substitute/global #f "&" s1 'pre "&" 'post))
- (set! s1 (regexp-substitute/global #f "<" s1 'pre "<" 'post))
- (regexp-substitute/global #f ">" s1 'pre ">" 'post))
+(define-public (escape-html s1)
+ (string-substitute-alist s1 '((#\< . "<")
+ (#\> . ">")
+ (#\& . "&"))))
;; regexps used to find start and end of code segments
(define startre (make-regexp "<\\?scm(:d)?[[:space:]]"))
commit e506b7c3325f09e84c1e5d9519e551cc49943535
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jul 28 13:36:22 2019 +0800
[eguile-utilities] compact functions
* whitespace
* move string-repeat to eguile-html-utilities where it's used
diff --git a/gnucash/report/report-system/eguile-utilities.scm b/gnucash/report/report-system/eguile-utilities.scm
index 25a91d860..0e536212f 100644
--- a/gnucash/report/report-system/eguile-utilities.scm
+++ b/gnucash/report/report-system/eguile-utilities.scm
@@ -33,7 +33,6 @@
(gnc:module-load "gnucash/report/report-system" 0)
(gnc:module-load "gnucash/app-utils" 0)
-
(define-public (fmtnumber n)
;; Format a number (integer or real) into something printable
(number->string (if (integer? n)
@@ -46,28 +45,18 @@
(define-public (gnc-monetary-neg? monetary)
; return true if the monetary value is negative
- (gnc-numeric-negative-p (gnc:gnc-monetary-amount monetary)))
-
-(define-public (string-repeat s n)
- ;; return a string made of n copies of string s
- ;; (there's probably a better way)
- (let ((s2 ""))
- (do ((i 1 (1+ i))) ((> i n))
- (set! s2 (string-append s2 s)))
- s2))
+ (negative? (gnc:gnc-monetary-amount monetary)))
;; 'Safe' versions of cdr and cadr that don't crash
;; if the list is empty (is there a better way?)
(define-public (safe-cdr l)
- (if (null? l)
- '()
- (cdr l)))
+ (if (null? l) '()
+ (cdr l)))
(define-public (safe-cadr l)
- (if (null? l)
- '()
- (if (null? (cdr l))
- '()
- (cadr l))))
+ (cond
+ ((null? l) '())
+ ((null? (cdr l)) '())
+ (else (cadr l))))
(define-public (find-file fname)
;; Find the file 'fname', and return its full path.
@@ -75,40 +64,27 @@
;; Then look in Gnucash's standard report directory.
;; If no file is found, returns just 'fname' for use in error messages.
;; Note: this has been tested on Linux and Windows Vista so far...
- (let* ((userpath (gnc-build-userdata-path fname))
- (syspath (gnc-build-report-path fname)))
- ; make sure there's a trailing delimiter
- (if (access? userpath R_OK)
- userpath
- (if (access? syspath R_OK)
- syspath
- fname))))
+ (let ((userpath (gnc-build-userdata-path fname))
+ (syspath (gnc-build-report-path fname)))
+ ;; make sure there's a trailing delimiter
+ (cond
+ ((access? userpath R_OK) userpath)
+ ((access? syspath R_OK) syspath)
+ (else fname))))
; Define syntax for more readable for loops (the built-in for-each requires an
; explicit lambda and has the list expression all the way at the end).
-(define-syntax for
- (syntax-rules (for in => do hash)
- ; Multiple variables and equal number of lists (in
- ; parenthesis). e.g.:
- ;
- ; (for (a b) in (lsta lstb) do (display (+ a b)))
- ;
- ; Note that this template must be defined before the
- ; next one, since the template are evaluated in-order.
- ((for (<var> ...) in (<list> ...) do <expr> ...)
- (for-each (lambda (<var> ...) <expr> ...) <list> ...))
- ; Single variable and list. e.g.:
- ;
- ; (for a in lst do (display a))
- ((for <var> in <list> do <expr> ...)
- (for-each (lambda (<var>) <expr> ...) <list>))
- ; Iterate over key & values in a hash. e.g.:
- ;
- ; (for key => value in hash do (display (* key value)))
- ((for <key> => <value> in <hash> do <expr> ...)
- ; We use fold to iterate over the hash (instead of
- ; hash-for-each, since that is not present in guile
- ; 1.6).
- (hash-fold (lambda (<key> <value> accum) (begin <expr> ... accum)) *unspecified* <hash>))
- ))
(export for)
+(define-syntax for
+ (syntax-rules (for in do)
+ ;; Multiple variables and equal number of lists (in
+ ;; parenthesis). e.g.:
+ ;; (for (a b) in (lsta lstb) do (display (+ a b)))
+ ;; Note that this template must be defined before the
+ ;; next one, since the template are evaluated in-order.
+ ((for (<var> ...) in (<list> ...) do <expr> ...)
+ (for-each (lambda (<var> ...) <expr> ...) <list> ...))
+
+ ;; Single variable and list. e.g.: (for a in lst do (display a))
+ ((for <var> in <list> do <expr> ...)
+ (for-each (lambda (<var>) <expr> ...) <list>))))
Summary of changes:
gnucash/report/business-reports/balsheet-eg.scm | 56 +-----------
.../report/business-reports/taxinvoice.eguile.scm | 2 +-
gnucash/report/report-system/eguile-gnc.scm | 101 +++++++++++----------
.../report/report-system/eguile-html-utilities.scm | 77 ++++++++--------
gnucash/report/report-system/eguile-utilities.scm | 78 ++++++----------
5 files changed, 121 insertions(+), 193 deletions(-)
More information about the gnucash-changes
mailing list