gnucash master: Multiple changes pushed

Christopher Lam clam at code.gnucash.org
Sat Jun 13 11:51:59 EDT 2020


Updated	 via  https://github.com/Gnucash/gnucash/commit/1bcffcd8 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/a107382b (commit)
	 via  https://github.com/Gnucash/gnucash/commit/0a15909d (commit)
	 via  https://github.com/Gnucash/gnucash/commit/28df0c09 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/2eb98146 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/38060b02 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/78018d8f (commit)
	from  https://github.com/Gnucash/gnucash/commit/51d00fcb (commit)



commit 1bcffcd88d575782b1e06eeada1efaa980076e92
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sat Jun 13 23:50:26 2020 +0800

    [html-utilities] gnc:html-render-options-changed shows subreports
    
    This is useful for cli to show Multicolumn report with subreports.
    e.g.
    
    * guid: 2f17ecb535f24a3a9f314bc5855569e5
    General / Number of columns: 2.0
    General / Report name: A saved-report based on nmulticolumn-view
    General / Stylesheet: Easy
    Embedded Report: Welcome to GnuCash
    Embedded Report: Balance Sheet
    
    * guid: d8ba4a2e89e8479ca9f6eccdeb164588

diff --git a/gnucash/report/html-utilities.scm b/gnucash/report/html-utilities.scm
index 1822c3598..f413dccf2 100644
--- a/gnucash/report/html-utilities.scm
+++ b/gnucash/report/html-utilities.scm
@@ -270,7 +270,9 @@
         (try xaccAccountGetName)
         (try gnc-budget-get-name)
         (format #f "~a" d)))
-  (let ((render-list '()))
+  (let ((render-list '())
+        (report-list (gnc:option-value
+                      (gnc:lookup-option options "__general" "report-list"))))
     (define (add-option-if-changed option)
       (let* ((section (gnc:option-section option))
              (name (gnc:option-name option))
@@ -281,6 +283,11 @@
         (if (not (or (equal? default-value value)
                      (char=? (string-ref section 0) #\_)))
             (addto! render-list retval))))
+    (for-each
+     (lambda (child)
+       (let ((report (gnc-report-find (car child))))
+         (addto! render-list (cons "Embedded Report" (gnc:report-name report)))))
+     (or report-list '()))
     (gnc:options-for-each add-option-if-changed options)
     (if plaintext?
         (string-append

commit a107382bd738bb0be0ffd090b920dc5376c16905
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sat Jun 13 22:45:56 2020 +0800

    [eguile] compact eguile processor
    
    eradicate set! calls, inline strings, neater code. also fix
    missing-regex message.

diff --git a/gnucash/report/eguile.scm b/gnucash/report/eguile.scm
index 828bcefcb..0649bce6d 100644
--- a/gnucash/report/eguile.scm
+++ b/gnucash/report/eguile.scm
@@ -103,14 +103,6 @@
 (define startre (and (defined? 'make-regexp) (make-regexp "<\\?scm(:d)?[[:space:]]")))
 (define endre   (and (defined? 'make-regexp) (make-regexp "(^|[[:space:]])\\?>")))
 
-;; Guile code to mark starting and stopping text or code modes
-(define textstart  "(display \"")
-(define textstop   "\")")
-(define codestart  "")
-(define codestop   "")
-(define dcodestart "(display ")
-(define dcodestop  ")")
-
 ;; Parse a template, and return a sequence of s-expressions
 ;; e.g. "Text <?scm:d (+ x 2) ?>." -> (display "Text ")(display (+ x 2))(display ".")
 (define (template->script)
@@ -129,43 +121,28 @@
         (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)
-    (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)
-    (when (string-null? line)
-      (set! line (read-line inp 'concat)))
-    (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)
+  (define (loop inp needle other code? line stop)
+    (cond
+     ((eof-object? line) (display stop))
+     ((string-null? line) (loop inp needle other code? (read-line inp 'concat) stop))
+     ((regexp-exec needle line) =>
+      (lambda (rmatch)
+        (display-it (match:prefix rmatch) code?)
+        (display stop)
+        (loop inp other needle (not code?) (match:suffix rmatch)
+              (cond
+               (code? (display "(display \"") "\")")
+               ((match:substring rmatch 1) (display "(display ") ")")
+               (else (display "") "")))))
+     (else
+      (display-it line code?)
+      (loop inp needle other code? "" stop))))
+
+  (display "(display \"")
   (if (defined? 'make-regexp)
-      (loop (current-input-port) startre endre #f "")
-      (display "eguile requires guile with regex."))
-  (display stop))
+      (loop (current-input-port) startre endre #f "" "\")")
+      (display "eguile requires guile with regex.\")")))
 
 ;end of (template->script)
 

commit 0a15909d5ededef244e3a6926199ba6116156a3f
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sat Jun 13 22:56:13 2020 +0800

    [eguile-utilities] compact & simplify
    
    instead of symbol->string, use string directly.

diff --git a/gnucash/report/eguile-utilities.scm b/gnucash/report/eguile-utilities.scm
index 09bb27a50..3f78ee888 100644
--- a/gnucash/report/eguile-utilities.scm
+++ b/gnucash/report/eguile-utilities.scm
@@ -78,27 +78,25 @@
   ;; Then look in Gnucash' gnucash/reports/'ftype' directory.
   ;; If no file is found, returns just 'fname' for use in error messages.
   (let* ((userpath (gnc-build-userdata-path fname))
-         (frelpath (string-join (list (symbol->string ftype) fname) "/"))
-         (syspath  (gnc-build-reports-path frelpath)))
-        (if (access? userpath R_OK)
-          userpath
-          (if (access? syspath R_OK)
-            syspath
-            fname))))
+         (syspath  (gnc-build-reports-path (string-append ftype "/" fname))))
+    (cond
+     ((access? userpath R_OK) userpath)
+     ((access? syspath R_OK) syspath)
+     (else fname))))
 
 (define-public (find-stylesheet fname)
   ;; Find the stylesheet 'fname', and return its full path.
   ;; First look in the user's .config/gnucash directory.
   ;; Then look in Gnucash' gnucash/reports/stylesheets directory.
   ;; If no file is found, returns just 'fname' for use in error messages.
-  (find-internal 'stylesheets fname))
+  (find-internal "stylesheets" fname))
 
 (define-public (find-template fname)
   ;; Find the template 'ftype'/'fname', and return its full path.
   ;; First look in the user's .config/gnucash directory.
   ;; Then look in Gnucash' gnucash/reports/templates directory.
   ;; If no file is found, returns just 'fname' for use in error messages.
-  (find-internal 'templates fname))
+  (find-internal "templates" 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).

commit 28df0c091ddf90fc1afbeb32c44700dc4a77d2eb
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sat Jun 13 22:17:04 2020 +0800

    [balsheet-pnl] fix balsheet->networth barchart link
    
    def0caa011c32fcb77d40d28527a4d6d174bc22c had error.

diff --git a/gnucash/report/reports/standard/balsheet-pnl.scm b/gnucash/report/reports/standard/balsheet-pnl.scm
index d5ed84bfc..475c4a557 100644
--- a/gnucash/report/reports/standard/balsheet-pnl.scm
+++ b/gnucash/report/reports/standard/balsheet-pnl.scm
@@ -1035,18 +1035,18 @@ also show overall period profit & loss."))
                                              common-currency price-source date)
                       (income-expense-balance 'format gnc:make-gnc-monetary #f)))))
 
-             (chart (and-let* (include-chart?
-                               (not (eq? incr 'disabled))
-                               (curr (or common-currency book-main-currency))
-                               (price (or price-source 'pricedb-nearest)))
-                      (gnc:make-report-anchor
-                       networth-barchart-uuid report-obj
-                       (list (list "General" "Start Date" (cons 'absolute startdate))
-                             (list "General" "End Date" (cons 'absolute enddate))
-                             (list "General" "Report's currency" curr)
-                             (list "General" "Step Size" incr)
-                             (list "General" "Price Source" price)
-                             (list "Accounts" "Accounts" asset-liability)))))
+             (chart
+              (and include-chart? (not (eq? incr 'disabled))
+                   (let ((chart-currency (or common-currency book-main-currency))
+                         (price-source (or price-source 'pricedb-nearest)))
+                     (gnc:make-report-anchor
+                      networth-barchart-uuid report-obj
+                      (list (list "General" "Start Date" (cons 'absolute startdate))
+                            (list "General" "End Date" (cons 'absolute enddate))
+                            (list "General" "Report's currency" chart-currency)
+                            (list "General" "Step Size" incr)
+                            (list "General" "Price Source" price-source)
+                            (list "Accounts" "Accounts" asset-liability))))))
 
              (get-col-header-fn
               (lambda (accounts col-idx)

commit 2eb981460446f7e17ae6ce383e8cdc4e6ec0729c
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sat Jun 13 22:29:30 2020 +0800

    [balsheet-pnl] use (ice-9 match) forms

diff --git a/gnucash/report/reports/standard/balsheet-pnl.scm b/gnucash/report/reports/standard/balsheet-pnl.scm
index 4ce6acaa6..d5ed84bfc 100644
--- a/gnucash/report/reports/standard/balsheet-pnl.scm
+++ b/gnucash/report/reports/standard/balsheet-pnl.scm
@@ -34,6 +34,7 @@
 (use-modules (srfi srfi-1))
 (use-modules (srfi srfi-2))
 (use-modules (srfi srfi-9))
+(use-modules (ice-9 match))
 
 ;; the column-data record. the gnc:account-accumulate-at-dates will
 ;; create a record for each report-date with split-data as follows:
@@ -455,27 +456,25 @@ also show overall period profit & loss."))
     ;; anchor: url string for monetaries (or #f) (all have same anchor)
     ;;
     ;; outputs: html-text object
-    (let ((text (gnc:make-html-text)))
-      (for-each
-       (lambda (monetary)
-         (let ((converted (and show-orig-cur?
-                               convert-curr-fn
-                               (convert-curr-fn monetary col-datum))))
-           (if (not (and omit-zb-bals?
-                         (gnc:gnc-monetary? monetary)
-                         (zero? (gnc:gnc-monetary-amount monetary))))
-               (gnc:html-text-append! text
-                                      (if converted
-                                          (gnc:html-markup-i
-                                           (gnc:html-markup "small" monetary " "))
-                                          "")
-                                      (if anchor
-                                          (gnc:html-markup-anchor
-                                           anchor (or converted monetary))
-                                          (or converted monetary))
-                                      (gnc:html-markup-br)))))
-       monetaries)
-      text))
+    (define (hide-false-or-zero? mon)
+      (and omit-zb-bals? (gnc:gnc-monetary? mon)
+           (zero? (gnc:gnc-monetary-amount mon))))
+    (let lp ((monetaries monetaries) (accum '()))
+      (match monetaries
+        (() (apply gnc:make-html-text (reverse accum)))
+        (((? hide-false-or-zero?) . rest) (lp rest accum))
+        ((monetary . rest)
+           (lp rest
+               (let ((converted (and show-orig-cur? convert-curr-fn
+                                     (convert-curr-fn monetary col-datum))))
+                 (cons* (gnc:html-markup-br)
+                        (if anchor
+                            (gnc:html-markup-anchor anchor (or converted monetary))
+                            (or converted monetary))
+                        (if converted
+                            (gnc:html-markup-i (gnc:html-markup "small" monetary " "))
+                            "")
+                        accum)))))))
 
   (define (account->depth acc)
     (cond ((vector? acc) 0)
@@ -518,35 +517,34 @@ also show overall period profit & loss."))
 
   (define (sum-accounts-at-col accounts datum convert?)
     ;; outputs: list of gnc-monetary
-
-    (let loop ((accounts accounts)
-               (result '()))
-      (cond
-       ((null? accounts)
-        (apply monetary+ result))
-       (else
-        (let* ((acc (car accounts))
-               (monetary (if (vector? acc)
-                             ((vector-ref acc 1) datum)
-                             (get-cell-monetary-fn acc datum)))
-               (amt (or (and convert? convert-curr-fn
-                             (not (list? monetary))
-                             (convert-curr-fn monetary datum))
-                        monetary)))
-          (loop (cdr accounts)
-                (if (list? amt)
-                    (append-reverse amt result)
-                    (cons amt result))))))))
-
+    (let loop ((accounts accounts) (result '()))
+      (match accounts
+        (() (apply monetary+ result))
+        ((acc . rest)
+         (let* ((monetary (if (vector? acc)
+                              ((vector-ref acc 1) datum)
+                              (get-cell-monetary-fn acc datum)))
+                (amt (or (and convert? convert-curr-fn
+                              (not (pair? monetary))
+                              (convert-curr-fn monetary datum))
+                         monetary)))
+           (loop rest (if (pair? amt)
+                          (append-reverse amt result)
+                          (cons amt result))))))))
+
+  (define (monetary-is-not-zero? mon) (not (zero? (gnc:gnc-monetary-amount mon))))
   (define (is-not-zero? accts)
     ;; this function tests whether accounts (with descendants) of all
     ;; columns are zero.
-    (not (every zero? (concatenate
-                       (map
-                        (lambda (col-datum)
-                          (map gnc:gnc-monetary-amount
-                               (sum-accounts-at-col accts col-datum #f)))
-                        cols-data)))))
+    (let lp ((cols-data cols-data))
+      (match cols-data
+        (() #f)
+        ((this . rest)
+         (let lp1 ((monetaries (sum-accounts-at-col accts this #f)))
+           (match monetaries
+             (() (lp rest))
+             (((? monetary-is-not-zero?) . _) #t)
+             ((_ . tail) (lp1 tail))))))))
 
   (define* (add-recursive-subtotal lvl lvl-acct #:key account-style-normal?)
     (if (or show-zb-accts?
@@ -614,40 +612,40 @@ also show overall period profit & loss."))
                             (gnc:html-make-empty-cells num-columns))))
 
   (let loop ((accounts (if show-accounts? accountlist '())))
-    (if (pair? accounts)
-        (let* ((curr (car accounts))
-               (rest (cdr accounts))
-               (next (and (pair? rest) (car rest)))
-               (lvl-curr (account->depth curr))
-               (lvl-next (if next (account->depth next) 0))
-               (curr-descendants-list (filter
-                                       (lambda (acc) (member acc accountlist))
-                                       (account->descendants curr)))
-               (recursive-parent-acct? (and recursive-bals?
-                                            (pair? curr-descendants-list)))
-               (multilevel-parent-acct? (and (not recursive-bals?)
-                                             (pair? curr-descendants-list))))
-
-          (if recursive-parent-acct?
-              (begin
-                (add-recursive-subtotal lvl-curr curr #:account-style-normal? #t)
-                (if (is-not-zero? (list curr))
-                    (add-account-row (1+ lvl-curr) curr #:override-show-zb-accts? #t)))
-              (add-account-row lvl-curr curr
-                               #:account-indent (if multilevel-parent-acct? 1 0)
-                               #:override-show-zb-accts? multilevel-parent-acct?))
-
-          (if (and (not recursive-bals?)
-                   (> lvl-curr lvl-next))
-              (let multilevel-loop ((lvl (1- lvl-curr))
-                                    (lvl-acct (gnc-account-get-parent curr)))
-                (unless (or (zero? lvl)
-                            (not (member lvl-acct accountlist))
-                            (< lvl lvl-next))
-                  (add-recursive-subtotal lvl lvl-acct)
-                  (multilevel-loop (1- lvl)
-                                   (gnc-account-get-parent lvl-acct)))))
-          (loop rest))))
+    (match accounts
+      (() #f)
+      ((curr . rest)
+       (let* ((next (and (pair? rest) (car rest)))
+              (lvl-curr (account->depth curr))
+              (lvl-next (if next (account->depth next) 0))
+              (curr-descendants-list (filter
+                                      (lambda (acc) (member acc accountlist))
+                                      (account->descendants curr)))
+              (recursive-parent-acct? (and recursive-bals?
+                                           (pair? curr-descendants-list)))
+              (multilevel-parent-acct? (and (not recursive-bals?)
+                                            (pair? curr-descendants-list))))
+
+         (if recursive-parent-acct?
+             (begin
+               (add-recursive-subtotal lvl-curr curr #:account-style-normal? #t)
+               (if (is-not-zero? (list curr))
+                   (add-account-row (1+ lvl-curr) curr #:override-show-zb-accts? #t)))
+             (add-account-row lvl-curr curr
+                              #:account-indent (if multilevel-parent-acct? 1 0)
+                              #:override-show-zb-accts? multilevel-parent-acct?))
+
+         (if (and (not recursive-bals?)
+                  (> lvl-curr lvl-next))
+             (let multilevel-loop ((lvl (1- lvl-curr))
+                                   (lvl-acct (gnc-account-get-parent curr)))
+               (unless (or (zero? lvl)
+                           (not (member lvl-acct accountlist))
+                           (< lvl lvl-next))
+                 (add-recursive-subtotal lvl lvl-acct)
+                 (multilevel-loop (1- lvl)
+                                  (gnc-account-get-parent lvl-acct)))))
+         (loop rest)))))
 
   (if show-total?
       (add-indented-row 0

commit 38060b0258041cd4bc5c34b956e6b2de2f6dcdb1
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sat Jun 13 22:51:15 2020 +0800

    [balsheet-pnl] value-collector doesn't need to ignore closing
    
    The value-collector is only used to tally account balances for
    asset&liability accounts. These accounts never have closing
    entries. No need to test closing property.

diff --git a/gnucash/report/reports/standard/balsheet-pnl.scm b/gnucash/report/reports/standard/balsheet-pnl.scm
index bb7d29c67..4ce6acaa6 100644
--- a/gnucash/report/reports/standard/balsheet-pnl.scm
+++ b/gnucash/report/reports/standard/balsheet-pnl.scm
@@ -783,10 +783,8 @@ also show overall period profit & loss."))
                                                  (gnc:make-commodity-collector))
                       #:split->elt
                       (lambda (s)
-                        (unless (xaccTransGetIsClosingTxn (xaccSplitGetParent s))
-                          (val-coll 'add
-                                    (xaccTransGetCurrency (xaccSplitGetParent s))
-                                    (xaccSplitGetValue s)))
+                        (val-coll 'add (xaccTransGetCurrency (xaccSplitGetParent s))
+                                  (xaccSplitGetValue s))
                         (make-datum s
                                     (amt->monetary (xaccSplitGetNoclosingBalance s))
                                     (amt->monetary (xaccSplitGetBalance s))

commit 78018d8f9c151791beed231096522076774bccbb
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sat Jun 13 22:47:32 2020 +0800

    [trep-engine] don't create intermediate cells object
    
    from cell-calculators (a list of column-info), the cells object (list
    of column-data) was created unnecessarily. use cell-calculators
    directly.

diff --git a/gnucash/report/trep-engine.scm b/gnucash/report/trep-engine.scm
index 52c815aae..fa9c0f619 100644
--- a/gnucash/report/trep-engine.scm
+++ b/gnucash/report/trep-engine.scm
@@ -1654,14 +1654,7 @@ be excluded from periodic reporting.")
 
     (define (add-split-row split cell-calculators row-style transaction-row?)
       (let* ((account (xaccSplitGetAccount split))
-             (reversible-account? (acc-reverse? account))
-             (cells (map (lambda (cell)
-                           (let ((split->monetary (vector-ref cell 1)))
-                             (vector (split->monetary split)
-                                     (vector-ref cell 2) ;reverse?
-                                     (vector-ref cell 3) ;subtotal?
-                                     )))
-                         cell-calculators)))
+             (reversible-account? (acc-reverse? account)))
 
         (unless (column-uses? 'subtotals-only)
           (gnc:html-table-append-row/markup!
@@ -1673,9 +1666,8 @@ be excluded from periodic reporting.")
                     split transaction-row?))
                  left-columns)
             (map (lambda (cell)
-                   (let* ((cell-monetary (vector-ref cell 0))
-                          (reverse? (and (vector-ref cell 1)
-                                         reversible-account?))
+                   (let* ((cell-monetary ((vector-ref cell 1) split))
+                          (reverse? (and (vector-ref cell 2) reversible-account?))
                           (cell-content (and cell-monetary
                                              (if reverse?
                                                  (gnc:monetary-neg cell-monetary)
@@ -1686,13 +1678,10 @@ be excluded from periodic reporting.")
                            (if opt-use-links?
                                (gnc:html-split-anchor split cell-content)
                                cell-content)))))
-                 cells))))
+                 cell-calculators))))
 
-        (map (lambda (cell)
-               (let ((cell-monetary (vector-ref cell 0))
-                     (subtotal? (vector-ref cell 2)))
-                 (and subtotal? cell-monetary)))
-             cells)))
+        (map (lambda (cell) (and (vector-ref cell 3) ((vector-ref cell 1) split)))
+             cell-calculators)))
 
     ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 



Summary of changes:
 gnucash/report/eguile-utilities.scm              |  16 +-
 gnucash/report/eguile.scm                        |  63 +++-----
 gnucash/report/html-utilities.scm                |   9 +-
 gnucash/report/reports/standard/balsheet-pnl.scm | 190 +++++++++++------------
 gnucash/report/trep-engine.scm                   |  23 +--
 5 files changed, 134 insertions(+), 167 deletions(-)



More information about the gnucash-changes mailing list