gnucash maint: Multiple changes pushed

Christopher Lam clam at code.gnucash.org
Sun Sep 29 02:15:28 EDT 2019


Updated	 via  https://github.com/Gnucash/gnucash/commit/aae1143e (commit)
	 via  https://github.com/Gnucash/gnucash/commit/08b1ee37 (commit)
	from  https://github.com/Gnucash/gnucash/commit/1be9bfbf (commit)



commit aae1143e34d587e615d97e91592ad324ca9ccc57
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sun Sep 29 13:45:34 2019 +0800

    [budget-income-statement] compact functions

diff --git a/gnucash/report/standard-reports/budget-income-statement.scm b/gnucash/report/standard-reports/budget-income-statement.scm
index ad16d6483..98cc16a07 100644
--- a/gnucash/report/standard-reports/budget-income-statement.scm
+++ b/gnucash/report/standard-reports/budget-income-statement.scm
@@ -303,24 +303,13 @@
      (gnc:lookup-option 
       (gnc:report-options report-obj) pagename optname)))
   
-  (define
-    (get-assoc-account-balances-budget
-      budget
-      accountlist
-      period-start
-      period-end
-      get-balance-fn)
+  (define (get-assoc-account-balances-budget
+           budget accountlist period-start period-end get-balance-fn)
     (gnc:get-assoc-account-balances
-      accountlist
-      (lambda (account)
-        (get-balance-fn budget account period-start period-end))))
-
-  (define
-    (get-budget-account-budget-balance
-      budget
-      account
-      period-start
-      period-end)
+     accountlist (lambda (account)
+                   (get-balance-fn budget account period-start period-end))))
+
+  (define (get-budget-account-budget-balance budget account period-start period-end)
     (gnc:budget-account-get-net budget account period-start period-end))
 
   (gnc:report-starting reportname)
@@ -429,9 +418,7 @@
 			   signed-balance report-commodity exchange-fn)))))
 	     (label (if neg? (or neg-label pos-label) pos-label))
 	     (balance (if neg?
-			  (let ((bal (gnc:make-commodity-collector)))
-			    (bal 'minusmerge signed-balance #f)
-			    bal)
+                          (gnc:collector- signed-balance)
 			  signed-balance))
 	     )
 	(gnc:html-table-add-labeled-amount-line!
@@ -530,20 +517,16 @@
 				 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)
+                                (gnc:collector- amount)
 				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
-			))
+                         pos-bal report-commodity exchange-fn))
+                   (balance
+                    (cond
+                     ((gnc:uniform-commodity? pos-bal report-commodity) bal)
+                     (show-fcur? (gnc-commodity-table pos-bal report-commodity
+                                                      exchange-fn))
+                     (else bal)))
 		   (column (or col 0))
 		   )
 	      (gnc:html-table-add-labeled-amount-line!
@@ -553,10 +536,8 @@
 	      )
 	    )
 
-
 	  (gnc:report-percent-done 5)
 
