gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Sat Sep 21 01:52:04 EDT 2019
Updated via https://github.com/Gnucash/gnucash/commit/496ca94a (commit)
via https://github.com/Gnucash/gnucash/commit/f72df3e1 (commit)
via https://github.com/Gnucash/gnucash/commit/7587c3b4 (commit)
via https://github.com/Gnucash/gnucash/commit/0511ce72 (commit)
from https://github.com/Gnucash/gnucash/commit/7a662272 (commit)
commit 496ca94a989d0001a64c19f5e2104ae02fe1a604
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Sep 20 22:43:00 2019 +0800
[reports] use new API gnc:collector+ and gnc:collector-
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 2ba1f71b8..e0ab202cd 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -262,11 +262,6 @@
(member (xaccSplitGetAccount s) accounts))
splits))))
-(define (coll-minus minuend subtrahend)
- (let ((coll (gnc:make-commodity-collector)))
- (coll 'merge minuend #f)
- (coll 'minusmerge subtrahend #f)
- coll))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -348,7 +343,7 @@
(sales (gnc:commodity-collector-get-negated
(filter-splits splits sales-accounts)))
(expense (filter-splits splits expense-accounts))
- (profit (coll-minus sales expense)))
+ (profit (gnc:collector- sales expense)))
(list owner profit sales expense)))
ownerlist))
(sortingtable '()))
@@ -403,9 +398,10 @@
;; Add the "No Customer" lines to the sortingtable for sorting
;; as well
- (let* ((other-sales (coll-minus toplevel-total-sales total-sales))
- (other-expense (coll-minus toplevel-total-expense total-expense))
- (other-profit (coll-minus other-sales other-expense)))
+ (let* ((other-sales (gnc:collector- toplevel-total-sales total-sales))
+ (other-expense (gnc:collector- toplevel-total-expense
+ total-expense))
+ (other-profit (gnc:collector- other-sales other-expense)))
(for-each
(lambda (comm)
(let* ((profit (cadr (other-profit 'getpair comm #f)))
@@ -479,7 +475,8 @@
(gnc:make-html-text (gnc:html-markup/attr/no-end "hr" "noshade")))))
;; Summary lines - 1 per currency
- (let ((total-profit (coll-minus toplevel-total-sales toplevel-total-expense)))
+ (let ((total-profit (gnc:collector- toplevel-total-sales
+ toplevel-total-expense)))
(for-each
(lambda (comm)
(let* ((profit (cadr (total-profit 'getpair comm #f)))
diff --git a/gnucash/report/standard-reports/balsheet-pnl.scm b/gnucash/report/standard-reports/balsheet-pnl.scm
index 6f9b3b8d6..bca8f5ad4 100644
--- a/gnucash/report/standard-reports/balsheet-pnl.scm
+++ b/gnucash/report/standard-reports/balsheet-pnl.scm
@@ -961,9 +961,8 @@ also show overall period profit & loss."))
asset-liability
(lambda (acc)
(gnc:account-get-comm-value-at-date acc date #f))))
- (unrealized (gnc:make-commodity-collector)))
- (unrealized 'merge asset-liability-basis #f)
- (unrealized 'minusmerge asset-liability-balance #f)
+ (unrealized (gnc:collector- asset-liability-basis
+ asset-liability-balance)))
(monetaries->exchanged
unrealized common-currency price-source date)))))
(retained-earnings-fn
diff --git a/gnucash/report/standard-reports/category-barchart.scm b/gnucash/report/standard-reports/category-barchart.scm
index 0da882b7d..c217a138c 100644
--- a/gnucash/report/standard-reports/category-barchart.scm
+++ b/gnucash/report/standard-reports/category-barchart.scm
@@ -341,12 +341,6 @@ developing over time"))
c report-currency
(lambda (a b) (exchange-fn a b date)))))))
- (define (collector-minus a b)
- (let ((coll (gnc:make-commodity-collector)))
- (coll 'merge a #f)
- (coll 'minusmerge b #f)
- coll))
-
;; copy of gnc:not-all-zeros using gnc-monetary
(define (not-all-zeros data)
(cond ((gnc:gnc-monetary? data) (not (zero? (gnc:gnc-monetary-amount data))))
@@ -401,8 +395,8 @@ developing over time"))
(cdr dates-list)
(cons (if do-intervals?
(collector->monetary
- (collector-minus (cadr list-of-mon-collectors)
- (car list-of-mon-collectors))
+ (gnc:collector- (cadr list-of-mon-collectors)
+ (car list-of-mon-collectors))
(cadr dates-list))
(collector->monetary
(car list-of-mon-collectors)
diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm
index d7574a233..396103b2d 100644
--- a/gnucash/report/standard-reports/net-charts.scm
+++ b/gnucash/report/standard-reports/net-charts.scm
@@ -267,12 +267,6 @@
;; conversion function above. Returns a list of gnc-monetary.
(define (process-datelist account-balances dates left-col?)
- (define (collector-minus coll1 coll2)
- (let ((res (gnc:make-commodity-collector)))
- (res 'merge coll1 #f)
- (res 'minusmerge coll2 #f)
- res))
-
(define accountlist
(if inc-exp?
(if left-col?
@@ -310,7 +304,7 @@
(cons
(collector->monetary
(if inc-exp?
- (collector-minus (car acct-balances) (cadr acct-balances))
+ (gnc:collector- (car acct-balances) (cadr acct-balances))
(car acct-balances))
(if inc-exp? (cadr dates) (car dates)))
result)))))
diff --git a/gnucash/report/standard-reports/trial-balance.scm b/gnucash/report/standard-reports/trial-balance.scm
index fd726ee71..e9cfeeac1 100644
--- a/gnucash/report/standard-reports/trial-balance.scm
+++ b/gnucash/report/standard-reports/trial-balance.scm
@@ -316,19 +316,6 @@
options))
-;; (coll-plus collectors ...) equiv to (+ collectors ...)
-(define (coll-plus . collectors)
- (let ((res (gnc:make-commodity-collector)))
- (for-each (lambda (coll) (res 'merge coll #f)) collectors)
- res))
-
-;; (coll-minus collectors ...) equiv to (- collector0 collector1 ...)
-(define (coll-minus . collectors)
- (let ((res (gnc:make-commodity-collector)))
- (res 'merge (car collectors) #f)
- (for-each (lambda (coll) (res 'minusmerge coll #f)) (cdr collectors))
- res))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; trial-balance-renderer
;; set up the document and add the table
@@ -531,7 +518,7 @@
(let* ((cost-fn (gnc:case-exchange-fn
'average-cost report-commodity end-date))
(acct-balances (map acct->bal all-accounts))
- (book-balance (apply coll-plus acct-balances))
+ (book-balance (apply gnc:collector+ acct-balances))
(value (gnc:sum-collector-commodity
book-balance report-commodity exchange-fn))
(cost (gnc:sum-collector-commodity
@@ -674,17 +661,19 @@
(pos-adjusting
(and ga-or-is? (sum-account-splits acct adjusting-splits #t)))
(neg-adjusting
- (and ga-or-is? (coll-minus adjusting pos-adjusting)))
- (pre-closing-bal (coll-minus curr-bal closing))
- (pre-adjusting-bal (coll-minus pre-closing-bal adjusting))
+ (and ga-or-is? (gnc:collector- adjusting pos-adjusting)))
+ (pre-closing-bal (gnc:collector- curr-bal closing))
+ (pre-adjusting-bal (gnc:collector- pre-closing-bal
+ adjusting))
(atb (cond ((not is?) pre-closing-bal)
((double-col 'credit-q pre-adjusting-bal
report-commodity exchange-fn show-fcur?)
- (list (coll-plus pos-adjusting)
- (coll-plus neg-adjusting pre-adjusting-bal)))
+ (list (gnc:collector+ pos-adjusting)
+ (gnc:collector+ neg-adjusting
+ pre-adjusting-bal)))
(else
- (list (coll-plus pos-adjusting pre-adjusting-bal)
- (coll-plus neg-adjusting))))))
+ (list (gnc:collector+ pos-adjusting pre-adjusting-bal)
+ (gnc:collector+ neg-adjusting))))))
;; curr-bal = account-bal with closing & adj entries
;; pre-closing-bal = account-bal with adj entries only
@@ -851,8 +840,8 @@
(tot-abs-amt-cell bs-credits))
'())))
(if (eq? report-variant 'work-sheet)
- (let* ((net-is (coll-minus is-debits is-credits))
- (net-bs (coll-minus bs-debits bs-credits))
+ (let* ((net-is (gnc:collector- is-debits is-credits))
+ (net-bs (gnc:collector- bs-debits bs-credits))
(tot-is (gnc:make-commodity-collector))
(tot-bs (gnc:make-commodity-collector))
(is-entry #f)
commit f72df3e1bc70b29ca74b12497044f093cc737fbe
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Sep 21 13:49:34 2019 +0800
[report-utilities] gnc:account-get-balances-at-dates: use quicksort
stable-sort! is slower than quicksort.
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 90e5249ba..973608af9 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -470,7 +470,7 @@ flawed. see report-utilities.scm. please update reports.")
(define (amount->monetary bal)
(gnc:make-gnc-monetary (xaccAccountGetCommodity account) bal))
(let loop ((splits (xaccAccountGetSplitList account))
- (dates-list (stable-sort! dates-list <))
+ (dates-list (sort dates-list <))
(currentbal 0)
(lastbal 0)
(balancelist '()))
commit 7587c3b4e337e513a4fb68f4b98bb26740e0f8c2
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Sep 20 22:42:43 2019 +0800
[API] gnc:collector+ and gnc:collector- for collector arithmetic
(gnc:collector+ ...) equivalent to (+ ...)
(gnc:collector- ...) equivalent to (- ...) and will also handle
single-argument sign negation.
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index 33c2229b2..4c2dd8b92 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -693,6 +693,8 @@
(export gnc:make-value-collector)
(export gnc:make-number-collector) ;deprecated
(export gnc:make-commodity-collector)
+(export gnc:collector+)
+(export gnc:collector-)
(export gnc:commodity-collector-get-negated)
(export gnc:commodity-collectorlist-get-merged) ;deprecated
(export gnc-commodity-collector-commodity-count)
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 75cc9979b..90e5249ba 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -390,6 +390,25 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
(define (gnc-commodity-collector-allzero? collector)
(every zero? (map cdr (collector 'format cons #f))))
+;; (gnc:collector+ collectors ...) equiv to (+ collectors ...) and
+;; outputs: a collector
+(define (gnc:collector+ . collectors)
+ (let ((res (gnc:make-commodity-collector)))
+ (for-each (lambda (coll) (res 'merge coll #f)) collectors)
+ res))
+
+;; (gnc:collectors- collectors ...) equiv to (- collectors ...), can
+;; also negate single-argument collector. outputs collector
+(define gnc:collector-
+ (case-lambda
+ (() (error "gnc:collector- needs at least 1 collector argument"))
+ ((coll) (gnc:collector- (gnc:make-commodity-collector) coll))
+ ((coll . rest)
+ (let ((res (gnc:make-commodity-collector)))
+ (res 'merge coll #f)
+ (res 'minusmerge (apply gnc:collector+ rest) #f)
+ res))))
+
;; add any number of gnc-monetary objects into a commodity-collector
;; usage: (gnc:monetaries-add monetary1 monetary2 ...)
;; output: a commodity-collector object
diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm
index fd62cc8fc..79728dade 100644
--- a/gnucash/report/report-system/test/test-report-utilities.scm
+++ b/gnucash/report/report-system/test/test-report-utilities.scm
@@ -213,6 +213,21 @@
(gnc:make-gnc-monetary USD 25)
(coll-A 'getmonetary USD #f))
+ (test-equal "gnc:collector+"
+ '(("USD" . 50) ("GBP" . -20))
+ (collector->list
+ (gnc:collector+ coll-A coll-A coll-B)))
+
+ (test-equal "gnc:collector- 1 arg"
+ '(("GBP" . 20) ("USD" . -25))
+ (collector->list
+ (gnc:collector- coll-A)))
+
+ (test-equal "gnc:collector- 3 args"
+ '(("USD" . 25) ("GBP" . -60))
+ (collector->list
+ (gnc:collector- coll-A coll-B coll-B)))
+
(test-equal "gnc:commodity-collector-get-negated"
'(("USD" . -25) ("GBP" . 20))
(collector->list
commit 0511ce723ee2ee52a9a5992bced6505577029e17
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Sep 20 22:17:44 2019 +0800
[API] gnc:list-flatten flattens lists recursively
and is a schemey algorithm rather than a report algorithm, so, belongs
centrally.
diff --git a/gnucash/report/standard-reports/budget.scm b/gnucash/report/standard-reports/budget.scm
index a13b56677..17274811d 100644
--- a/gnucash/report/standard-reports/budget.scm
+++ b/gnucash/report/standard-reports/budget.scm
@@ -317,17 +317,6 @@
(gnc-budget-get-account-period-actual-value budget acct period))
periodlist)))
- (define (flatten lst)
- (reverse!
- (let loop ((lst lst) (result '()))
- (if (null? lst)
- result
- (let ((elt (car lst))
- (rest (cdr lst)))
- (if (pair? elt)
- (loop rest (append (loop elt '()) result))
- (loop rest (cons elt result))))))))
-
;; Adds a line to the budget report.
;;
;; Parameters:
@@ -342,7 +331,7 @@
column-list exchange-fn)
(let* ((comm (xaccAccountGetCommodity acct))
(reverse-balance? (gnc-reverse-balance acct))
- (allperiods (filter number? (flatten column-list)))
+ (allperiods (filter number? (gnc:list-flatten column-list)))
(total-periods (if accumulate?
(iota (1+ (apply max allperiods)))
allperiods))
diff --git a/libgnucash/scm/test/test-libgnucash-scm-utilities.scm b/libgnucash/scm/test/test-libgnucash-scm-utilities.scm
index a2e0d4d24..50903c431 100644
--- a/libgnucash/scm/test/test-libgnucash-scm-utilities.scm
+++ b/libgnucash/scm/test/test-libgnucash-scm-utilities.scm
@@ -10,6 +10,7 @@
(test-traverse-vec)
(test-substring-replace)
(test-sort-and-delete-duplicates)
+ (test-gnc:list-flatten)
(test-begin "test-libgnucash-scm-utilities.scm"))
(define (test-traverse-vec)
@@ -87,3 +88,14 @@
'(1 2 3)
(sort-and-delete-duplicates '(3 1 2) <))
(test-end "sort-and-delete-duplicates"))
+
+(define (test-gnc:list-flatten)
+ (test-equal "gnc:list-flatten null"
+ '()
+ (gnc:list-flatten '()))
+ (test-equal "gnc:list-flatten noop"
+ '(1 2 3)
+ (gnc:list-flatten '(1 2 3)))
+ (test-equal "gnc:list-flatten deep"
+ '(1 2 3 4 5 6)
+ (gnc:list-flatten '(1 (2) (() () (((((3))) ())) 4 () ((5) (6)))))))
diff --git a/libgnucash/scm/utilities.scm b/libgnucash/scm/utilities.scm
index aa69e277f..6665f1b97 100644
--- a/libgnucash/scm/utilities.scm
+++ b/libgnucash/scm/utilities.scm
@@ -47,6 +47,7 @@
(export gnc:debug)
(export addto!)
(export sort-and-delete-duplicates)
+(export gnc:list-flatten)
;; Do this stuff very early -- but other than that, don't add any
;; executable code until the end of the file if you can help it.
@@ -191,6 +192,17 @@
(define (kons a b) (if (and (pair? b) (= a (car b))) b (cons a b)))
(reverse (fold kons '() (sort lst <))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; flattens an arbitrary deep nested list into simple list. this is
+;; probably the most efficient algorithm available. '(1 2 (3 4)) -->
+;; '(1 2 3 4)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (gnc:list-flatten . lst)
+ (reverse
+ (let lp ((e lst) (accum '()))
+ (if (list? e)
+ (fold lp accum e)
+ (cons e accum)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; compatibility hack for fixing guile-2.0 string handling. this code
Summary of changes:
.../report/business-reports/customer-summary.scm | 17 +++++------
gnucash/report/report-system/report-system.scm | 2 ++
gnucash/report/report-system/report-utilities.scm | 21 ++++++++++++-
.../report-system/test/test-report-utilities.scm | 15 ++++++++++
gnucash/report/standard-reports/balsheet-pnl.scm | 5 ++--
gnucash/report/standard-reports/budget.scm | 13 +-------
.../report/standard-reports/category-barchart.scm | 10 ++-----
gnucash/report/standard-reports/net-charts.scm | 8 +----
gnucash/report/standard-reports/trial-balance.scm | 35 ++++++++--------------
.../scm/test/test-libgnucash-scm-utilities.scm | 12 ++++++++
libgnucash/scm/utilities.scm | 12 ++++++++
11 files changed, 86 insertions(+), 64 deletions(-)
More information about the gnucash-changes
mailing list