diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm index 33c2229b2b..4c2dd8b925 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 75cc9979b3..90e5249ba9 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 fd62cc8fc5..79728dade4 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