-
           ;; Pre-fetch expense account balances.
           (set! expense-account-balances
             (get-assoc-account-balances-budget
@@ -575,10 +556,8 @@
             (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
@@ -599,15 +578,11 @@
               (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:make-commodity-collector))
-	  (net-income 'merge revenue-total #f)
-	  (net-income 'minusmerge expense-total #f)
-	  
+	  (set! net-income
+            (gnc:collector- revenue-total expense-total))
 
 	  (gnc:report-percent-done 30)
 

commit 08b1ee371100497ddaa2711bb22ea19409e72ea9
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sun Sep 29 13:36:10 2019 +0800

    [budget-balance-sheet] remove dead code, use collector arithmetic

diff --git a/gnucash/report/standard-reports/budget-balance-sheet.scm b/gnucash/report/standard-reports/budget-balance-sheet.scm
index 074d0faa9..18afbe328 100644
--- a/gnucash/report/standard-reports/budget-balance-sheet.scm
+++ b/gnucash/report/standard-reports/budget-balance-sheet.scm
@@ -259,17 +259,9 @@
   (define (get-budget-account-budget-balance budget account)
     (gnc:budget-account-get-net budget account #f #f))
 
-  (define (get-budget-account-budget-balance-negated budget account)
-    (gnc:commodity-collector-get-negated
-      (get-budget-account-budget-balance budget account)))
-
   (define (get-budget-account-initial-balance budget account)
     (gnc:budget-account-get-initial-balance budget account))
 
-  (define (get-budget-account-initial-balance-negated budget account)
-    (gnc:commodity-collector-get-negated
-      (get-budget-account-initial-balance budget account)))
-
   (define (get-budget-accountlist-budget-balance budget accountlist)
     (gnc:budget-accountlist-get-net budget accountlist #f #f))
 
@@ -282,25 +274,11 @@
     (gnc:commodity-collector-get-negated
       (gnc:get-assoc-account-balances-total account-balances)))
 
-  (define
-    (sum-prefetched-account-balances-for-account
-      initial-balances budget-balances account)
-    (let*
-      (
-        (initial-balance
-          (gnc:select-assoc-account-balance initial-balances account))
-        (budget-balance
-          (gnc:select-assoc-account-balance budget-balances account))
-        (total-balance
-          (if (or (not initial-balance) (not budget-balance))
-            #f
-            (gnc:make-commodity-collector))))
-      (if
-        total-balance
-        (begin
-          (total-balance 'merge initial-balance #f)
-          (total-balance 'merge budget-balance #f)))
-      total-balance))
+  (define (sum-prefetched-account-balances-for-account
+           initial-balances budget-balances account)
+    (let ((initial (gnc:select-assoc-account-balance initial-balances account))
+          (budget (gnc:select-assoc-account-balance budget-balances account)))
+      (and initial budget (gnc:collector+ initial budget))))
 
   (gnc:report-starting reportname)
   
@@ -393,9 +371,7 @@
 			   signed-balance report-commodity exchange-fn)))))
 	     (label (if neg? (or neg-label pos-label) pos-label))
 	     (balance (if neg?
-			  (let ((bal (gnc:make-commodity-collector)))
-			    (bal 'minusmerge signed-balance #f)
-			    bal)
+                          (gnc:collector- signed-balance)
 			  signed-balance))
 	     )
 	(gnc:html-table-add-labeled-amount-line!
@@ -573,50 +549,33 @@
             (gnc:commodity-collector-get-negated liability-repayments))
 
 	  ;; Total liabilities.
-	  (set! liability-balance (gnc:make-commodity-collector))
-          (liability-balance 'merge existing-liabilities #f)
-          (liability-balance 'merge new-liabilities #f)
-
+	  (set! liability-balance
+            (gnc:collector+ existing-liabilities new-liabilities))
 
 	  (gnc:report-percent-done 12)
 
-
           ;; Total existing retained earnings.
           ;; existing retained earnings = initial income - initial expenses
-          (set! existing-retained-earnings (gnc:make-commodity-collector))
-          ;; Income is negative; negate to add.
-          (existing-retained-earnings 'minusmerge
-            (gnc:budget-accountlist-get-initial-balance budget income-accounts)
-            #f)
-          ;; Expenses are positive; negate to subtract.
-          (existing-retained-earnings 'minusmerge
-            (gnc:budget-accountlist-get-initial-balance budget expense-accounts)
-            #f)
-
+          (set! existing-retained-earnings
+            (gnc:collector-
+             (gnc:collector+
+              (gnc:budget-accountlist-get-initial-balance budget income-accounts)
+              (gnc:budget-accountlist-get-initial-balance budget expense-accounts))))
 
 	  (gnc:report-percent-done 14)
 
-
           ;; Total new retained earnings.
-          (set! new-retained-earnings (gnc:make-commodity-collector))
-          ;; Budgeted income is positive; add.
-          (new-retained-earnings 'merge
-            (get-budget-accountlist-budget-balance budget income-accounts)
-            #f)
-          ;; Budgeted expenses are positive; negate to subtract.
-          (new-retained-earnings 'minusmerge
-            (get-budget-accountlist-budget-balance budget expense-accounts)
-            #f)
+          (set! new-retained-earnings
+            (gnc:collector-
+             (get-budget-accountlist-budget-balance budget income-accounts)
+             (get-budget-accountlist-budget-balance budget expense-accounts)))
 
           ;; Total retained earnings.
-          (set! retained-earnings (gnc:make-commodity-collector))
-          (retained-earnings 'merge existing-retained-earnings #f)
-          (retained-earnings 'merge new-retained-earnings #f)
-
+          (set! retained-earnings
+            (gnc:collector+ existing-retained-earnings new-retained-earnings))
 
 	  (gnc:report-percent-done 16)
 
-
           ;; Total existing assets.
           (set! existing-assets
             (gnc:get-assoc-account-balances-total
@@ -630,77 +589,56 @@
           ;; Total unallocated assets.
           ;; unallocated-assets =
           ;;  new-retained-earnings - allocated-assets - liability-repayments
-          (set! unallocated-assets (gnc:make-commodity-collector))
-          (unallocated-assets 'merge new-retained-earnings #f)
-          (unallocated-assets 'minusmerge allocated-assets #f)
-          (unallocated-assets 'minusmerge liability-repayments #f)
+          (set! unallocated-assets
+            (gnc:collector- new-retained-earnings
+                            allocated-assets
+                            liability-repayments))
 
           ;; Total assets.
-	  (set! asset-balance (gnc:make-commodity-collector))
-          (asset-balance 'merge existing-assets #f)
-          (asset-balance 'merge allocated-assets #f)
-          (asset-balance 'merge unallocated-assets #f)
-
+	  (set! asset-balance
+            (gnc:collector+ existing-assets allocated-assets unallocated-assets))
 
 	  (gnc:report-percent-done 18)
 
-
           ;; Calculate unrealized gains.
-          (set! unrealized-gain (gnc:make-commodity-collector))
-          (let*
-            (
-              (get-total-value-fn
-                (lambda (account)
-                  (gnc:account-get-comm-value-at-date account date-t64 #f)))
-              (asset-basis
-                (gnc:accounts-get-comm-total-assets
-                  asset-accounts get-total-value-fn))
-              (liability-basis
-                (gnc:commodity-collector-get-negated
+          (let* ((get-total-value-fn
+                  (lambda (account)
+                    (gnc:account-get-comm-value-at-date account date-t64 #f)))
+                 (asset-basis
                   (gnc:accounts-get-comm-total-assets
-                    liability-accounts get-total-value-fn)))
-            )
-
-            ;; Calculate unrealized gains from assets.
-            (unrealized-gain 'merge existing-assets #f)
-            (unrealized-gain 'minusmerge asset-basis #f)
-
-            ;; Combine with unrealized gains from liabilities
-            (unrealized-gain 'minusmerge existing-liabilities #f)
-            (unrealized-gain 'merge liability-basis #f))
+                   asset-accounts get-total-value-fn))
+                 (liability-basis
+                  (gnc:collector-
+                   (gnc:accounts-get-comm-total-assets
+                    liability-accounts get-total-value-fn))))
 
+            (set! unrealized-gain
+              (gnc:collector-
+               (gnc:collector- existing-assets asset-basis)
+               (gnc:collector- existing-liabilities liability-basis))))
 
 	  (gnc:report-percent-done 22)
 
-
           ;; Total existing equity; negative.
           (set! existing-equity
-            (get-assoc-account-balances-total-negated
-              equity-account-initial-balances))
-          ;; Include existing retained earnings.
-          (existing-equity 'merge existing-retained-earnings #f)
-          ;; Include unrealized gains.
-          (existing-equity 'merge unrealized-gain #f)
-
+            (gnc:collector+
+             (get-assoc-account-balances-total-negated equity-account-initial-balances)
+             existing-retained-earnings
+             unrealized-gain))
 
           ;; Total new equity; positive.
           (set! new-equity
-            (gnc:get-assoc-account-balances-total
-              equity-account-budget-balances))
-          ;; Include new retained earnings.
-          (new-equity 'merge new-retained-earnings #f)
-
+            (gnc:collector+
+             (gnc:get-assoc-account-balances-total equity-account-budget-balances)
+             new-retained-earnings))
 
           ;; Total equity.
-	  (set! equity-balance (gnc:make-commodity-collector))
-	  (equity-balance 'merge existing-equity #f)
-	  (equity-balance 'merge new-equity #f)
+	  (set! equity-balance
+            (gnc:collector+ existing-equity new-equity))
 
           ;; Total liability + equity.
-	  (set! liability-plus-equity (gnc:make-commodity-collector))
-	  (liability-plus-equity 'merge liability-balance #f)
-	  (liability-plus-equity 'merge equity-balance #f)
-	  
+	  (set! liability-plus-equity
+            (gnc:collector+ liability-balance equity-balance))
 
 	  (gnc:report-percent-done 30)
 	  



Summary of changes:
 .../standard-reports/budget-balance-sheet.scm      | 160 +++++++--------------
 .../standard-reports/budget-income-statement.scm   |  59 +++-----
 2 files changed, 66 insertions(+), 153 deletions(-)



More information about the gnucash-changes mailing list