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