gnucash master: Multiple changes pushed

Christopher Lam clam at code.gnucash.org
Thu Oct 3 01:27:56 EDT 2019


Updated	 via  https://github.com/Gnucash/gnucash/commit/eb58bca7 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/315bbb5d (commit)
	 via  https://github.com/Gnucash/gnucash/commit/d47e49c2 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/c6195d6e (commit)
	 via  https://github.com/Gnucash/gnucash/commit/f015a968 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/5d15fd41 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/34c677d7 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/3452c33c (commit)
	 via  https://github.com/Gnucash/gnucash/commit/1dfd7c55 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/992f657c (commit)
	 via  https://github.com/Gnucash/gnucash/commit/8f1c82e8 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/34bb47e2 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/bf202d14 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/621c857b (commit)
	from  https://github.com/Gnucash/gnucash/commit/0c65c41b (commit)



commit eb58bca7afafe3eb06bdb18e5df6662b38d72c25
Merge: 0c65c41b3 315bbb5d0
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Oct 3 13:27:16 2019 +0800

    Merge branch 'maint'

diff --cc gnucash/report/reports/standard/test/test-budget.scm
index 34e43278c,21e506316..cf7759683
--- a/gnucash/report/reports/standard/test/test-budget.scm
+++ b/gnucash/report/reports/standard/test/test-budget.scm
@@@ -30,10 -30,12 +30,12 @@@
  (use-modules (gnucash app-utils))
  (use-modules (gnucash engine))
  (use-modules (sw_engine))
 -(use-modules (gnucash report standard-reports budget))
 -(use-modules (gnucash report standard-reports budget-income-statement))
 -(use-modules (gnucash report report-system test test-extras))
 -(use-modules (gnucash report stylesheets))
 -(use-modules (gnucash engine test test-extras))
 +(use-modules (gnucash reports standard budget))
++(use-modules (gnucash reports standard budget-income-statement))
 +(use-modules (tests test-report-extras))
 +(use-modules (gnucash report stylesheets plain)) ; For the default stylesheet, required for rendering
 +(use-modules (tests test-engine-extras))
+ (use-modules (sxml xpath))
  
  ;; Explicitly set locale to make the report output predictable
  (setlocale LC_ALL "C")

commit 315bbb5d0539d7d911b867b2eac8406f8d3e4484
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Oct 3 13:02:08 2019 +0800

    [test-stress-options] reinstate test empty book
    
    d47e49c23 had disabled testing empty book in error.

diff --git a/gnucash/report/standard-reports/test/test-stress-options.scm b/gnucash/report/standard-reports/test/test-stress-options.scm
index 26110ca76..0a4925ebf 100644
--- a/gnucash/report/standard-reports/test/test-stress-options.scm
+++ b/gnucash/report/standard-reports/test/test-stress-options.scm
@@ -264,7 +264,7 @@
    optionslist))
 
 (define (tests)
-  ;; (run-tests "with empty book")
+  (run-tests "with empty book")
   (let ((env (create-test-env))
         (account-alist (create-test-data)))
     (gnc:create-budget-and-transactions env account-alist))

commit d47e49c230c2085008cdf87b71ebb98cb6ccb1cb
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Oct 3 08:06:16 2019 +0800

    [test-stress-options] add budget to test book
    
    the populated book has a budget. this enables more thorough testing of
    budget reports.

diff --git a/gnucash/report/standard-reports/test/test-stress-options.scm b/gnucash/report/standard-reports/test/test-stress-options.scm
index 028441bd5..26110ca76 100644
--- a/gnucash/report/standard-reports/test/test-stress-options.scm
+++ b/gnucash/report/standard-reports/test/test-stress-options.scm
@@ -264,7 +264,9 @@
    optionslist))
 
 (define (tests)
-  (run-tests "with empty book")
-  (create-test-data)
+  ;; (run-tests "with empty book")
+  (let ((env (create-test-env))
+        (account-alist (create-test-data)))
+    (gnc:create-budget-and-transactions env account-alist))
   (create-test-invoice-data)
   (run-tests "on a populated book"))

commit c6195d6e7aa8e4dd691657df00aaccc85f92388a
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Oct 3 08:05:52 2019 +0800

    [test-budget] centralize gnc:create-budget-and-transactions
    
    it will be reused by test-stress-options

diff --git a/gnucash/report/standard-reports/test/test-budget.scm b/gnucash/report/standard-reports/test/test-budget.scm
index 0c59686cf..21e506316 100644
--- a/gnucash/report/standard-reports/test/test-budget.scm
+++ b/gnucash/report/standard-reports/test/test-budget.scm
@@ -62,40 +62,10 @@
 (define (options->sxml options uuid test-title)
   (gnc:options->sxml uuid options "test-budget" test-title))
 
-(define (create-budget-and-transactions env account-alist)
-  (let* ((book (gnc-get-current-book))
-         (budget (gnc-budget-new book))
-         (bank (cdr (assoc "Bank" account-alist)))
-         (income (cdr (assoc "Income" account-alist)))
-         (expense (cdr (assoc "Expenses" account-alist))))
-    (gnc-budget-set-name budget "test budget")
-    (gnc-budget-begin-edit budget)
-    (gnc-budget-set-num-periods budget 6)
-    (gnc-budget-set-account-period-value budget bank 0 20)
-    (gnc-budget-set-account-period-value budget bank 1 40)
-    (gnc-budget-set-account-period-value budget bank 3 60)
-    (gnc-budget-set-account-period-value budget expense 1 30)
-    (gnc-budget-set-account-period-value budget expense 2 20)
-    (gnc-budget-set-account-period-value budget expense 3 40)
-    (gnc-budget-set-account-period-value budget income 0 -55)
-    (gnc-budget-set-account-period-value budget income 2 -65)
-    (gnc-budget-set-account-period-value budget income 3 -75)
-    (gnc-budget-commit-edit budget)
-    (let ((midperiod (lambda (period)
-                       (floor (/ (+ (gnc-budget-get-period-start-date budget period)
-                                    (gnc-budget-get-period-end-date budget period))
-                                 2)))))
-      (env-create-transaction env (midperiod 0) bank income 55)
-      (env-create-transaction env (midperiod 2) bank income 67)
-      (env-create-transaction env (midperiod 3) bank income 77)
-      (env-create-transaction env (midperiod 0) expense bank 20)
-      (env-create-transaction env (midperiod 1) expense bank 20))
-    budget))
-
 (define (test-budget)
   (let* ((env (create-test-env))
          (account-alist (create-test-data))
-         (budget (create-budget-and-transactions env account-alist))
+         (budget (gnc:create-budget-and-transactions env account-alist))
          (options (gnc:make-report-options budget-uuid))
          (bank (cdr (assoc "Bank" account-alist))))
 
@@ -186,7 +156,7 @@
 (define (test-budget-income-statement)
   (let* ((env (create-test-env))
          (account-alist (create-test-data))
-         (budget (create-budget-and-transactions env account-alist))
+         (budget (gnc:create-budget-and-transactions env account-alist))
          (options (gnc:make-report-options budget-is-uuid))
          (bank (assoc-ref account-alist "Bank")))
 
diff --git a/libgnucash/engine/test/test-extras.scm b/libgnucash/engine/test/test-extras.scm
index 3fbe5bd9f..126f7e0ec 100644
--- a/libgnucash/engine/test/test-extras.scm
+++ b/libgnucash/engine/test/test-extras.scm
@@ -834,6 +834,36 @@
 
     (vector inv-1 inv-2 inv-3 inv-4 inv-5 inv-6 inv-7 inv-8)))
 
+(define-public (gnc:create-budget-and-transactions env account-alist)
+  (let* ((book (gnc-get-current-book))
+         (budget (gnc-budget-new book))
+         (bank (cdr (assoc "Bank" account-alist)))
+         (income (cdr (assoc "Income" account-alist)))
+         (expense (cdr (assoc "Expenses" account-alist))))
+    (gnc-budget-set-name budget "test budget")
+    (gnc-budget-begin-edit budget)
+    (gnc-budget-set-num-periods budget 6)
+    (gnc-budget-set-account-period-value budget bank 0 20)
+    (gnc-budget-set-account-period-value budget bank 1 40)
+    (gnc-budget-set-account-period-value budget bank 3 60)
+    (gnc-budget-set-account-period-value budget expense 1 30)
+    (gnc-budget-set-account-period-value budget expense 2 20)
+    (gnc-budget-set-account-period-value budget expense 3 40)
+    (gnc-budget-set-account-period-value budget income 0 -55)
+    (gnc-budget-set-account-period-value budget income 2 -65)
+    (gnc-budget-set-account-period-value budget income 3 -75)
+    (gnc-budget-commit-edit budget)
+    (let ((midperiod (lambda (period)
+                       (floor (/ (+ (gnc-budget-get-period-start-date budget period)
+                                    (gnc-budget-get-period-end-date budget period))
+                                 2)))))
+      (env-create-transaction env (midperiod 0) bank income 55)
+      (env-create-transaction env (midperiod 2) bank income 67)
+      (env-create-transaction env (midperiod 3) bank income 77)
+      (env-create-transaction env (midperiod 0) expense bank 20)
+      (env-create-transaction env (midperiod 1) expense bank 20))
+    budget))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; various stock transactions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

commit f015a96833825df852f3e20bb5ce0ebcb78a8de4
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Oct 3 00:52:17 2019 +0800

    [budget] fixcrash: fix crasher for some periods
    
    eg. the following combo would previously crash:
    - periods from next to current
    - use accumulated amounts

diff --git a/gnucash/report/standard-reports/budget.scm b/gnucash/report/standard-reports/budget.scm
index 71104db10..b5c1c6443 100644
--- a/gnucash/report/standard-reports/budget.scm
+++ b/gnucash/report/standard-reports/budget.scm
@@ -332,7 +332,7 @@
       (let* ((comm (xaccAccountGetCommodity acct))
              (reverse-balance? (gnc-reverse-balance acct))
              (allperiods (filter number? (gnc:list-flatten column-list)))
-             (total-periods (if accumulate?
+             (total-periods (if (and accumulate? (not (null? allperiods)))
                                 (iota (1+ (apply max allperiods)))
                                 allperiods))
              (income-acct? (eqv? (xaccAccountGetType acct) ACCT-TYPE-INCOME)))

commit 5d15fd41fd8c73869698a388b7baa3b722e75966
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Oct 3 00:41:43 2019 +0800

    [budget] fixcrash: prevent crash if periods start > end
    
    It's silly to input start-period > end-period. Nevertheless handle it
    by swapping them instead of crashing. i.e. report budget periods from
    end to start.

diff --git a/gnucash/report/standard-reports/budget.scm b/gnucash/report/standard-reports/budget.scm
index 17274811d..71104db10 100644
--- a/gnucash/report/standard-reports/budget.scm
+++ b/gnucash/report/standard-reports/budget.scm
@@ -537,7 +537,9 @@
     (define (calc-periods
              budget user-start user-end collapse-before? collapse-after? show-total?)
       (define (range start end)
-        (iota (- end start) start))
+        (if (< start end)
+            (iota (- end start) start)
+            (iota (- start end) end)))
       (let* ((num-periods (gnc-budget-get-num-periods budget))
              (range-start (or user-start 0))
              (range-end (if user-end (1+ user-end) num-periods))

commit 34c677d70d13c8b4b97806af02a6d8c79f92ccd1
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Oct 3 00:01:47 2019 +0800

    [budget-flow] fixcrash: exchange-fn needs to specify exchange date
    
    because some exchange-fn *do* require date eg. pricedb-nearest. use
    the period end-date for the exchange date.

diff --git a/gnucash/report/standard-reports/budget-flow.scm b/gnucash/report/standard-reports/budget-flow.scm
index 81fda0c03..f20a8f39f 100644
--- a/gnucash/report/standard-reports/budget-flow.scm
+++ b/gnucash/report/standard-reports/budget-flow.scm
@@ -276,7 +276,8 @@
 
          ;; calculate the exchange rates
          (exchange-fn (gnc:case-exchange-fn
-                       price-source report-currency #f))
+                       price-source report-currency
+                       (gnc-budget-get-period-end-date budget period)))
 
          ;; The HTML document
          (doc (gnc:make-html-document)))

commit 3452c33cdf0b8d405ae50a6755346b45704a890d
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Tue Oct 1 00:56:44 2019 +0800

    [budget-income-statement] define vars in formals
    
    and use collector arithmetic

diff --git a/gnucash/report/standard-reports/budget-income-statement.scm b/gnucash/report/standard-reports/budget-income-statement.scm
index 29baf0751..a2393037c 100644
--- a/gnucash/report/standard-reports/budget-income-statement.scm
+++ b/gnucash/report/standard-reports/budget-income-statement.scm
@@ -442,28 +442,88 @@
 
      (else
       ;; Get all the balances for each of the account types.
-      (let* (
-             (revenue-account-balances #f)
-             (expense-account-balances #f)
+      (let* ((revenue-account-balances
+              (get-assoc-account-balances-budget
+               budget revenue-accounts period-start period-end
+               get-budget-account-budget-balance))
+
+             (expense-account-balances
+              (get-assoc-account-balances-budget
+               budget expense-accounts period-start period-end
+               get-budget-account-budget-balance))
+
+             (revenue-total
+              (gnc:get-assoc-account-balances-total revenue-account-balances))
+
+             (expense-total
+              (gnc:get-assoc-account-balances-total expense-account-balances))
+
+             (net-income
+              (gnc:collector- revenue-total expense-total))
+
+             (table-env
+              (list
+               (list 'display-tree-depth tree-depth)
+               (list 'depth-limit-behavior
+                     (if bottom-behavior 'flatten 'summarize))
+               (list 'report-commodity report-commodity)
+               (list 'exchange-fn exchange-fn)
+               (list 'parent-account-subtotal-mode parent-total-mode)
+               (list 'zero-balance-mode
+                     (if show-zb-accts? 'show-leaf-acct 'omit-leaf-acct))
+               (list 'account-label-mode (if use-links? 'anchor 'name))))
+
+             (params
+              (list
+               (list 'parent-account-balance-mode parent-balance-mode)
+               (list 'zero-balance-display-mode
+                     (if omit-zb-bals? 'omit-balance 'show-balance))
+               (list 'multicommodity-mode (and show-fcur? 'table))
+               (list 'rule-mode use-rules?)))
+
+             (revenue-get-balance-fn
+              (lambda (acct start-date end-date)
+                (gnc:collector-
+                 (gnc:select-assoc-account-balance revenue-account-balances acct))))
+
+             (revenue-table
+              (gnc:make-html-acct-table/env/accts
+               (cons (list 'get-balance-fn revenue-get-balance-fn) table-env)
+               revenue-accounts))
+
+             (expense-get-balance-fn
+              (lambda (acct start-date end-date)
+                (gnc:select-assoc-account-balance expense-account-balances acct)))
+
+             (expense-table
+              (gnc:make-html-acct-table/env/accts
+               (cons (list 'get-balance-fn expense-get-balance-fn) table-env)
+               expense-accounts))
+
+             (space (make-list tree-depth (gnc:make-html-table-cell/min-width 60)))
+
+             (inc-table
+              (let ((table (gnc:make-html-table)))
+                (gnc:html-table-append-row! table space)
+                (when label-revenue?
+                  (add-subtotal-line table (_ "Revenues") #f #f))
+                (gnc:html-table-add-account-balances table revenue-table params)
+                (when total-revenue?
+                  (add-subtotal-line table (_ "Total Revenue") #f revenue-total))
+                table))
+
+             (exp-table
+              (let ((table (gnc:make-html-table)))
+                (gnc:html-table-append-row! table space)
+                (when label-expense?
+                  (add-subtotal-line table (_ "Expenses") #f #f))
+                (gnc:html-table-add-account-balances table expense-table params)
+                (when total-expense?
+                  (add-subtotal-line table (_ "Total Expenses") #f expense-total))
+                table))
 
-             (revenue-total #f)
-             (revenue-get-balance-fn #f)
-
-             (expense-total #f)
-             (expense-get-balance-fn #f)
-
-             (net-income #f)
-
-             ;; Create the account tables below where their
-             ;; percentage time can be tracked.
-             (inc-table (gnc:make-html-table)) ;; gnc:html-table
-             (exp-table (gnc:make-html-table))
-
-             (table-env #f)                      ;; parameters for :make-
-             (params #f)                         ;; and -add-account-
-             (revenue-table #f)                  ;; gnc:html-acct-table
-             (expense-table #f)                  ;; gnc:html-acct-table
              (budget-name (gnc-budget-get-name budget))
+
              (period-for
               (cond
                ((not use-budget-period-range?)
@@ -493,128 +553,17 @@
              label                0  1 "text-cell"
              bal           (1+ col)  1 "number-cell")))
 
-        (gnc:report-percent-done 5)
-
-        ;; Pre-fetch expense account balances.
-        (set! expense-account-balances
-          (get-assoc-account-balances-budget
-           budget
-           expense-accounts
-           period-start
-           period-end
-           get-budget-account-budget-balance))
-
-        ;; Total expenses.
-        (set! expense-total
-          (gnc:get-assoc-account-balances-total expense-account-balances))
-
-        ;; Function to get individual expense account total.
-        (set! expense-get-balance-fn
-          (lambda (account start-date end-date)
-            (gnc:select-assoc-account-balance expense-account-balances account)))
-
-        (gnc:report-percent-done 10)
-
-        ;; Pre-fetch revenue account balances.
-        (set! revenue-account-balances
-          (get-assoc-account-balances-budget
-           budget
-           revenue-accounts
-           period-start
-           period-end
-           get-budget-account-budget-balance))
-
-        ;; Total revenue.
-        (set! revenue-total
-          (gnc:get-assoc-account-balances-total revenue-account-balances))
-
-        ;; Function to get individual revenue account total.
-        ;; Budget revenue is always positive, so this must be negated.
-        (set! revenue-get-balance-fn
-          (lambda (account start-date end-date)
-            (gnc:commodity-collector-get-negated
-             (gnc:select-assoc-account-balance revenue-account-balances account))))
-
-        (gnc:report-percent-done 20)
-
-        ;; calculate net income
-        (set! net-income
-          (gnc:collector- revenue-total expense-total))
-
         (gnc:report-percent-done 30)
 
         (gnc:html-document-set-title!
-         doc
-         (format #f "~a ~a ~a" company-name report-title period-for))
-
-        (set! table-env
-          (list
-           (list 'display-tree-depth tree-depth)
-           (list 'depth-limit-behavior (if bottom-behavior
-                                           'flatten
-                                           'summarize))
-           (list 'report-commodity report-commodity)
-           (list 'exchange-fn exchange-fn)
-           (list 'parent-account-subtotal-mode parent-total-mode)
-           (list 'zero-balance-mode (if show-zb-accts?
-                                        'show-leaf-acct
-                                        'omit-leaf-acct))
-           (list 'account-label-mode (if use-links?
-                                         'anchor
-                                         'name))
-           )
-          )
-        (set! params
-          (list
-           (list 'parent-account-balance-mode parent-balance-mode)
-           (list 'zero-balance-display-mode (if omit-zb-bals?
-                                                'omit-balance
-                                                'show-balance))
-           (list 'multicommodity-mode (if show-fcur? 'table #f))
-           (list 'rule-mode use-rules?)
-           )
-          )
-
-        (let ((space (make-list tree-depth (gnc:make-html-table-cell/min-width 60))))
-          (gnc:html-table-append-row! inc-table space)
-          (gnc:html-table-append-row! exp-table space))
-
-        (gnc:report-percent-done 80)
-        (if label-revenue?
-            (add-subtotal-line inc-table (_ "Revenues") #f #f))
-        (set! revenue-table
-          (gnc:make-html-acct-table/env/accts
-           (append table-env (list (list 'get-balance-fn revenue-get-balance-fn)))
-           revenue-accounts))
-        (gnc:html-table-add-account-balances
-         inc-table revenue-table params)
-        (if total-revenue?
-            (add-subtotal-line
-             inc-table (_ "Total Revenue") #f revenue-total))
-
-        (gnc:report-percent-done 85)
-        (if label-expense?
-            (add-subtotal-line
-             exp-table (_ "Expenses") #f #f))
-        (set! expense-table
-          (gnc:make-html-acct-table/env/accts
-           (append table-env (list (list 'get-balance-fn expense-get-balance-fn)))
-           expense-accounts))
-        (gnc:html-table-add-account-balances
-         exp-table expense-table params)
-        (if total-expense?
-            (add-subtotal-line
-             exp-table (_ "Total Expenses") #f expense-total))
+         doc (format #f "~a ~a ~a" company-name report-title period-for))
 
         (report-line
-         (if standard-order?
-             exp-table
-             inc-table)
+         (if standard-order? exp-table inc-table)
          (string-append (_ "Net income") " " period-for)
          (string-append (_ "Net loss") " " period-for)
          net-income
-         (* 2 (- tree-depth 1)) exchange-fn #f #f
-         )
+         (* 2 (1- tree-depth)) exchange-fn #f #f)
 
         (let ((build-table (gnc:make-html-table))
                 (inc-cell (gnc:make-html-table-cell inc-table))

commit 1dfd7c5547cd7f0842f0a2e5cd8952e84b17f420
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Tue Oct 1 00:48:16 2019 +0800

    [budget-income-statement] compact functions
    
    neater.

diff --git a/gnucash/report/standard-reports/budget-income-statement.scm b/gnucash/report/standard-reports/budget-income-statement.scm
index d26085212..29baf0751 100644
--- a/gnucash/report/standard-reports/budget-income-statement.scm
+++ b/gnucash/report/standard-reports/budget-income-statement.scm
@@ -417,270 +417,236 @@
     
     ;; wrapper around gnc:html-table-append-ruler!
     (define (add-rule table)
-      (gnc:html-table-append-ruler!
-       table (* 2 tree-depth)))
-    
+      (gnc:html-table-append-ruler! table (* 2 tree-depth)))
+
     (cond
-      ((null? accounts)
-        ;; No accounts selected.
-        (gnc:html-document-add-object! 
-          doc 
-          (gnc:html-make-no-account-warning 
-	    reportname (gnc:report-id report-obj))))
-      ((not budget-valid?)
-        ;; No budget selected.
-        (gnc:html-document-add-object!
-          doc (gnc:html-make-generic-budget-warning report-title)))
-      ((and use-budget-period-range?
-          (< user-budget-period-end user-budget-period-start))
-        ;; User has selected a range with end period lower than start period.
-        (gnc:html-document-add-object!
-          doc
-          (gnc:html-make-generic-simple-warning
+     ((null? accounts)
+      ;; No accounts selected.
+      (gnc:html-document-add-object!
+       doc
+       (gnc:html-make-no-account-warning
+        reportname (gnc:report-id report-obj))))
+
+     ((not budget-valid?)
+      ;; No budget selected.
+      (gnc:html-document-add-object!
+       doc (gnc:html-make-generic-budget-warning report-title)))
+
+     ((and use-budget-period-range?
+           (< user-budget-period-end user-budget-period-start))
+      ;; User has selected a range with end period lower than start period.
+      (gnc:html-document-add-object!
+       doc (gnc:html-make-generic-simple-warning
             report-title
             (_ "Reporting range end period cannot be less than start period."))))
-      (else (begin
-        ;; Get all the balances for each of the account types.
-        (let* (
-               (revenue-account-balances #f)
-               (expense-account-balances #f)
-
-	       (revenue-total #f)
-               (revenue-get-balance-fn #f)
-
-	       (expense-total #f)
-               (expense-get-balance-fn #f)
-
-	       (net-income #f)
-	       
-               ;; Create the account tables below where their
-               ;; percentage time can be tracked.
-	       (inc-table (gnc:make-html-table)) ;; gnc:html-table
-	       (exp-table (gnc:make-html-table))
-
-	       (table-env #f)                      ;; parameters for :make-
-	       (params #f)                         ;; and -add-account-
-               (revenue-table #f)                  ;; gnc:html-acct-table
-               (expense-table #f)                  ;; gnc:html-acct-table
-               (budget-name (gnc-budget-get-name budget))
-               (period-for
-                 (if use-budget-period-range?
-                   (if (equal? user-budget-period-start user-budget-period-end)
-                     (format
-                       #f
-                       (_ "for Budget ~a Period ~d")
-                       budget-name
-                       user-budget-period-start)
-                     (format
-                       #f
-                       (_ "for Budget ~a Periods ~d - ~d")
-                       budget-name
-                       user-budget-period-start
-                       user-budget-period-end))
-                   (format
-                     #f
-                     (_ "for Budget ~a")
-                     budget-name)))
-	       )
-
-	  ;; a helper to add a line to our report
-	  (define (report-line
-		   table pos-label neg-label amount col exchange-fn rule? row-style)
-	    (let* ((neg? (and amount neg-label
-			      (negative?
-			       (gnc:gnc-monetary-amount
-				(gnc:sum-collector-commodity
-				 amount report-commodity exchange-fn)))))
-		   (label (if neg? (or neg-label pos-label) pos-label))
-		   (abs-amt (if neg? (gnc:collector- amount) amount))
-		   (bal (gnc:sum-collector-commodity
-                         abs-amt report-commodity exchange-fn)))
-	      (gnc:html-table-add-labeled-amount-line!
-	       table (* 2 tree-depth)  row-style rule?
-	       label                0  1 "text-cell"
-	       bal           (1+ col)  1 "number-cell")))
-
-	  (gnc:report-percent-done 5)
-
-          ;; Pre-fetch expense account balances.
-          (set! expense-account-balances
-            (get-assoc-account-balances-budget
-              budget
-              expense-accounts
-              period-start
-              period-end
-              get-budget-account-budget-balance))
-
-          ;; Total expenses.
-          (set! expense-total
-            (gnc:get-assoc-account-balances-total expense-account-balances))
-
-          ;; Function to get individual expense account total.
-          (set! expense-get-balance-fn
-            (lambda (account start-date end-date)
-              (gnc:select-assoc-account-balance expense-account-balances account)))
-
-	  (gnc:report-percent-done 10)
-
-          ;; Pre-fetch revenue account balances.
-          (set! revenue-account-balances
-            (get-assoc-account-balances-budget
-              budget
-              revenue-accounts
-              period-start
-              period-end
-              get-budget-account-budget-balance))
-
-          ;; Total revenue.
-          (set! revenue-total
-            (gnc:get-assoc-account-balances-total revenue-account-balances))
-
-          ;; Function to get individual revenue account total.
-          ;; Budget revenue is always positive, so this must be negated.
-          (set! revenue-get-balance-fn
-            (lambda (account start-date end-date)
-              (gnc:commodity-collector-get-negated
-                (gnc:select-assoc-account-balance revenue-account-balances account))))
-
-	  (gnc:report-percent-done 20)
-
-	  ;; calculate net income
-	  (set! net-income
-            (gnc:collector- revenue-total expense-total))
-
-	  (gnc:report-percent-done 30)
-
-          (gnc:html-document-set-title! 
-            doc
-            (format #f "~a ~a ~a" company-name report-title period-for))
-
-	  (set! table-env
-		(list
-		 (list 'display-tree-depth tree-depth)
-		 (list 'depth-limit-behavior (if bottom-behavior
-						 'flatten
-						 'summarize))
-		 (list 'report-commodity report-commodity)
-		 (list 'exchange-fn exchange-fn)
-		 (list 'parent-account-subtotal-mode parent-total-mode)
-		 (list 'zero-balance-mode (if show-zb-accts?
-					      'show-leaf-acct
-					      'omit-leaf-acct))
-		 (list 'account-label-mode (if use-links?
-					       'anchor
-					       'name))
-		 )
-		)
-	  (set! params
-		(list
-		 (list 'parent-account-balance-mode parent-balance-mode)
-		 (list 'zero-balance-display-mode (if omit-zb-bals?
-						      'omit-balance
-						      'show-balance))
-		 (list 'multicommodity-mode (if show-fcur? 'table #f))
-		 (list 'rule-mode use-rules?)
-		  )
-		)
-	  
-	  (let ((space (make-list tree-depth (gnc:make-html-table-cell/min-width 60))))
-            (gnc:html-table-append-row! inc-table space)
-            (gnc:html-table-append-row! exp-table space))
-	       
-	  (gnc:report-percent-done 80)
-	  (if label-revenue?
-	      (add-subtotal-line inc-table (_ "Revenues") #f #f))
-	  (set! revenue-table
-		(gnc:make-html-acct-table/env/accts
-                 (append table-env (list (list 'get-balance-fn revenue-get-balance-fn)))
-                 revenue-accounts))
-	  (gnc:html-table-add-account-balances
-	   inc-table revenue-table params)
-          (if total-revenue?
-	      (add-subtotal-line 
-	       inc-table (_ "Total Revenue") #f revenue-total))
-	  
-	  (gnc:report-percent-done 85)
-	  (if label-expense?
-	      (add-subtotal-line 
-	       exp-table (_ "Expenses") #f #f))
-	  (set! expense-table
-		(gnc:make-html-acct-table/env/accts
-                 (append table-env (list (list 'get-balance-fn expense-get-balance-fn)))
-                 expense-accounts))
-	  (gnc:html-table-add-account-balances
-	   exp-table expense-table params)
-	  (if total-expense?
-	      (add-subtotal-line
-	       exp-table (_ "Total Expenses") #f expense-total))
-	  
-	  (report-line
-	   (if standard-order? 
-	       exp-table 
-	       inc-table)
-	   (string-append (_ "Net income") " " period-for)
-	   (string-append (_ "Net loss") " " period-for)
-	   net-income
-	   (* 2 (- tree-depth 1)) exchange-fn #f #f
-	   )
-	  
-	  (gnc:html-document-add-object! 
-	   doc 
-	   (let* ((build-table (gnc:make-html-table)))
-	     (if two-column?     
-		 (gnc:html-table-append-row!
-		  build-table
-		  (if standard-order?
-		      (list
-		       (gnc:make-html-table-cell inc-table)
-		       (gnc:make-html-table-cell exp-table)
-		       )
-		      (list
-		       (gnc:make-html-table-cell exp-table)
-		       (gnc:make-html-table-cell inc-table)
-		       )
-		      )
-		  )
-		 (if standard-order?
-		     (begin
-		       (gnc:html-table-append-row!
-			build-table
-			(list (gnc:make-html-table-cell inc-table)))
-		       (gnc:html-table-append-row!
-			build-table
-			(list (gnc:make-html-table-cell exp-table)))
-		       )
-		     (begin
-		       (gnc:html-table-append-row!
-			build-table
-			(list (gnc:make-html-table-cell exp-table)))
-		       (gnc:html-table-append-row!
-			build-table
-			(list (gnc:make-html-table-cell inc-table)))
-		       )
-		     )
-		 )
-	     
-	     (gnc:html-table-set-style!
-	      build-table "td"
-	      'attribute '("align" "left")
-	      'attribute '("valign" "top"))
-	     build-table
-	     )
-	   )
-  
-	  
-	  
-          ;; add currency information if requested
-	  (gnc:report-percent-done 90)
-          (if show-rates?
-              (gnc:html-document-add-object! 
-               doc ;;(gnc:html-markup-p)
-               (gnc:html-make-exchangerates 
-                report-commodity exchange-fn accounts)))
-	  (gnc:report-percent-done 100)
-	  
-	  )
-	))) ;; end cond
+
+     (else
+      ;; Get all the balances for each of the account types.
+      (let* (
+             (revenue-account-balances #f)
+             (expense-account-balances #f)
+
+             (revenue-total #f)
+             (revenue-get-balance-fn #f)
+
+             (expense-total #f)
+             (expense-get-balance-fn #f)
+
+             (net-income #f)
+
+             ;; Create the account tables below where their
+             ;; percentage time can be tracked.
+             (inc-table (gnc:make-html-table)) ;; gnc:html-table
+             (exp-table (gnc:make-html-table))
+
+             (table-env #f)                      ;; parameters for :make-
+             (params #f)                         ;; and -add-account-
+             (revenue-table #f)                  ;; gnc:html-acct-table
+             (expense-table #f)                  ;; gnc:html-acct-table
+             (budget-name (gnc-budget-get-name budget))
+             (period-for
+              (cond
+               ((not use-budget-period-range?)
+                (format #f (_ "for Budget ~a") budget-name))
+               ((= user-budget-period-start user-budget-period-end)
+                (format #f (_ "for Budget ~a Period ~d")
+                        budget-name user-budget-period-start))
+               (else
+                (format #f (_ "for Budget ~a Periods ~d - ~d")
+                        budget-name user-budget-period-start
+                        user-budget-period-end)))))
+
+        ;; a helper to add a line to our report
+        (define (report-line
+                 table pos-label neg-label amount col exchange-fn rule? row-style)
+          (let* ((neg? (and amount neg-label
+                            (negative?
+                             (gnc:gnc-monetary-amount
+                              (gnc:sum-collector-commodity
+                               amount report-commodity exchange-fn)))))
+                 (label (if neg? (or neg-label pos-label) pos-label))
+                 (abs-amt (if neg? (gnc:collector- amount) amount))
+                 (bal (gnc:sum-collector-commodity
+                       abs-amt report-commodity exchange-fn)))
+            (gnc:html-table-add-labeled-amount-line!
+             table (* 2 tree-depth)  row-style rule?
+             label                0  1 "text-cell"
+             bal           (1+ col)  1 "number-cell")))
+
+        (gnc:report-percent-done 5)
+
+        ;; Pre-fetch expense account balances.
+        (set! expense-account-balances
+          (get-assoc-account-balances-budget
+           budget
+           expense-accounts
+           period-start
+           period-end
+           get-budget-account-budget-balance))
+
+        ;; Total expenses.
+        (set! expense-total
+          (gnc:get-assoc-account-balances-total expense-account-balances))
+
+        ;; Function to get individual expense account total.
+        (set! expense-get-balance-fn
+          (lambda (account start-date end-date)
+            (gnc:select-assoc-account-balance expense-account-balances account)))
+
+        (gnc:report-percent-done 10)
+
+        ;; Pre-fetch revenue account balances.
+        (set! revenue-account-balances
+          (get-assoc-account-balances-budget
+           budget
+           revenue-accounts
+           period-start
+           period-end
+           get-budget-account-budget-balance))
+
+        ;; Total revenue.
+        (set! revenue-total
+          (gnc:get-assoc-account-balances-total revenue-account-balances))
+
+        ;; Function to get individual revenue account total.
+        ;; Budget revenue is always positive, so this must be negated.
+        (set! revenue-get-balance-fn
+          (lambda (account start-date end-date)
+            (gnc:commodity-collector-get-negated
+             (gnc:select-assoc-account-balance revenue-account-balances account))))
+
+        (gnc:report-percent-done 20)
+
+        ;; calculate net income
+        (set! net-income
+          (gnc:collector- revenue-total expense-total))
+
+        (gnc:report-percent-done 30)
+
+        (gnc:html-document-set-title!
+         doc
+         (format #f "~a ~a ~a" company-name report-title period-for))
+
+        (set! table-env
+          (list
+           (list 'display-tree-depth tree-depth)
+           (list 'depth-limit-behavior (if bottom-behavior
+                                           'flatten
+                                           'summarize))
+           (list 'report-commodity report-commodity)
+           (list 'exchange-fn exchange-fn)
+           (list 'parent-account-subtotal-mode parent-total-mode)
+           (list 'zero-balance-mode (if show-zb-accts?
+                                        'show-leaf-acct
+                                        'omit-leaf-acct))
+           (list 'account-label-mode (if use-links?
+                                         'anchor
+                                         'name))
+           )
+          )
+        (set! params
+          (list
+           (list 'parent-account-balance-mode parent-balance-mode)
+           (list 'zero-balance-display-mode (if omit-zb-bals?
+                                                'omit-balance
+                                                'show-balance))
+           (list 'multicommodity-mode (if show-fcur? 'table #f))
+           (list 'rule-mode use-rules?)
+           )
+          )
+
+        (let ((space (make-list tree-depth (gnc:make-html-table-cell/min-width 60))))
+          (gnc:html-table-append-row! inc-table space)
+          (gnc:html-table-append-row! exp-table space))
+
+        (gnc:report-percent-done 80)
+        (if label-revenue?
+            (add-subtotal-line inc-table (_ "Revenues") #f #f))
+        (set! revenue-table
+          (gnc:make-html-acct-table/env/accts
+           (append table-env (list (list 'get-balance-fn revenue-get-balance-fn)))
+           revenue-accounts))
+        (gnc:html-table-add-account-balances
+         inc-table revenue-table params)
+        (if total-revenue?
+            (add-subtotal-line
+             inc-table (_ "Total Revenue") #f revenue-total))
+
+        (gnc:report-percent-done 85)
+        (if label-expense?
+            (add-subtotal-line
+             exp-table (_ "Expenses") #f #f))
+        (set! expense-table
+          (gnc:make-html-acct-table/env/accts
+           (append table-env (list (list 'get-balance-fn expense-get-balance-fn)))
+           expense-accounts))
+        (gnc:html-table-add-account-balances
+         exp-table expense-table params)
+        (if total-expense?
+            (add-subtotal-line
+             exp-table (_ "Total Expenses") #f expense-total))
+
+        (report-line
+         (if standard-order?
+             exp-table
+             inc-table)
+         (string-append (_ "Net income") " " period-for)
+         (string-append (_ "Net loss") " " period-for)
+         net-income
+         (* 2 (- tree-depth 1)) exchange-fn #f #f
+         )
+
+        (let ((build-table (gnc:make-html-table))
+                (inc-cell (gnc:make-html-table-cell inc-table))
+                (exp-cell (gnc:make-html-table-cell exp-table)))
+            (define (add-cells . lst) (gnc:html-table-append-row! build-table lst))
+            (cond
+             ((and two-column? standard-order?)
+              (add-cells inc-cell exp-cell))
+
+             (two-column?
+              (add-cells exp-cell inc-cell))
+
+             (standard-order?
+              (add-cells inc-cell)
+              (add-cells exp-cell))
+
+             (else
+              (add-cells exp-cell)
+              (add-cells inc-cell)))
+
+            (gnc:html-table-set-style!
+             build-table "td"
+             'attribute '("align" "left")
+             'attribute '("valign" "top"))
+            (gnc:html-document-add-object! doc build-table))
+
+        ;; add currency information if requested
+        (gnc:report-percent-done 90)
+        (when show-rates?
+          (gnc:html-document-add-object!
+           doc (gnc:html-make-exchangerates report-commodity exchange-fn accounts)))
+        (gnc:report-percent-done 100))))
     
     (gnc:report-finished)
     

commit 992f657cc50a679715691735f5bdaec3a9a95740
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Wed Oct 2 21:49:41 2019 +0800

    [test-budget] augment to test budget-income-statement.scm

diff --git a/gnucash/report/standard-reports/test/test-budget.scm b/gnucash/report/standard-reports/test/test-budget.scm
index c471ca7bf..0c59686cf 100644
--- a/gnucash/report/standard-reports/test/test-budget.scm
+++ b/gnucash/report/standard-reports/test/test-budget.scm
@@ -31,18 +31,26 @@
 (use-modules (gnucash engine))
 (use-modules (sw_engine))
 (use-modules (gnucash report standard-reports budget))
+(use-modules (gnucash report standard-reports budget-income-statement))
 (use-modules (gnucash report report-system test test-extras))
 (use-modules (gnucash report stylesheets))
 (use-modules (gnucash engine test test-extras))
+(use-modules (sxml xpath))
 
 ;; Explicitly set locale to make the report output predictable
 (setlocale LC_ALL "C")
-(define uuid "810ed4b25ef0486ea43bbd3dddb32b11")
+(define budget-uuid "810ed4b25ef0486ea43bbd3dddb32b11")
+(define budget-is-uuid "583c313fcc484efc974c4c844404f454")
 
 (define (run-test)
   (test-runner-factory gnc:test-runner)
   (test-begin "budget")
-  (test-budget)
+  (test-group-with-cleanup "budget.scm"
+    (test-budget)
+    (teardown))
+  (test-group-with-cleanup "budget-income-statement.scm"
+    (test-budget-income-statement)
+    (teardown))
   (test-end "budget"))
 
 (define (set-option options page tag value)
@@ -51,7 +59,7 @@
 (define (teardown)
   (gnc-clear-current-session))
 
-(define (options->sxml options test-title)
+(define (options->sxml options uuid test-title)
   (gnc:options->sxml uuid options "test-budget" test-title))
 
 (define (create-budget-and-transactions env account-alist)
@@ -88,15 +96,16 @@
   (let* ((env (create-test-env))
          (account-alist (create-test-data))
          (budget (create-budget-and-transactions env account-alist))
-         (options (gnc:make-report-options uuid))
+         (options (gnc:make-report-options budget-uuid))
          (bank (cdr (assoc "Bank" account-alist))))
 
+    (display "\nbudget.scm\n")
     (set-option options "Accounts" "Account Display Depth" 'all)
 
     (set-option options "Display" "Show Difference" #f)
     (set-option options "Display" "Show Budget" #f)
     (set-option options "Display" "Show Actual" #f)
-    (let ((sxml (options->sxml options "basic all display off")))
+    (let ((sxml (options->sxml options budget-uuid "basic all display off")))
       (test-equal "all display OFF, table has 15 cells"
         15
         (length (sxml->table-row-col sxml 1 #f #f))))
@@ -105,7 +114,7 @@
     (set-option options "Display" "Show Budget" #t)
     (set-option options "Display" "Show Actual" #t)
     (set-option options "Display" "Show Column with Totals" #t)
-    (let ((sxml (options->sxml options "basic")))
+    (let ((sxml (options->sxml options budget-uuid "basic")))
       (test-equal "all display ON, table has 226 cells"
         226
         (length (sxml->table-row-col sxml 1 #f #f)))
@@ -128,7 +137,7 @@
     (set-option options "General" "Report for range of budget periods" #t)
     (set-option options "General" "Range start" 'current)
     (set-option options "General" "Range end" 'next)
-    (let ((sxml (options->sxml options "only next period")))
+    (let ((sxml (options->sxml options budget-uuid "only next period")))
       (test-equal "only next period - 133 cells"
         133
         (length (sxml->table-row-col sxml 1 #f #f)))
@@ -140,7 +149,7 @@
 
     (set-option options "General" "Range start" 'last)
     (set-option options "General" "Range end" 'last)
-    (let ((sxml (options->sxml options "only last period")))
+    (let ((sxml (options->sxml options budget-uuid "only last period")))
       (test-equal "only last period - 102 cells"
         102
         (length (sxml->table-row-col sxml 1 #f #f)))
@@ -156,7 +165,7 @@
     (set-option options "General" "Exact end period" 4)
     (set-option options "General" "Include collapsed periods before selected." #f)
     (set-option options "General" "Include collapsed periods after selected." #f)
-    (let ((sxml (options->sxml options "exact periods")))
+    (let ((sxml (options->sxml options budget-uuid "exact periods")))
       (test-equal "exact periods - 133 cells"
         133
         (length (sxml->table-row-col sxml 1 #f #f)))
@@ -167,9 +176,33 @@
         (sxml->table-row-col sxml 1 5 #f)))
 
     (set-option options "General" "Use accumulated amounts" #t)
-    (let ((sxml (options->sxml options "Use accumulated amounts")))
+    (let ((sxml (options->sxml options budget-uuid "Use accumulated amounts")))
       (test-equal "use accumulated amounts"
         '("Bank" "$60.00" "$15.00" "$45.00" "$60.00" "$82.00" "-$22.00"
           "$120.00" "$159.00" "-$39.00" "$120.00" "$159.00" "-$39.00")
         (sxml->table-row-col sxml 1 5 #f)))
     ))
+
+(define (test-budget-income-statement)
+  (let* ((env (create-test-env))
+         (account-alist (create-test-data))
+         (budget (create-budget-and-transactions env account-alist))
+         (options (gnc:make-report-options budget-is-uuid))
+         (bank (assoc-ref account-alist "Bank")))
+
+    (display "\nbudget-income-statement.scm\n")
+    (let ((sxml (options->sxml options budget-is-uuid "budget-is-basic")))
+      (test-equal "basic test"
+        72
+        (length (sxml->table-row-col sxml 1 #f #f)))
+
+      (test-equal "budgeted income amounts"
+        '("$195.00" "Income")
+        ((sxpath '(// table // (tr 1) // table // (tr 3) // *text*))
+         sxml))
+
+      (test-equal "net loss for budget"
+        '("Net loss for Budget test budget" "$285.00")
+        ((sxpath '(// table // (tr 2) // table // (tr 5) // *text*))
+         sxml)))))
+

commit 8f1c82e875d5d8152d0d96a228035fde5e1bb895
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Tue Oct 1 01:21:20 2019 +0800

    [cash-flow] use collector arithmetic

diff --git a/gnucash/report/standard-reports/cash-flow.scm b/gnucash/report/standard-reports/cash-flow.scm
index 9a35699d2..67e9a4752 100644
--- a/gnucash/report/standard-reports/cash-flow.scm
+++ b/gnucash/report/standard-reports/cash-flow.scm
@@ -196,8 +196,6 @@
         (let* ((tree-depth (if (equal? display-depth 'all)
                                (accounts-get-children-depth accounts)
                                display-depth))
-
-               (money-diff-collector (gnc:make-commodity-collector))
                (account-disp-list
                 (map
                  (lambda (account)
@@ -253,8 +251,6 @@
                                        account-full-name<?))
                   (money-out-alist (cdr (assq 'money-out-alist result)))
                   (money-out-collector (cdr (assq 'money-out-collector result))))
-              (money-diff-collector 'merge money-in-collector #f)
-              (money-diff-collector 'minusmerge money-out-collector #f)
 
               (gnc:html-document-add-object!
                doc
@@ -318,7 +314,8 @@
                 (gnc:make-html-table-header-cell/markup
                  "total-number-cell"
                  (gnc:sum-collector-commodity
-                  money-diff-collector report-currency exchange-fn))))
+                  (gnc:collector- money-in-collector money-out-collector)
+                  report-currency exchange-fn))))
 
               (gnc:html-document-add-object! doc table)
 

commit 34bb47e23f9beacf1d219b4fd7a7868d9d131ad4
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Tue Oct 1 00:06:48 2019 +0800

    [income-statement] compact functions

diff --git a/gnucash/report/standard-reports/income-statement.scm b/gnucash/report/standard-reports/income-statement.scm
index 444101339..55d45f73a 100644
--- a/gnucash/report/standard-reports/income-statement.scm
+++ b/gnucash/report/standard-reports/income-statement.scm
@@ -383,45 +383,40 @@
 	 (exchange-fn
 	  (gnc:case-exchange-fn price-source report-commodity end-date))
 	 )
-    
+
     ;; Wrapper to call gnc:html-table-add-labeled-amount-line!
     ;; with the proper arguments.
     (define (add-subtotal-line table pos-label neg-label signed-balance)
-      (let* ((neg? (and signed-balance
-			neg-label
-			(gnc-numeric-negative-p
-			 (gnc:gnc-monetary-amount
-			  (gnc:sum-collector-commodity
-			   signed-balance report-commodity exchange-fn)))))
-	     (label (if neg? (or neg-label pos-label) pos-label))
-	     (balance (if neg? (gnc:collector- signed-balance) signed-balance)))
-	(gnc:html-table-add-labeled-amount-line!
-	 table (* tree-depth 2) "primary-subheading" #f label 0 1 "total-label-cell"
-	 (gnc:sum-collector-commodity balance report-commodity exchange-fn)
-	 (1- (* tree-depth 2)) 1 "total-number-cell")))
-    
+      (let* ((neg? (and signed-balance neg-label
+                        (negative?
+                         (gnc:gnc-monetary-amount
+                          (gnc:sum-collector-commodity
+                           signed-balance report-commodity exchange-fn)))))
+             (label (if neg? (or neg-label pos-label) pos-label))
+             (balance (if neg? (gnc:collector- signed-balance) signed-balance)))
+        (gnc:html-table-add-labeled-amount-line!
+         table (* tree-depth 2) "primary-subheading" #f label 0 1 "total-label-cell"
+         (gnc:sum-collector-commodity balance report-commodity exchange-fn)
+         (1- (* tree-depth 2)) 1 "total-number-cell")))
+
     ;; wrapper around gnc:html-table-append-ruler!
     (define (add-rule table)
       (gnc:html-table-append-ruler! table (* 2 tree-depth)))
-    
-    (gnc:html-document-set-title! 
-     doc (format #f
-		  (string-append "~a ~a "
-				 (_ "For Period Covering ~a to ~a"))
-		  company-name report-title
+
+    (gnc:html-document-set-title!
+     doc (format #f (string-append "~a ~a " (_ "For Period Covering ~a to ~a"))
+                  company-name report-title
                   (qof-print-date start-date-printable)
                   (qof-print-date end-date)))
-    
+
     (if (null? accounts)
-	
-        ;; error condition: no accounts specified
-	;; is this *really* necessary??
-	;; i'd be fine with an all-zero P&L
-	;; that would, technically, be correct....
-        (gnc:html-document-add-object! 
-         doc 
-         (gnc:html-make-no-account-warning 
-	  reportname (gnc:report-id report-obj)))
+
+        ;; error condition: no accounts specified is this *really*
+        ;; necessary??  i'd be fine with an all-zero P&L that would,
+        ;; technically, be correct....
+        (gnc:html-document-add-object!
+         doc (gnc:html-make-no-account-warning
+              reportname (gnc:report-id report-obj)))
 
         ;; Get all the balances for each of the account types.
         (let* ((expense-total
@@ -530,82 +525,48 @@
            (string-append (_ "Net income") period-for)
            (string-append (_ "Net loss") period-for)
            net-income (* 2 (1- tree-depth)) exchange-fn #f #f)
-	  
-	  (gnc:html-document-add-object! 
-	   doc 
-	   (let* ((build-table (gnc:make-html-table)))
-	     (if two-column?     
-		 (gnc:html-table-append-row!
-		  build-table
-		  (if standard-order?
-		      (list
-		       (gnc:make-html-table-cell inc-table)
-		       (if (null? trading-accounts)
-			   (gnc:html-make-empty-cell)
-		           (gnc:make-html-table-cell tra-table))
-		       (gnc:make-html-table-cell exp-table)
-		       )
-		      (list
-		       (gnc:make-html-table-cell exp-table)
-		       (gnc:make-html-table-cell inc-table)
-		       (if (null? trading-accounts)
-			   (gnc:html-make-empty-cell)
-		           (gnc:make-html-table-cell tra-table))
-		       )
-		      )
-		  )
-		 (if standard-order?
-		     (begin
-		       (gnc:html-table-append-row!
-			build-table
-			(list (gnc:make-html-table-cell inc-table)))
-		       (if (not (null? trading-accounts))
-		           (gnc:html-table-append-row!
-			    build-table
-			    (list (gnc:make-html-table-cell tra-table))))
-		       (gnc:html-table-append-row!
-			build-table
-			(list (gnc:make-html-table-cell exp-table)))
-		       )
-		     (begin
-		       (gnc:html-table-append-row!
-			build-table
-			(list (gnc:make-html-table-cell exp-table)))
-		       (gnc:html-table-append-row!
-			build-table
-			(list (gnc:make-html-table-cell inc-table)))
-		       (if (not (null? trading-accounts))
-		           (gnc:html-table-append-row!
-			    build-table
-			    (list (gnc:make-html-table-cell tra-table))))
-		       )
-		     )
-		 )
-	     
-	     (gnc:html-table-set-style!
-	      build-table "td"
-	      'attribute '("align" "left")
-	      'attribute '("valign" "top"))
-	     build-table
-	     )
-	   )
-  
-	  
-	  
+
+          ;; add the sections in the desired order to document
+          (let ((build-table (gnc:make-html-table))
+                (inc-cell (gnc:make-html-table-cell inc-table))
+                (tra-cell (if (null? trading-accounts)
+                              (gnc:html-make-empty-cell)
+                              (gnc:make-html-table-cell tra-table)))
+                (exp-cell (gnc:make-html-table-cell exp-table)))
+            (define (add-cells . lst) (gnc:html-table-append-row! build-table lst))
+            (cond
+             ((and two-column? standard-order?)
+              (add-cells inc-cell tra-cell exp-cell))
+
+             (two-column?
+              (add-cells exp-cell inc-cell tra-cell))
+
+             (standard-order?
+              (add-cells inc-cell)
+              (unless (null? trading-accounts) (add-cells tra-cell))
+              (add-cells exp-cell))
+
+             (else
+              (add-cells exp-cell)
+              (add-cells inc-cell)
+              (unless (null? trading-accounts) (add-cells tra-cell))))
+
+            (gnc:html-table-set-style!
+             build-table "td"
+             'attribute '("align" "left")
+             'attribute '("valign" "top"))
+            (gnc:html-document-add-object! doc build-table))
+
           ;; add currency information if requested
-	  (gnc:report-percent-done 90)
-          (if show-rates?
-              (gnc:html-document-add-object! 
-               doc ;;(gnc:html-markup-p)
-               (gnc:html-make-exchangerates 
-                report-commodity exchange-fn accounts)))
-	  (gnc:report-percent-done 100)
-	  
-	  )
-	)
-    
+          (gnc:report-percent-done 90)
+          (when show-rates?
+            (gnc:html-document-add-object!
+             doc (gnc:html-make-exchangerates
+                  report-commodity exchange-fn accounts)))
+          (gnc:report-percent-done 100)))
+
     (gnc:report-finished)
-    
+
     doc))
 
 (define is-reportname (N_ "Income Statement"))

commit bf202d14614aa8bc7bdde063851f345ceb15101f
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Mon Sep 30 23:50:08 2019 +0800

    [income-statement] use collector arithmetic, define vars in formals

diff --git a/gnucash/report/standard-reports/income-statement.scm b/gnucash/report/standard-reports/income-statement.scm
index 2a9918c8d..444101339 100644
--- a/gnucash/report/standard-reports/income-statement.scm
+++ b/gnucash/report/standard-reports/income-statement.scm
@@ -422,32 +422,71 @@
          doc 
          (gnc:html-make-no-account-warning 
 	  reportname (gnc:report-id report-obj)))
-	
+
         ;; Get all the balances for each of the account types.
-        (let* ((revenue-closing #f)
-	       (expense-closing #f)
-	       (neg-revenue-total #f)
-	       (revenue-total #f)
-	       (expense-total #f)
-	       (trading-total #f)
-	       (net-income #f)
-	       
-               ;; Create the account tables below where their
-               ;; percentage time can be tracked.
-	       (inc-table (gnc:make-html-table)) ;; gnc:html-table
-	       (exp-table (gnc:make-html-table))
-	       (tra-table (gnc:make-html-table))
-
-	       (table-env #f)                      ;; parameters for :make-
-	       (params #f)                         ;; and -add-account-
-               (revenue-table #f)                  ;; gnc:html-acct-table
-               (expense-table #f)                  ;; gnc:html-acct-table
-               (trading-table #f)
+        (let* ((expense-total
+                (gnc:collector-
+                 (gnc:accountlist-get-comm-balance-interval-with-closing
+                  expense-accounts start-date end-date)
+                 (gnc:account-get-trans-type-balance-interval-with-closing
+                  expense-accounts closing-pattern start-date end-date)))
+
+               (revenue-total
+                (gnc:collector-
+                 (gnc:account-get-trans-type-balance-interval-with-closing
+                  revenue-accounts closing-pattern start-date end-date)
+                 (gnc:accountlist-get-comm-balance-interval-with-closing
+                  revenue-accounts start-date end-date)))
+
+               (trading-total
+                (gnc:accountlist-get-comm-balance-interval-with-closing
+                 trading-accounts start-date end-date))
+
+               (net-income
+                (gnc:collector+ revenue-total
+                                trading-total
+                                (gnc:collector- expense-total)))
+
+               (inc-table (gnc:make-html-table))
+               (exp-table (gnc:make-html-table))
+               (tra-table (gnc:make-html-table))
+
+               (table-env
+                (list
+                 (list 'start-date start-date)
+                 (list 'end-date end-date)
+                 (list 'display-tree-depth tree-depth)
+                 (list 'depth-limit-behavior (if bottom-behavior 'flatten 'summarize))
+                 (list 'report-commodity report-commodity)
+                 (list 'exchange-fn exchange-fn)
+                 (list 'parent-account-subtotal-mode parent-total-mode)
+                 (list 'zero-balance-mode
+                       (if show-zb-accts? 'show-leaf-acct 'omit-leaf-acct))
+                 (list 'account-label-mode (if use-links? 'anchor 'name))
+                 ;; we may, at some point, want to add an option to
+                 ;; generate a pre-adjustment income statement...
+                 (list 'balance-mode 'pre-closing)
+                 (list 'closing-pattern closing-pattern)))
+
+               (params
+                (list
+                 (list 'parent-account-balance-mode parent-balance-mode)
+                 (list 'zero-balance-display-mode
+                       (if omit-zb-bals? 'omit-balance 'show-balance))
+                 (list 'multicommodity-mode (and show-fcur? 'table))
+                 (list 'rule-mode use-rules?)))
+
+               (revenue-table
+                (gnc:make-html-acct-table/env/accts table-env revenue-accounts))
+               (expense-table
+                (gnc:make-html-acct-table/env/accts table-env expense-accounts))
+               (trading-table
+                (gnc:make-html-acct-table/env/accts table-env trading-accounts))
 
                (period-for (string-append " " (_ "for Period"))))
 
           ;; a helper to add a line to our report
-          (define (report-line
+          (define (add-report-line
                    table pos-label neg-label amount col
                    exchange-fn rule? row-style)
             (let* ((mon (gnc:sum-collector-commodity
@@ -461,123 +500,36 @@
                label                0  1 "text-cell"
                bal          (+ col 1)  1 "number-cell")))
 
-          ;; sum revenues and expenses
-	  (set! revenue-closing
-		(gnc:account-get-trans-type-balance-interval-with-closing
-		 revenue-accounts closing-pattern
-		 start-date end-date)
-		) ;; this is norm positive (debit)
-	  (set! expense-closing
-		(gnc:account-get-trans-type-balance-interval-with-closing
-		 expense-accounts closing-pattern
-		 start-date end-date)
-		) ;; this is norm negative (credit)
-	  (set! expense-total
-		(gnc:accountlist-get-comm-balance-interval-with-closing
-		 expense-accounts
-		 start-date end-date))
-	  (expense-total 'minusmerge expense-closing #f)
-	  (set! neg-revenue-total
-		(gnc:accountlist-get-comm-balance-interval-with-closing
-		 revenue-accounts
-		 start-date end-date))
-	  (neg-revenue-total 'minusmerge revenue-closing #f)
-	  (set! revenue-total (gnc:make-commodity-collector))
-	  (revenue-total 'minusmerge neg-revenue-total #f)
-          (set! trading-total 
-                (gnc:accountlist-get-comm-balance-interval-with-closing
-                 trading-accounts
-                 start-date end-date))
-	  ;; calculate net income
-	  (set! net-income (gnc:make-commodity-collector))
-	  (net-income 'merge revenue-total #f)
-	  (net-income 'merge trading-total #f)
-	  (net-income 'minusmerge expense-total #f)
-	  
-	  (set! table-env
-		(list
-		 (list 'start-date start-date)
-		 (list 'end-date end-date)
-		 (list 'display-tree-depth tree-depth)
-		 (list 'depth-limit-behavior (if bottom-behavior
-						 'flatten
-						 'summarize))
-		 (list 'report-commodity report-commodity)
-		 (list 'exchange-fn exchange-fn)
-		 (list 'parent-account-subtotal-mode parent-total-mode)
-		 (list 'zero-balance-mode (if show-zb-accts?
-					      'show-leaf-acct
-					      'omit-leaf-acct))
-		 (list 'account-label-mode (if use-links?
-					       'anchor
-					       'name))
-		 ;; we may, at some point, want to add an option to
-		 ;; generate a pre-adjustment income statement...
-		 (list 'balance-mode 'pre-closing)
-		 (list 'closing-pattern closing-pattern)
-		 )
-		)
-	  (set! params
-		(list
-		 (list 'parent-account-balance-mode parent-balance-mode)
-		 (list 'zero-balance-display-mode (if omit-zb-bals?
-						      'omit-balance
-						      'show-balance))
-		 (list 'multicommodity-mode (if show-fcur? 'table #f))
-		 (list 'rule-mode use-rules?)
-		  )
-		)
-	  
-	  (let ((space (make-list tree-depth (gnc:make-html-table-cell/min-width 60))))
+          (let ((space (make-list tree-depth (gnc:make-html-table-cell/min-width 60))))
             (gnc:html-table-append-row! inc-table space)
             (gnc:html-table-append-row! exp-table space)
             (gnc:html-table-append-row! tra-table space))
-
-	  (gnc:report-percent-done 80)
-	  (if label-revenue?
-	      (add-subtotal-line inc-table (_ "Revenues") #f #f))
-	  (set! revenue-table
-		(gnc:make-html-acct-table/env/accts
-		 table-env revenue-accounts))
-	  (gnc:html-table-add-account-balances
-	   inc-table revenue-table params)
-          (if total-revenue?
-	      (add-subtotal-line 
-	       inc-table (_ "Total Revenue") #f revenue-total))
-	  
-	  (gnc:report-percent-done 85)
-	  (if label-expense?
-	      (add-subtotal-line 
-	       exp-table (_ "Expenses") #f #f))
-	  (set! expense-table
-		(gnc:make-html-acct-table/env/accts
-		 table-env expense-accounts))
-	  (gnc:html-table-add-account-balances
-	   exp-table expense-table params)
-	  (if total-expense?
-	      (add-subtotal-line
-	       exp-table (_ "Total Expenses") #f expense-total))
-	       
-	  (if label-trading?
-              (add-subtotal-line tra-table (_ "Trading") #f #f))
-	  (set! trading-table
-	        (gnc:make-html-acct-table/env/accts
-	         table-env trading-accounts))
-	  (gnc:html-table-add-account-balances
-	   tra-table trading-table params)
-	  (if total-trading?
-              (add-subtotal-line
-	       tra-table (_ "Total Trading") #f trading-total))
-	  
-	  (report-line
-	   (if standard-order? 
-	       exp-table 
-	       inc-table)
-	   (string-append (_ "Net income") period-for)
-	   (string-append (_ "Net loss") period-for)
-	   net-income
-	   (* 2 (- tree-depth 1)) exchange-fn #f #f
-	   )
+          (gnc:report-percent-done 80)
+
+          (when label-revenue?
+            (add-subtotal-line inc-table (_ "Revenues") #f #f))
+          (gnc:html-table-add-account-balances inc-table revenue-table params)
+          (when total-revenue?
+            (add-subtotal-line inc-table (_ "Total Revenue") #f revenue-total))
+          (gnc:report-percent-done 85)
+
+          (when label-expense?
+            (add-subtotal-line exp-table (_ "Expenses") #f #f))
+          (gnc:html-table-add-account-balances exp-table expense-table params)
+          (when total-expense?
+            (add-subtotal-line exp-table (_ "Total Expenses") #f expense-total))
+
+          (when label-trading?
+            (add-subtotal-line tra-table (_ "Trading") #f #f))
+          (gnc:html-table-add-account-balances tra-table trading-table params)
+          (when total-trading?
+            (add-subtotal-line tra-table (_ "Total Trading") #f trading-total))
+
+          (add-report-line
+           (if standard-order? exp-table inc-table)
+           (string-append (_ "Net income") period-for)
+           (string-append (_ "Net loss") period-for)
+           net-income (* 2 (1- tree-depth)) exchange-fn #f #f)
 	  
 	  (gnc:html-document-add-object! 
 	   doc 

commit 621c857b6a3df6a75b390f9cad6838dd80ea5db4
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Mon Sep 30 23:36:59 2019 +0800

    [income-statement] remove dead code, compact function
    
    column and balance were unused. compact function.

diff --git a/gnucash/report/standard-reports/income-statement.scm b/gnucash/report/standard-reports/income-statement.scm
index d5477685d..2a9918c8d 100644
--- a/gnucash/report/standard-reports/income-statement.scm
+++ b/gnucash/report/standard-reports/income-statement.scm
@@ -445,43 +445,23 @@
                (trading-table #f)
 
                (period-for (string-append " " (_ "for Period"))))
-	  
-	  ;; a helper to add a line to our report
-	  (define (report-line
-		   table pos-label neg-label amount col
-		   exchange-fn rule? row-style)
-	    (let* ((neg? (and amount
-			      neg-label
-			      (gnc-numeric-negative-p
-			       (gnc:gnc-monetary-amount
-				(gnc:sum-collector-commodity
-				 amount report-commodity exchange-fn)))))
-		   (label (if neg? (or neg-label pos-label) pos-label))
-		   (pos-bal (if neg?
-				(let ((bal (gnc:make-commodity-collector)))
-				  (bal 'minusmerge amount #f)
-				  bal)
-				amount))
-		   (bal (gnc:sum-collector-commodity
-			 pos-bal report-commodity exchange-fn))
-		   (balance
-		    (or (and (gnc:uniform-commodity? pos-bal report-commodity)
-			     bal)
-			(and show-fcur?
-			     (gnc-commodity-table
-			      pos-bal report-commodity exchange-fn))
-			bal
-			))
-		   (column (or col 0))
-		   )
-	      (gnc:html-table-add-labeled-amount-line!
-	       table (* 2 tree-depth)  row-style rule?
-	       label                0  1 "text-cell"
-	       bal          (+ col 1)  1 "number-cell")
-	      )
-	    )
-	  
-	  ;; sum revenues and expenses
+
+          ;; a helper to add a line to our report
+          (define (report-line
+                   table pos-label neg-label amount col
+                   exchange-fn rule? row-style)
+            (let* ((mon (gnc:sum-collector-commodity
+                         amount report-commodity exchange-fn))
+                   (neg? (and amount neg-label
+                              (negative? (gnc:gnc-monetary-amount mon))))
+                   (label (if neg? (or neg-label pos-label) pos-label))
+                   (bal (if neg? (gnc:monetary-neg mon) mon)))
+              (gnc:html-table-add-labeled-amount-line!
+               table (* 2 tree-depth)  row-style rule?
+               label                0  1 "text-cell"
+               bal          (+ col 1)  1 "number-cell")))
+
+          ;; sum revenues and expenses
 	  (set! revenue-closing
 		(gnc:account-get-trans-type-balance-interval-with-closing
 		 revenue-accounts closing-pattern



Summary of changes:
 gnucash/report/reports/standard/budget-flow.scm    |   3 +-
 .../reports/standard/budget-income-statement.scm   | 437 +++++++++-----------
 gnucash/report/reports/standard/budget.scm         |   6 +-
 gnucash/report/reports/standard/cash-flow.scm      |   7 +-
 .../report/reports/standard/income-statement.scm   | 439 ++++++++-------------
 .../report/reports/standard/test/test-budget.scm   |  85 ++--
 .../reports/standard/test/test-stress-options.scm  |   4 +-
 libgnucash/engine/test/test-engine-extras.scm      |  30 ++
 8 files changed, 427 insertions(+), 584 deletions(-)



More information about the gnucash-changes mailing list