gnucash maint: Multiple changes pushed
John Ralls
jralls at code.gnucash.org
Mon Oct 29 16:00:22 EDT 2018
Updated via https://github.com/Gnucash/gnucash/commit/105ea8e9 (commit)
via https://github.com/Gnucash/gnucash/commit/cef574af (commit)
via https://github.com/Gnucash/gnucash/commit/af5fb0dd (commit)
via https://github.com/Gnucash/gnucash/commit/de343aac (commit)
via https://github.com/Gnucash/gnucash/commit/d8b8c197 (commit)
via https://github.com/Gnucash/gnucash/commit/9a179f82 (commit)
via https://github.com/Gnucash/gnucash/commit/4091ea8e (commit)
via https://github.com/Gnucash/gnucash/commit/d318fff9 (commit)
via https://github.com/Gnucash/gnucash/commit/952ac9c7 (commit)
via https://github.com/Gnucash/gnucash/commit/f27ea2d4 (commit)
via https://github.com/Gnucash/gnucash/commit/6c59cd15 (commit)
via https://github.com/Gnucash/gnucash/commit/c13f076a (commit)
via https://github.com/Gnucash/gnucash/commit/1444a58c (commit)
via https://github.com/Gnucash/gnucash/commit/c94db1ac (commit)
from https://github.com/Gnucash/gnucash/commit/f6fb1101 (commit)
commit 105ea8e952dce9ef38ff75deca3d0d2e6839e3da
Merge: f6fb110 cef574a
Author: John Ralls <jralls at ceridwen.us>
Date: Mon Oct 29 12:15:41 2018 -0700
Merge Chris Lam's 'maint-category-barchart' into maint.
commit cef574affeb753e3faab2604a0cbd79a58bddb21
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Oct 19 18:35:30 2018 +0800
[category-barchart] remove old expensive function
diff --git a/gnucash/report/standard-reports/category-barchart.scm b/gnucash/report/standard-reports/category-barchart.scm
index 283b0c5..10181ae 100644
--- a/gnucash/report/standard-reports/category-barchart.scm
+++ b/gnucash/report/standard-reports/category-barchart.scm
@@ -384,27 +384,6 @@ developing over time"))
#:ignore-closing? (gnc:account-is-inc-exp? acc)))))
accounts))
- ;; Calculates the net balance (profit or loss) of an account in
- ;; the given time interval. date-list-entry is a pair containing
- ;; the start- and end-date of that interval. If subacct?==#t,
- ;; the subaccount's balances are included as well. Returns a
- ;; double, exchanged into the report-currency by the above
- ;; conversion function, and possibly with reversed sign.
- (define (get-balance account date-list-entry subacct?)
- ((if (reverse-balance? account)
- gnc:monetary-neg identity)
- (if do-intervals?
- (collector->monetary
- (gnc:account-get-comm-balance-interval
- account
- (first date-list-entry)
- (second date-list-entry) subacct?)
- (second date-list-entry))
- (collector->monetary
- (gnc:account-get-comm-balance-at-date
- account date-list-entry subacct?)
- date-list-entry))))
-
;; Creates the <balance-list> to be used in the function
;; below.
(define (account->balance-list account subacct?)
commit af5fb0dde5b53e541fc181f2d237220b34fc2902
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Oct 28 15:17:28 2018 +0800
[category-barchart] remove datelist->stringlist
diff --git a/gnucash/report/standard-reports/category-barchart.scm b/gnucash/report/standard-reports/category-barchart.scm
index 41bf399..283b0c5 100644
--- a/gnucash/report/standard-reports/category-barchart.scm
+++ b/gnucash/report/standard-reports/category-barchart.scm
@@ -327,9 +327,6 @@ developing over time"))
(other-anchor "")
(all-data '()))
- (define (datelist->stringlist dates-list)
- (map qof-print-date dates-list))
-
;; Converts a commodity-collector into gnc-monetary in the report's
;; currency using the exchange-fn calculated above. Returns a gnc-monetary
;; multiplied by the averaging-multiplier (smaller than one; multiplication
@@ -554,9 +551,9 @@ developing over time"))
(let ((dates-list (if do-intervals?
(list-head dates-list (1- (length dates-list)))
dates-list)))
- (set! date-string-list (datelist->stringlist dates-list))
+ (set! date-string-list (map qof-print-date dates-list))
(qof-date-format-set QOF-DATE-FORMAT-ISO)
- (set! date-iso-string-list (datelist->stringlist dates-list))
+ (set! date-iso-string-list (map qof-print-date dates-list))
(qof-date-format-set save-fmt)
;; Set chart title, subtitle etc.
(if (eq? chart-type 'barchart)
commit de343aac3d15d0cb483f1f0e6a527f8d96d49974
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Oct 19 18:35:10 2018 +0800
[category-barchart] optimize (account->balance-list)
1. Modify dates-list definition
instead of either (list date0 date1 date) or
(list (list start0 end0 '())
(list start1 end1 '()) ...)
it now is a list-of-dates (list date0 date1 date2)
2. Pre-generate account-balances using dates-list.
account-balances-alist is an alist-of-balances
3. Use the pre-generated account-balance-alist instead of
calling (get-balance) to obtain balances. This
bypasses (get-balance) which calls a very expensive query-based
functions for every *account* and *date-interval*
diff --git a/gnucash/report/standard-reports/category-barchart.scm b/gnucash/report/standard-reports/category-barchart.scm
index ba8818e..41bf399 100644
--- a/gnucash/report/standard-reports/category-barchart.scm
+++ b/gnucash/report/standard-reports/category-barchart.scm
@@ -313,15 +313,12 @@ developing over time"))
(else report-title)))
(currency-frac (gnc-commodity-get-fraction report-currency))
;; This is the list of date intervals to calculate.
- (dates-list (if do-intervals?
- (gnc:make-date-interval-list
- (gnc:time64-start-day-time from-date-t64)
- (gnc:time64-end-day-time to-date-t64)
- (gnc:deltasym-to-delta interval))
- (gnc:make-date-list
- (gnc:time64-end-day-time from-date-t64)
- (gnc:time64-end-day-time to-date-t64)
- (gnc:deltasym-to-delta interval))))
+ (dates-list (gnc:make-date-list
+ ((if do-intervals?
+ gnc:time64-start-day-time
+ gnc:time64-end-day-time) from-date-t64)
+ (gnc:time64-end-day-time to-date-t64)
+ (gnc:deltasym-to-delta interval)))
;; Here the date strings for the x-axis labels are
;; created.
(date-string-list '())
@@ -331,12 +328,7 @@ developing over time"))
(all-data '()))
(define (datelist->stringlist dates-list)
- (map (lambda (date-list-item)
- (qof-print-date
- (if do-intervals?
- (car date-list-item)
- date-list-item)))
- dates-list))
+ (map qof-print-date dates-list))
;; Converts a commodity-collector into gnc-monetary in the report's
;; currency using the exchange-fn calculated above. Returns a gnc-monetary
@@ -367,12 +359,34 @@ developing over time"))
(car (coll 'format gnc:make-gnc-monetary #f))
(gnc:warn "monetary+ expects 1 currency " (gnc:strify monetaries)))))
+ (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))))
((list? data) (or-map not-all-zeros data))
(else #f)))
+ ;; this is an alist of account-balances
+ ;; (list (list acc0 bal0 bal1 bal2 ...)
+ ;; (list acc1 bal0 bal1 bal2 ...)
+ ;; ...)
+ ;; whereby each balance is a gnc-monetary
+ (define account-balances-alist
+ (map
+ (lambda (acc)
+ (cons acc
+ (map
+ (if (reverse-balance? acc) gnc:monetary-neg identity)
+ (gnc:account-get-balances-at-dates
+ acc dates-list
+ #:ignore-closing? (gnc:account-is-inc-exp? acc)))))
+ accounts))
+
;; Calculates the net balance (profit or loss) of an account in
;; the given time interval. date-list-entry is a pair containing
;; the start- and end-date of that interval. If subacct?==#t,
@@ -397,9 +411,34 @@ developing over time"))
;; Creates the <balance-list> to be used in the function
;; below.
(define (account->balance-list account subacct?)
- (map
- (lambda (d) (get-balance account d subacct?))
- dates-list))
+ (let* ((accountslist (cons account
+ (if subacct?
+ (gnc-account-get-descendants account)
+ '())))
+ (selected-balances (filter
+ (lambda (entry)
+ (member (car entry) accountslist))
+ account-balances-alist))
+ (selected-monetaries (map cdr selected-balances))
+ (list-of-mon-collectors (apply map monetaries-add selected-monetaries)))
+ (let loop ((list-of-mon-collectors list-of-mon-collectors)
+ (dates-list dates-list)
+ (result '()))
+ (if (null? (if do-intervals?
+ (cdr list-of-mon-collectors)
+ list-of-mon-collectors))
+ (reverse result)
+ (loop (cdr list-of-mon-collectors)
+ (cdr dates-list)
+ (cons (if do-intervals?
+ (collector->monetary
+ (collector-minus (cadr list-of-mon-collectors)
+ (car list-of-mon-collectors))
+ (cadr dates-list))
+ (collector->monetary
+ (car list-of-mon-collectors)
+ (car dates-list)))
+ result))))))
(define (count-accounts current-depth accts)
(if (< current-depth tree-depth)
@@ -512,7 +551,9 @@ developing over time"))
(if
(and (not (null? all-data))
(not-all-zeros (map cadr all-data)))
- (begin
+ (let ((dates-list (if do-intervals?
+ (list-head dates-list (1- (length dates-list)))
+ dates-list)))
(set! date-string-list (datelist->stringlist dates-list))
(qof-date-format-set QOF-DATE-FORMAT-ISO)
(set! date-iso-string-list (datelist->stringlist dates-list))
commit d8b8c197bcfd76dd9ad0a623c6e4c75730127b7e
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Oct 19 18:32:31 2018 +0800
[category-barchart] use (or-map) in (not-all-zeros)
diff --git a/gnucash/report/standard-reports/category-barchart.scm b/gnucash/report/standard-reports/category-barchart.scm
index e219531..ba8818e 100644
--- a/gnucash/report/standard-reports/category-barchart.scm
+++ b/gnucash/report/standard-reports/category-barchart.scm
@@ -369,12 +369,8 @@ developing over time"))
;; copy of gnc:not-all-zeros using gnc-monetary
(define (not-all-zeros data)
- (define (myor list)
- (begin
- (if (null? list) #f
- (or (car list) (myor (cdr list))))))
(cond ((gnc:gnc-monetary? data) (not (zero? (gnc:gnc-monetary-amount data))))
- ((list? data) (myor (map not-all-zeros data)))
+ ((list? data) (or-map not-all-zeros data))
(else #f)))
;; Calculates the net balance (profit or loss) of an account in
commit 9a179f8293fda7c94102213a491ff5c019d15eb5
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Oct 19 18:31:30 2018 +0800
[category-barchart] remove monetary->double
doubles are not necessary for charts.
diff --git a/gnucash/report/standard-reports/category-barchart.scm b/gnucash/report/standard-reports/category-barchart.scm
index 049fd0f..e219531 100644
--- a/gnucash/report/standard-reports/category-barchart.scm
+++ b/gnucash/report/standard-reports/category-barchart.scm
@@ -367,10 +367,6 @@ developing over time"))
(car (coll 'format gnc:make-gnc-monetary #f))
(gnc:warn "monetary+ expects 1 currency " (gnc:strify monetaries)))))
- ;; Extract value of gnc-monetary and return it as double
- (define (monetary->double monetary)
- (gnc:gnc-monetary-amount monetary))
-
;; copy of gnc:not-all-zeros using gnc-monetary
(define (not-all-zeros data)
(define (myor list)
@@ -618,7 +614,7 @@ developing over time"))
(gnc:html-barchart-set-data!
chart
(apply zip (map (lambda (mlist)
- (map monetary->double mlist))
+ (map gnc:gnc-monetary-amount mlist))
(map cadr all-data)))))
;; Labels and colors
@@ -639,7 +635,7 @@ developing over time"))
(gnc:html-linechart-set-data!
chart
(apply zip (map (lambda (mlist)
- (map monetary->double mlist))
+ (map gnc:gnc-monetary-amount mlist))
(map cadr all-data)))))
;; Labels and colors
commit 4091ea8ea9bfe0ec897b05c7e0666655a13d6ff1
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Oct 19 18:30:13 2018 +0800
[category-barchart] rewrite monetary+ using commodity collector
This is neater. Split into 2 functions, both of which are useful
(monetaries-add . monetaries)
add different gnc-monetary objects into a gnc-commodity-collector
(monetaries+ . monetaries)
special case for above whereby all monetaries are expected to be in
one currency only -- convert gnc-commodity-collector to monetary
diff --git a/gnucash/report/standard-reports/category-barchart.scm b/gnucash/report/standard-reports/category-barchart.scm
index 84722f7..049fd0f 100644
--- a/gnucash/report/standard-reports/category-barchart.scm
+++ b/gnucash/report/standard-reports/category-barchart.scm
@@ -352,18 +352,20 @@ developing over time"))
c report-currency
(lambda (a b) (exchange-fn a b date)))))))
- ;; Add two or more gnc-monetary objects
- (define (monetary+ a . blist)
- (if (null? blist)
- a
- (let ((b (apply monetary+ blist)))
- (if (and (gnc:gnc-monetary? a) (gnc:gnc-monetary? b))
- (let ((same-currency? (gnc-commodity-equal (gnc:gnc-monetary-commodity a) (gnc:gnc-monetary-commodity b)))
- (amount (+ (gnc:gnc-monetary-amount a) (gnc:gnc-monetary-amount b))))
- (if same-currency?
- (gnc:make-gnc-monetary (gnc:gnc-monetary-commodity a) amount)
- (warn "incompatible currencies in monetary+: " a b)))
- (warn "wrong arguments for monetary+: " a b)))))
+ (define (monetaries-add . monetaries)
+ (let ((coll (gnc:make-commodity-collector)))
+ (for-each
+ (lambda (mon)
+ (coll 'add (gnc:gnc-monetary-commodity mon) (gnc:gnc-monetary-amount mon)))
+ monetaries)
+ coll))
+
+ ;; Special case for monetaries-add whereby only 1 currency is expected
+ (define (monetary+ . monetaries)
+ (let ((coll (apply monetaries-add monetaries)))
+ (if (= 1 (gnc-commodity-collector-commodity-count coll))
+ (car (coll 'format gnc:make-gnc-monetary #f))
+ (gnc:warn "monetary+ expects 1 currency " (gnc:strify monetaries)))))
;; Extract value of gnc-monetary and return it as double
(define (monetary->double monetary)
commit d318fff9a5fa7a26259eb6c4d5a107df55adcaf9
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Oct 19 18:29:16 2018 +0800
[category-barchart] remove old gnc-numeric methods
diff --git a/gnucash/report/standard-reports/category-barchart.scm b/gnucash/report/standard-reports/category-barchart.scm
index c899649..84722f7 100644
--- a/gnucash/report/standard-reports/category-barchart.scm
+++ b/gnucash/report/standard-reports/category-barchart.scm
@@ -290,17 +290,17 @@ developing over time"))
;; Calculate the divisor of the amounts so that an
;; average is shown. Multiplier factor is a gnc-numeric
(let* ((start-frac-avg (averaging-fraction-func from-date-t64))
- (end-frac-avg (averaging-fraction-func (+ 1 to-date-t64)))
+ (end-frac-avg (averaging-fraction-func (1+ to-date-t64)))
(diff-avg (- end-frac-avg start-frac-avg))
(diff-avg-numeric (/ (inexact->exact (round (* diff-avg 1000000))) ; 6 decimals precision
1000000))
(start-frac-int (interval-fraction-func from-date-t64))
- (end-frac-int (interval-fraction-func (+ 1 to-date-t64)))
+ (end-frac-int (interval-fraction-func (1+ to-date-t64)))
(diff-int (- end-frac-int start-frac-int))
(diff-int-numeric (inexact->exact diff-int)))
;; Extra sanity check to ensure a number smaller than 1
(if (> diff-avg diff-int)
- (gnc-numeric-div diff-int-numeric diff-avg-numeric GNC-DENOM-AUTO GNC-RND-ROUND)
+ (/ diff-int-numeric diff-avg-numeric)
1))
1))
;; If there is averaging, the report-title is extended
@@ -346,12 +346,11 @@ developing over time"))
(define (collector->monetary c date)
(gnc:make-gnc-monetary
report-currency
- (gnc-numeric-mul
- (gnc:gnc-monetary-amount
- (gnc:sum-collector-commodity
- c report-currency
- (lambda (a b) (exchange-fn a b date))))
- averaging-multiplier currency-frac GNC-RND-ROUND)))
+ (* averaging-multiplier
+ (gnc:gnc-monetary-amount
+ (gnc:sum-collector-commodity
+ c report-currency
+ (lambda (a b) (exchange-fn a b date)))))))
;; Add two or more gnc-monetary objects
(define (monetary+ a . blist)
@@ -360,7 +359,7 @@ developing over time"))
(let ((b (apply monetary+ blist)))
(if (and (gnc:gnc-monetary? a) (gnc:gnc-monetary? b))
(let ((same-currency? (gnc-commodity-equal (gnc:gnc-monetary-commodity a) (gnc:gnc-monetary-commodity b)))
- (amount (gnc-numeric-add (gnc:gnc-monetary-amount a) (gnc:gnc-monetary-amount b) GNC-DENOM-AUTO GNC-RND-ROUND)))
+ (amount (+ (gnc:gnc-monetary-amount a) (gnc:gnc-monetary-amount b))))
(if same-currency?
(gnc:make-gnc-monetary (gnc:gnc-monetary-commodity a) amount)
(warn "incompatible currencies in monetary+: " a b)))
@@ -368,7 +367,7 @@ developing over time"))
;; Extract value of gnc-monetary and return it as double
(define (monetary->double monetary)
- (gnc-numeric-to-double (gnc:gnc-monetary-amount monetary)))
+ (gnc:gnc-monetary-amount monetary))
;; copy of gnc:not-all-zeros using gnc-monetary
(define (not-all-zeros data)
@@ -376,7 +375,7 @@ developing over time"))
(begin
(if (null? list) #f
(or (car list) (myor (cdr list))))))
- (cond ((gnc:gnc-monetary? data) (not (gnc-numeric-zero-p (gnc:gnc-monetary-amount data))))
+ (cond ((gnc:gnc-monetary? data) (not (zero? (gnc:gnc-monetary-amount data))))
((list? data) (myor (map not-all-zeros data)))
(else #f)))
@@ -413,8 +412,8 @@ developing over time"))
(let ((sum 0))
(for-each
(lambda (a)
- (set! sum (+ sum (+ 1 (count-accounts (1+ current-depth)
- (gnc-account-get-children a))))))
+ (set! sum (+ sum (1+ (count-accounts (1+ current-depth)
+ (gnc-account-get-children a))))))
accts)
sum)
(length (filter show-acct? accts))))
@@ -503,10 +502,8 @@ developing over time"))
xaccAccountGetName) (car b)))))
(else
(lambda (a b)
- (> (gnc-numeric-compare (gnc:gnc-monetary-amount (apply monetary+ (cadr a)))
- (gnc:gnc-monetary-amount (apply monetary+ (cadr b))))
- 0)))
- )))
+ (> (gnc:gnc-monetary-amount (apply monetary+ (cadr a)))
+ (gnc:gnc-monetary-amount (apply monetary+ (cadr b)))))))))
;; Or rather sort by total amount?
;;(< (apply + (cadr a))
;; (apply + (cadr b))))))
@@ -751,7 +748,7 @@ developing over time"))
(lambda (row)
(if (not (null? row))
(monetary+ (car row) (sumrow (cdr row)))
- (gnc:make-gnc-monetary report-currency (gnc-numeric-zero))))))
+ (gnc:make-gnc-monetary report-currency 0)))))
(gnc:html-table-append-column!
table
(sumtot (apply zip (map cadr all-data))))))
commit 952ac9c7f40ce209ce3b9976d7edbbc9ba1bdfbe
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Oct 19 18:27:19 2018 +0800
[category-barchart] compact functions
diff --git a/gnucash/report/standard-reports/category-barchart.scm b/gnucash/report/standard-reports/category-barchart.scm
index 0d8e1ef..c899649 100644
--- a/gnucash/report/standard-reports/category-barchart.scm
+++ b/gnucash/report/standard-reports/category-barchart.scm
@@ -128,10 +128,7 @@ developing over time"))
(N_ "Show the average weekly amount during the reporting period."))
(vector 'DayDelta
(N_ "Daily")
- (N_ "Show the average daily amount during the reporting period."))
- )
- ))
- )
+ (N_ "Show the average daily amount during the reporting period."))))))
;; Accounts tab
@@ -170,10 +167,7 @@ developing over time"))
(N_ "Use bar charts."))
(vector 'linechart
(N_ "Line Chart")
- (N_ "Use line charts."))
- )
- )
- )
+ (N_ "Use line charts.")))))
(add-option
(gnc:make-simple-boolean-option
@@ -265,11 +259,9 @@ developing over time"))
(work-to-do 0)
(show-table? (get-option gnc:pagename-display (N_ "Show table")))
(document (gnc:make-html-document))
- (chart
- (if (eqv? chart-type 'barchart)
- (gnc:make-html-barchart)
- (gnc:make-html-linechart)
- ))
+ (chart (if (eqv? chart-type 'barchart)
+ (gnc:make-html-barchart)
+ (gnc:make-html-linechart)))
(table (gnc:make-html-table))
(topl-accounts (gnc:filter-accountlist-type
account-types
@@ -281,7 +273,7 @@ developing over time"))
(define (show-acct? a)
(member a accounts))
- (define tree-depth (if (equal? account-levels 'all)
+ (define tree-depth (if (eq? account-levels 'all)
(gnc:get-current-account-tree-depth)
account-levels))
@@ -300,20 +292,17 @@ developing over time"))
(let* ((start-frac-avg (averaging-fraction-func from-date-t64))
(end-frac-avg (averaging-fraction-func (+ 1 to-date-t64)))
(diff-avg (- end-frac-avg start-frac-avg))
- (diff-avg-numeric (/
- (inexact->exact (round (* diff-avg 1000000))) ; 6 decimals precision
- 1000000))
+ (diff-avg-numeric (/ (inexact->exact (round (* diff-avg 1000000))) ; 6 decimals precision
+ 1000000))
(start-frac-int (interval-fraction-func from-date-t64))
(end-frac-int (interval-fraction-func (+ 1 to-date-t64)))
(diff-int (- end-frac-int start-frac-int))
- (diff-int-numeric (/
- (inexact->exact diff-int) 1))
- )
+ (diff-int-numeric (inexact->exact diff-int)))
;; Extra sanity check to ensure a number smaller than 1
(if (> diff-avg diff-int)
(gnc-numeric-div diff-int-numeric diff-avg-numeric GNC-DENOM-AUTO GNC-RND-ROUND)
- 1/1))
- 1/1))
+ 1))
+ 1))
;; If there is averaging, the report-title is extended
;; accordingly.
(report-title
@@ -355,8 +344,6 @@ developing over time"))
;; instead of division to avoid division-by-zero issues) in case
;; the user wants to see the amounts averaged over some value.
(define (collector->monetary c date)
- (if (not (number? date))
- (throw 'wrong))
(gnc:make-gnc-monetary
report-currency
(gnc-numeric-mul
@@ -364,8 +351,7 @@ developing over time"))
(gnc:sum-collector-commodity
c report-currency
(lambda (a b) (exchange-fn a b date))))
- averaging-multiplier currency-frac GNC-RND-ROUND)
- ))
+ averaging-multiplier currency-frac GNC-RND-ROUND)))
;; Add two or more gnc-monetary objects
(define (monetary+ a . blist)
@@ -378,9 +364,7 @@ developing over time"))
(if same-currency?
(gnc:make-gnc-monetary (gnc:gnc-monetary-commodity a) amount)
(warn "incompatible currencies in monetary+: " a b)))
- (warn "wrong arguments for monetary+: " a b)))
- )
- )
+ (warn "wrong arguments for monetary+: " a b)))))
;; Extract value of gnc-monetary and return it as double
(define (monetary->double monetary)
@@ -429,7 +413,7 @@ developing over time"))
(let ((sum 0))
(for-each
(lambda (a)
- (set! sum (+ sum (+ 1 (count-accounts (+ 1 current-depth)
+ (set! sum (+ sum (+ 1 (count-accounts (1+ current-depth)
(gnc-account-get-children a))))))
accts)
sum)
@@ -463,7 +447,7 @@ developing over time"))
res)))
(set! res (append
(traverse-accounts
- (+ 1 current-depth)
+ (1+ current-depth)
(gnc-account-get-children a))
res))))
accts)
@@ -543,7 +527,7 @@ developing over time"))
(set! date-iso-string-list (datelist->stringlist dates-list))
(qof-date-format-set save-fmt)
;; Set chart title, subtitle etc.
- (if (eqv? chart-type 'barchart)
+ (if (eq? chart-type 'barchart)
(begin
(gnc:html-barchart-set-title! chart report-title)
(gnc:html-barchart-set-subtitle!
@@ -551,8 +535,8 @@ developing over time"))
(if do-intervals?
(_ "~a to ~a")
(_ "Balances ~a to ~a"))
- (gnc:html-string-sanitize (qof-print-date from-date-t64))
- (gnc:html-string-sanitize (qof-print-date to-date-t64))))
+ (qof-print-date from-date-t64)
+ (qof-print-date to-date-t64)))
(gnc:html-barchart-set-width! chart width)
(gnc:html-barchart-set-height! chart height)
@@ -577,8 +561,8 @@ developing over time"))
(if do-intervals?
(_ "~a to ~a")
(_ "Balances ~a to ~a"))
- (gnc:html-string-sanitize (qof-print-date from-date-t64))
- (gnc:html-string-sanitize (qof-print-date to-date-t64))))
+ (qof-print-date from-date-t64)
+ (qof-print-date to-date-t64)))
(gnc:html-linechart-set-width! chart width)
(gnc:html-linechart-set-height! chart height)
@@ -602,8 +586,8 @@ developing over time"))
;; 'other' category and add a link to a new report with just
;; those accounts.
(if (> (length all-data) max-slices)
- (let* ((start (take all-data (- max-slices 1)))
- (finish (drop all-data (- max-slices 1)))
+ (let* ((start (take all-data (1- max-slices)))
+ (finish (drop all-data (1- max-slices)))
(other-sum (map
(lambda (l) (apply monetary+ l))
(apply zip (map cadr finish)))))
@@ -629,7 +613,7 @@ developing over time"))
;; transposes the data, i.e. swaps rows and columns. Pretty
;; cool, eh? Courtesy of dave_p.
(gnc:report-percent-done 92)
- (if (eqv? chart-type 'barchart)
+ (if (eq? chart-type 'barchart)
(begin ;; bar chart
(if (not (null? all-data))
(gnc:html-barchart-set-data!
@@ -650,8 +634,7 @@ developing over time"))
all-data))
(gnc:html-barchart-set-col-colors!
chart
- (gnc:assign-colors (length all-data)))
- )
+ (gnc:assign-colors (length all-data))))
(begin ;; line chart
(if (not (null? all-data))
(gnc:html-linechart-set-data!
@@ -672,9 +655,7 @@ developing over time"))
all-data))
(gnc:html-linechart-set-col-colors!
chart
- (gnc:assign-colors (length all-data)))
- )
- )
+ (gnc:assign-colors (length all-data)))))
;; set the URLs; the slices are links to other reports
;; (gnc:report-percent-done 96)
@@ -703,14 +684,14 @@ developing over time"))
;; (list gnc:pagename-accounts optname-accounts
;; (cons acct subaccts))
;; (list gnc:pagename-accounts optname-levels
- ;; (+ 1 tree-depth))
+ ;; (1+ tree-depth))
;; (list gnc:pagename-general
;; gnc:optname-reportname
;; ((if show-fullname?
;; gnc-account-get-full-name
;; xaccAccountGetName) acct))))))))
;; all-data)))
- ;; (if (eqv? chart-type 'barchart)
+ ;; (if (eq? chart-type 'barchart)
;; (begin ;; bar chart
;; (gnc:html-barchart-set-button-1-bar-urls!
;; chart (append urls urls))
@@ -741,12 +722,8 @@ developing over time"))
(begin
(gnc:html-table-append-column!
table (car col))
- (addcol (cdr col))
- )
- ))
- ))
- (addcol (map cadr all-data))
- )
+ (addcol (cdr col)))))))
+ (addcol (map cadr all-data)))
(gnc:html-table-set-col-headers!
table
@@ -761,9 +738,7 @@ developing over time"))
all-data)
(if (> (gnc:html-table-num-columns table) 2)
(list (_ "Grand Total"))
- '()
- )
- ))
+ '())))
(if (> (gnc:html-table-num-columns table) 2)
(letrec
@@ -771,24 +746,15 @@ developing over time"))
(lambda (row)
(if (null? row)
'()
- (cons (sumrow (car row)) (sumtot (cdr row)))
- )
- )
- )
+ (cons (sumrow (car row)) (sumtot (cdr row))))))
(sumrow
(lambda (row)
(if (not (null? row))
(monetary+ (car row) (sumrow (cdr row)))
- (gnc:make-gnc-monetary report-currency (gnc-numeric-zero))
- )
- )
- ))
+ (gnc:make-gnc-monetary report-currency (gnc-numeric-zero))))))
(gnc:html-table-append-column!
table
- (sumtot (apply zip (map cadr all-data)))
- )
- )
- )
+ (sumtot (apply zip (map cadr all-data))))))
;; set numeric columns to align right
(for-each
(lambda (col)
@@ -796,10 +762,7 @@ developing over time"))
table col "td"
'attribute (list "class" "number-cell")))
'(1 2 3 4 5 6 7 8 9 10 11 12 13 14))
- (gnc:html-document-add-object! document table)
- ) ;; begin if
- )
- )
+ (gnc:html-document-add-object! document table))))
;; else if empty data
(gnc:html-document-add-object!
commit f27ea2d4bc57ad559ae9521094db39e0ca7ae1d9
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Oct 19 18:23:42 2018 +0800
[category-barchart] *reindent/untabify/delete-trailing-whitespace*
diff --git a/gnucash/report/standard-reports/category-barchart.scm b/gnucash/report/standard-reports/category-barchart.scm
index b3b9129..0d8e1ef 100644
--- a/gnucash/report/standard-reports/category-barchart.scm
+++ b/gnucash/report/standard-reports/category-barchart.scm
@@ -25,7 +25,7 @@
;; depends must be outside module scope -- and should eventually go away.
(define-module (gnucash report standard-reports category-barchart))
(use-modules (srfi srfi-1))
-(use-modules (gnucash utilities))
+(use-modules (gnucash utilities))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
@@ -42,15 +42,15 @@
;; The names are used in the menu
;; The menu statusbar tips.
-(define menutip-income
+(define menutip-income
(N_ "Shows a chart with the Income per interval \
developing over time"))
-(define menutip-expense
+(define menutip-expense
(N_ "Shows a chart with the Expenses per interval \
developing over time"))
-(define menutip-assets
+(define menutip-assets
(N_ "Shows a chart with the Assets developing over time"))
-(define menutip-liabilities
+(define menutip-liabilities
(N_ "Shows a chart with the Liabilities \
developing over time"))
@@ -87,8 +87,8 @@ developing over time"))
(define opthelp-averaging (N_ "Select whether the amounts should be shown over the full time period or rather as the average e.g. per month."))
(define (options-generator account-types reverse-balance? do-intervals?)
- (let* ((options (gnc:new-options))
- (add-option
+ (let* ((options (gnc:new-options))
+ (add-option
(lambda (new-option)
(gnc:register-option options new-option))))
@@ -101,13 +101,13 @@ developing over time"))
options gnc:pagename-general
optname-from-date optname-to-date "a")
- (gnc:options-add-interval-choice!
+ (gnc:options-add-interval-choice!
options gnc:pagename-general optname-stepsize "b" 'MonthDelta)
- (gnc:options-add-currency!
+ (gnc:options-add-currency!
options gnc:pagename-general optname-report-currency "c")
- (gnc:options-add-price-source!
+ (gnc:options-add-price-source!
options gnc:pagename-general
optname-price-source "d" 'weighted-average)
@@ -141,17 +141,17 @@ developing over time"))
"a"
(N_ "Report on these accounts, if chosen account level allows.")
(lambda ()
- (gnc:filter-accountlist-type
+ (gnc:filter-accountlist-type
account-types
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
(lambda (accounts)
(list #t
(gnc:filter-accountlist-type account-types accounts)))
#t))
-
- (gnc:options-add-account-levels!
- options gnc:pagename-accounts optname-levels "c"
- (N_ "Show accounts to this depth and not further.")
+
+ (gnc:options-add-account-levels!
+ options gnc:pagename-accounts optname-levels "c"
+ (N_ "Show accounts to this depth and not further.")
2)
;; Display tab
@@ -161,19 +161,19 @@ developing over time"))
"a" (N_ "Show the full account name in legend?") #f))
(add-option
- (gnc:make-multichoice-option
- gnc:pagename-display optname-chart-type
- "b" "Select which chart type to use"
- 'barchart
- (list (vector 'barchart
- (N_ "Bar Chart")
- (N_ "Use bar charts."))
- (vector 'linechart
- (N_ "Line Chart")
- (N_ "Use line charts."))
- )
+ (gnc:make-multichoice-option
+ gnc:pagename-display optname-chart-type
+ "b" "Select which chart type to use"
+ 'barchart
+ (list (vector 'barchart
+ (N_ "Bar Chart")
+ (N_ "Use bar charts."))
+ (vector 'linechart
+ (N_ "Line Chart")
+ (N_ "Use line charts."))
+ )
)
- )
+ )
(add-option
(gnc:make-simple-boolean-option
@@ -195,11 +195,11 @@ developing over time"))
"e" (N_ "Display a table of the selected data.")
#f))
- (gnc:options-add-plot-size!
- options gnc:pagename-display
+ (gnc:options-add-plot-size!
+ options gnc:pagename-display
optname-plot-width optname-plot-height "f" (cons 'percent 100.0) (cons 'percent 100.0))
- (gnc:options-add-sort-method!
+ (gnc:options-add-sort-method!
options gnc:pagename-display
optname-sort-method "g" 'amount)
@@ -219,63 +219,63 @@ developing over time"))
;; constant over the whole report period. Note that this might get
;; *really* complicated.
-(define (category-barchart-renderer report-obj reportname reportguid
+(define (category-barchart-renderer report-obj reportname reportguid
account-types do-intervals?)
;; A helper functions for looking up option values.
(define (get-option section name)
- (gnc:option-value
- (gnc:lookup-option
+ (gnc:option-value
+ (gnc:lookup-option
(gnc:report-options report-obj) section name)))
-
+
(gnc:report-starting reportname)
(let* ((to-date-t64 (gnc:time64-end-day-time
(gnc:date-option-absolute-time
- (get-option gnc:pagename-general
+ (get-option gnc:pagename-general
optname-to-date))))
- (from-date-t64 (gnc:time64-start-day-time
- (gnc:date-option-absolute-time
- (get-option gnc:pagename-general
- optname-from-date))))
- (interval (get-option gnc:pagename-general optname-stepsize))
- (report-currency (get-option gnc:pagename-general
- optname-report-currency))
- (price-source (get-option gnc:pagename-general
- optname-price-source))
- (report-title (get-option gnc:pagename-general
- gnc:optname-reportname))
- (averaging-selection (if do-intervals?
- (get-option gnc:pagename-general
- optname-averaging)
- 'None))
-
- (accounts (get-option gnc:pagename-accounts optname-accounts))
- (account-levels (get-option gnc:pagename-accounts optname-levels))
-
- (chart-type (get-option gnc:pagename-display optname-chart-type))
- (stacked? (get-option gnc:pagename-display optname-stacked))
- (show-fullname? (get-option gnc:pagename-display optname-fullname))
- (max-slices (inexact->exact
- (get-option gnc:pagename-display optname-slices)))
- (height (get-option gnc:pagename-display optname-plot-height))
- (width (get-option gnc:pagename-display optname-plot-width))
- (sort-method (get-option gnc:pagename-display optname-sort-method))
- (reverse-balance? (get-option "__report" "reverse-balance?"))
-
- (work-done 0)
- (work-to-do 0)
- (show-table? (get-option gnc:pagename-display (N_ "Show table")))
- (document (gnc:make-html-document))
- (chart
- (if (eqv? chart-type 'barchart)
+ (from-date-t64 (gnc:time64-start-day-time
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general
+ optname-from-date))))
+ (interval (get-option gnc:pagename-general optname-stepsize))
+ (report-currency (get-option gnc:pagename-general
+ optname-report-currency))
+ (price-source (get-option gnc:pagename-general
+ optname-price-source))
+ (report-title (get-option gnc:pagename-general
+ gnc:optname-reportname))
+ (averaging-selection (if do-intervals?
+ (get-option gnc:pagename-general
+ optname-averaging)
+ 'None))
+
+ (accounts (get-option gnc:pagename-accounts optname-accounts))
+ (account-levels (get-option gnc:pagename-accounts optname-levels))
+
+ (chart-type (get-option gnc:pagename-display optname-chart-type))
+ (stacked? (get-option gnc:pagename-display optname-stacked))
+ (show-fullname? (get-option gnc:pagename-display optname-fullname))
+ (max-slices (inexact->exact
+ (get-option gnc:pagename-display optname-slices)))
+ (height (get-option gnc:pagename-display optname-plot-height))
+ (width (get-option gnc:pagename-display optname-plot-width))
+ (sort-method (get-option gnc:pagename-display optname-sort-method))
+ (reverse-balance? (get-option "__report" "reverse-balance?"))
+
+ (work-done 0)
+ (work-to-do 0)
+ (show-table? (get-option gnc:pagename-display (N_ "Show table")))
+ (document (gnc:make-html-document))
+ (chart
+ (if (eqv? chart-type 'barchart)
(gnc:make-html-barchart)
(gnc:make-html-linechart)
- ))
- (table (gnc:make-html-table))
- (topl-accounts (gnc:filter-accountlist-type
- account-types
- (gnc-account-get-children-sorted
- (gnc-get-current-root-account)))))
-
+ ))
+ (table (gnc:make-html-table))
+ (topl-accounts (gnc:filter-accountlist-type
+ account-types
+ (gnc-account-get-children-sorted
+ (gnc-get-current-root-account)))))
+
;; Returns true if the account a was selected in the account
;; selection option.
(define (show-acct? a)
@@ -294,43 +294,43 @@ developing over time"))
(averaging-fraction-func (gnc:date-get-fraction-func averaging-selection))
(interval-fraction-func (gnc:date-get-fraction-func interval))
(averaging-multiplier
- (if averaging-fraction-func
- ;; Calculate the divisor of the amounts so that an
- ;; average is shown. Multiplier factor is a gnc-numeric
- (let* ((start-frac-avg (averaging-fraction-func from-date-t64))
- (end-frac-avg (averaging-fraction-func (+ 1 to-date-t64)))
- (diff-avg (- end-frac-avg start-frac-avg))
- (diff-avg-numeric (/
- (inexact->exact (round (* diff-avg 1000000))) ; 6 decimals precision
- 1000000))
- (start-frac-int (interval-fraction-func from-date-t64))
- (end-frac-int (interval-fraction-func (+ 1 to-date-t64)))
- (diff-int (- end-frac-int start-frac-int))
- (diff-int-numeric (/
- (inexact->exact diff-int) 1))
- )
- ;; Extra sanity check to ensure a number smaller than 1
- (if (> diff-avg diff-int)
- (gnc-numeric-div diff-int-numeric diff-avg-numeric GNC-DENOM-AUTO GNC-RND-ROUND)
- 1/1))
- 1/1))
+ (if averaging-fraction-func
+ ;; Calculate the divisor of the amounts so that an
+ ;; average is shown. Multiplier factor is a gnc-numeric
+ (let* ((start-frac-avg (averaging-fraction-func from-date-t64))
+ (end-frac-avg (averaging-fraction-func (+ 1 to-date-t64)))
+ (diff-avg (- end-frac-avg start-frac-avg))
+ (diff-avg-numeric (/
+ (inexact->exact (round (* diff-avg 1000000))) ; 6 decimals precision
+ 1000000))
+ (start-frac-int (interval-fraction-func from-date-t64))
+ (end-frac-int (interval-fraction-func (+ 1 to-date-t64)))
+ (diff-int (- end-frac-int start-frac-int))
+ (diff-int-numeric (/
+ (inexact->exact diff-int) 1))
+ )
+ ;; Extra sanity check to ensure a number smaller than 1
+ (if (> diff-avg diff-int)
+ (gnc-numeric-div diff-int-numeric diff-avg-numeric GNC-DENOM-AUTO GNC-RND-ROUND)
+ 1/1))
+ 1/1))
;; If there is averaging, the report-title is extended
;; accordingly.
(report-title
- (case averaging-selection
- ((MonthDelta) (string-append report-title " " (_ "Monthly Average")))
- ((WeekDelta) (string-append report-title " " (_ "Weekly Average")))
- ((DayDelta) (string-append report-title " " (_ "Daily Average")))
- (else report-title)))
+ (case averaging-selection
+ ((MonthDelta) (string-append report-title " " (_ "Monthly Average")))
+ ((WeekDelta) (string-append report-title " " (_ "Weekly Average")))
+ ((DayDelta) (string-append report-title " " (_ "Daily Average")))
+ (else report-title)))
(currency-frac (gnc-commodity-get-fraction report-currency))
;; This is the list of date intervals to calculate.
(dates-list (if do-intervals?
(gnc:make-date-interval-list
- (gnc:time64-start-day-time from-date-t64)
+ (gnc:time64-start-day-time from-date-t64)
(gnc:time64-end-day-time to-date-t64)
(gnc:deltasym-to-delta interval))
(gnc:make-date-list
- (gnc:time64-end-day-time from-date-t64)
+ (gnc:time64-end-day-time from-date-t64)
(gnc:time64-end-day-time to-date-t64)
(gnc:deltasym-to-delta interval))))
;; Here the date strings for the x-axis labels are
@@ -343,10 +343,10 @@ developing over time"))
(define (datelist->stringlist dates-list)
(map (lambda (date-list-item)
- (qof-print-date
- (if do-intervals?
- (car date-list-item)
- date-list-item)))
+ (qof-print-date
+ (if do-intervals?
+ (car date-list-item)
+ date-list-item)))
dates-list))
;; Converts a commodity-collector into gnc-monetary in the report's
@@ -361,11 +361,11 @@ developing over time"))
report-currency
(gnc-numeric-mul
(gnc:gnc-monetary-amount
- (gnc:sum-collector-commodity
+ (gnc:sum-collector-commodity
c report-currency
(lambda (a b) (exchange-fn a b date))))
averaging-multiplier currency-frac GNC-RND-ROUND)
- ))
+ ))
;; Add two or more gnc-monetary objects
(define (monetary+ a . blist)
@@ -407,9 +407,9 @@ developing over time"))
gnc:monetary-neg identity)
(if do-intervals?
(collector->monetary
- (gnc:account-get-comm-balance-interval
- account
- (first date-list-entry)
+ (gnc:account-get-comm-balance-interval
+ account
+ (first date-list-entry)
(second date-list-entry) subacct?)
(second date-list-entry))
(collector->monetary
@@ -417,23 +417,23 @@ developing over time"))
account date-list-entry subacct?)
date-list-entry))))
-;; Creates the <balance-list> to be used in the function
- ;; below.
+ ;; Creates the <balance-list> to be used in the function
+ ;; below.
(define (account->balance-list account subacct?)
- (map
+ (map
(lambda (d) (get-balance account d subacct?))
dates-list))
- (define (count-accounts current-depth accts)
- (if (< current-depth tree-depth)
- (let ((sum 0))
- (for-each
- (lambda (a)
- (set! sum (+ sum (+ 1 (count-accounts (+ 1 current-depth)
- (gnc-account-get-children a))))))
- accts)
- sum)
- (length (filter show-acct? accts))))
+ (define (count-accounts current-depth accts)
+ (if (< current-depth tree-depth)
+ (let ((sum 0))
+ (for-each
+ (lambda (a)
+ (set! sum (+ sum (+ 1 (count-accounts (+ 1 current-depth)
+ (gnc-account-get-children a))))))
+ accts)
+ sum)
+ (length (filter show-acct? accts))))
;; Calculates all account's balances. Returns a list of pairs:
;; (<account> <balance-list>), like '((Earnings (10.0 11.2))
@@ -455,10 +455,10 @@ developing over time"))
(for-each
(lambda (a)
(begin
- (set! work-done (1+ work-done))
- (gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do))))
+ (set! work-done (1+ work-done))
+ (gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do))))
(if (show-acct? a)
- (set! res
+ (set! res
(cons (list a (account->balance-list a #f))
res)))
(set! res (append
@@ -471,11 +471,11 @@ developing over time"))
;; else (i.e. current-depth == tree-depth)
(map
(lambda (a)
- (set! work-done (1+ work-done))
- (gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do))))
+ (set! work-done (1+ work-done))
+ (gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do))))
(list a (account->balance-list a #t)))
(filter show-acct? accts))))
-
+
;; The percentage done numbers here are a hack so that
;; something gets displayed. On my system the
@@ -484,251 +484,251 @@ developing over time"))
;; routine needs to send progress reports, or the price
;; lookup should be distributed and done when actually
;; needed so as to amortize the cpu time properly.
- (gnc:report-percent-done 1)
- (set! commodity-list (gnc:accounts-get-commodities
- (append
+ (gnc:report-percent-done 1)
+ (set! commodity-list (gnc:accounts-get-commodities
+ (append
(gnc:acccounts-get-all-subaccounts accounts)
accounts)
report-currency))
- (set! exchange-fn (gnc:case-exchange-time-fn
- price-source report-currency
+ (set! exchange-fn (gnc:case-exchange-time-fn
+ price-source report-currency
commodity-list to-date-t64
- 5 15))
+ 5 15))
(set! work-to-do (count-accounts 1 topl-accounts))
;; Sort the account list according to the account code field.
- (set! all-data (sort
- (filter (lambda (l)
+ (set! all-data (sort
+ (filter (lambda (l)
(not (zero?
(gnc:gnc-monetary-amount
(apply monetary+ (cadr l))))))
(traverse-accounts 1 topl-accounts))
- (cond
- ((eq? sort-method 'acct-code)
- (lambda (a b)
- (string<? (xaccAccountGetCode (car a))
- (xaccAccountGetCode (car b)))))
- ((eq? sort-method 'alphabetical)
- (lambda (a b)
- (string<? ((if show-fullname?
- gnc-account-get-full-name
- xaccAccountGetName) (car a))
- ((if show-fullname?
- gnc-account-get-full-name
- xaccAccountGetName) (car b)))))
- (else
- (lambda (a b)
+ (cond
+ ((eq? sort-method 'acct-code)
+ (lambda (a b)
+ (string<? (xaccAccountGetCode (car a))
+ (xaccAccountGetCode (car b)))))
+ ((eq? sort-method 'alphabetical)
+ (lambda (a b)
+ (string<? ((if show-fullname?
+ gnc-account-get-full-name
+ xaccAccountGetName) (car a))
+ ((if show-fullname?
+ gnc-account-get-full-name
+ xaccAccountGetName) (car b)))))
+ (else
+ (lambda (a b)
(> (gnc-numeric-compare (gnc:gnc-monetary-amount (apply monetary+ (cadr a)))
(gnc:gnc-monetary-amount (apply monetary+ (cadr b))))
0)))
- )))
+ )))
;; Or rather sort by total amount?
- ;;(< (apply + (cadr a))
+ ;;(< (apply + (cadr a))
;; (apply + (cadr b))))))
;; Other sort criteria: max. amount, standard deviation of amount,
;; min. amount; ascending, descending. FIXME: Add user options to
;; choose sorting.
-
-
+
+
;;(gnc:warn "all-data" all-data)
;; Proceed if the data is non-zeros
- (if
+ (if
(and (not (null? all-data))
(not-all-zeros (map cadr all-data)))
- (begin
+ (begin
(set! date-string-list (datelist->stringlist dates-list))
(qof-date-format-set QOF-DATE-FORMAT-ISO)
(set! date-iso-string-list (datelist->stringlist dates-list))
(qof-date-format-set save-fmt)
;; Set chart title, subtitle etc.
(if (eqv? chart-type 'barchart)
- (begin
- (gnc:html-barchart-set-title! chart report-title)
- (gnc:html-barchart-set-subtitle!
- chart (format #f
- (if do-intervals?
- (_ "~a to ~a")
- (_ "Balances ~a to ~a"))
- (gnc:html-string-sanitize (qof-print-date from-date-t64))
- (gnc:html-string-sanitize (qof-print-date to-date-t64))))
-
- (gnc:html-barchart-set-width! chart width)
- (gnc:html-barchart-set-height! chart height)
-
- ;; row labels etc.
- (gnc:html-barchart-set-row-labels! chart date-string-list)
- ;; FIXME: axis labels are not yet supported by
- ;; libguppitank.
- (gnc:html-barchart-set-y-axis-label!
- chart (gnc-commodity-get-mnemonic report-currency))
- (gnc:html-barchart-set-row-labels-rotated?! chart #t)
- (gnc:html-barchart-set-stacked?! chart stacked?)
- ;; If this is a stacked barchart, then reverse the legend.
- ;; Doesn't do what you'd expect. - DRH
- ;; It does work, but needs Guppi 0.40.4. - cstim
- (gnc:html-barchart-set-legend-reversed?! chart stacked?)
- )
- (begin
- (gnc:html-linechart-set-title! chart report-title)
- (gnc:html-linechart-set-subtitle!
- chart (format #f
- (if do-intervals?
- (_ "~a to ~a")
- (_ "Balances ~a to ~a"))
- (gnc:html-string-sanitize (qof-print-date from-date-t64))
- (gnc:html-string-sanitize (qof-print-date to-date-t64))))
-
- (gnc:html-linechart-set-width! chart width)
- (gnc:html-linechart-set-height! chart height)
-
- ;; row labels etc.
- (gnc:html-linechart-set-row-labels! chart date-iso-string-list)
- ;; FIXME: axis labels are not yet supported by
- ;; libguppitank.
- (gnc:html-linechart-set-y-axis-label!
- chart (gnc-commodity-get-mnemonic report-currency))
- (gnc:html-linechart-set-row-labels-rotated?! chart #t)
- (gnc:html-linechart-set-stacked?! chart stacked?)
- ;; If this is a stacked linechart, then reverse the legend.
- ;; Doesn't do what you'd expect. - DRH
- ;; It does work, but needs Guppi 0.40.4. - cstim
- (gnc:html-linechart-set-legend-reversed?! chart stacked?)
- )
- )
-
+ (begin
+ (gnc:html-barchart-set-title! chart report-title)
+ (gnc:html-barchart-set-subtitle!
+ chart (format #f
+ (if do-intervals?
+ (_ "~a to ~a")
+ (_ "Balances ~a to ~a"))
+ (gnc:html-string-sanitize (qof-print-date from-date-t64))
+ (gnc:html-string-sanitize (qof-print-date to-date-t64))))
+
+ (gnc:html-barchart-set-width! chart width)
+ (gnc:html-barchart-set-height! chart height)
+
+ ;; row labels etc.
+ (gnc:html-barchart-set-row-labels! chart date-string-list)
+ ;; FIXME: axis labels are not yet supported by
+ ;; libguppitank.
+ (gnc:html-barchart-set-y-axis-label!
+ chart (gnc-commodity-get-mnemonic report-currency))
+ (gnc:html-barchart-set-row-labels-rotated?! chart #t)
+ (gnc:html-barchart-set-stacked?! chart stacked?)
+ ;; If this is a stacked barchart, then reverse the legend.
+ ;; Doesn't do what you'd expect. - DRH
+ ;; It does work, but needs Guppi 0.40.4. - cstim
+ (gnc:html-barchart-set-legend-reversed?! chart stacked?)
+ )
+ (begin
+ (gnc:html-linechart-set-title! chart report-title)
+ (gnc:html-linechart-set-subtitle!
+ chart (format #f
+ (if do-intervals?
+ (_ "~a to ~a")
+ (_ "Balances ~a to ~a"))
+ (gnc:html-string-sanitize (qof-print-date from-date-t64))
+ (gnc:html-string-sanitize (qof-print-date to-date-t64))))
+
+ (gnc:html-linechart-set-width! chart width)
+ (gnc:html-linechart-set-height! chart height)
+
+ ;; row labels etc.
+ (gnc:html-linechart-set-row-labels! chart date-iso-string-list)
+ ;; FIXME: axis labels are not yet supported by
+ ;; libguppitank.
+ (gnc:html-linechart-set-y-axis-label!
+ chart (gnc-commodity-get-mnemonic report-currency))
+ (gnc:html-linechart-set-row-labels-rotated?! chart #t)
+ (gnc:html-linechart-set-stacked?! chart stacked?)
+ ;; If this is a stacked linechart, then reverse the legend.
+ ;; Doesn't do what you'd expect. - DRH
+ ;; It does work, but needs Guppi 0.40.4. - cstim
+ (gnc:html-linechart-set-legend-reversed?! chart stacked?)
+ )
+ )
+
;; If we have too many categories, we sum them into a new
;; 'other' category and add a link to a new report with just
;; those accounts.
(if (> (length all-data) max-slices)
(let* ((start (take all-data (- max-slices 1)))
(finish (drop all-data (- max-slices 1)))
- (other-sum (map
+ (other-sum (map
(lambda (l) (apply monetary+ l))
(apply zip (map cadr finish)))))
(set! all-data
- (append start
- (list (list (_ "Other") other-sum))))
+ (append start
+ (list (list (_ "Other") other-sum))))
(let* ((options (gnc:make-report-options reportguid))
(id #f))
;; now copy all the options
- (gnc:options-copy-values
+ (gnc:options-copy-values
(gnc:report-options report-obj) options)
;; and set the destination accounts
(gnc:option-set-value
- (gnc:lookup-option options gnc:pagename-accounts
+ (gnc:lookup-option options gnc:pagename-accounts
optname-accounts)
(map car finish))
;; Set the URL to point to this report.
(set! id (gnc:make-report reportguid options))
(set! other-anchor (gnc:report-anchor-text id)))))
-
-
+
+
;; This adds the data. Note the apply-zip stuff: This
;; transposes the data, i.e. swaps rows and columns. Pretty
;; cool, eh? Courtesy of dave_p.
- (gnc:report-percent-done 92)
+ (gnc:report-percent-done 92)
(if (eqv? chart-type 'barchart)
- (begin ;; bar chart
- (if (not (null? all-data))
- (gnc:html-barchart-set-data!
- chart
- (apply zip (map (lambda (mlist)
- (map monetary->double mlist))
- (map cadr all-data)))))
-
- ;; Labels and colors
- (gnc:report-percent-done 94)
- (gnc:html-barchart-set-col-labels!
- chart (map (lambda (pair)
- (if (string? (car pair))
- (car pair)
- ((if show-fullname?
- gnc-account-get-full-name
- xaccAccountGetName) (car pair))))
- all-data))
- (gnc:html-barchart-set-col-colors!
- chart
- (gnc:assign-colors (length all-data)))
- )
- (begin ;; line chart
- (if (not (null? all-data))
- (gnc:html-linechart-set-data!
- chart
- (apply zip (map (lambda (mlist)
- (map monetary->double mlist))
- (map cadr all-data)))))
-
- ;; Labels and colors
- (gnc:report-percent-done 94)
- (gnc:html-linechart-set-col-labels!
- chart (map (lambda (pair)
- (if (string? (car pair))
- (car pair)
- ((if show-fullname?
- gnc-account-get-full-name
- xaccAccountGetName) (car pair))))
- all-data))
- (gnc:html-linechart-set-col-colors!
- chart
- (gnc:assign-colors (length all-data)))
- )
- )
-
+ (begin ;; bar chart
+ (if (not (null? all-data))
+ (gnc:html-barchart-set-data!
+ chart
+ (apply zip (map (lambda (mlist)
+ (map monetary->double mlist))
+ (map cadr all-data)))))
+
+ ;; Labels and colors
+ (gnc:report-percent-done 94)
+ (gnc:html-barchart-set-col-labels!
+ chart (map (lambda (pair)
+ (if (string? (car pair))
+ (car pair)
+ ((if show-fullname?
+ gnc-account-get-full-name
+ xaccAccountGetName) (car pair))))
+ all-data))
+ (gnc:html-barchart-set-col-colors!
+ chart
+ (gnc:assign-colors (length all-data)))
+ )
+ (begin ;; line chart
+ (if (not (null? all-data))
+ (gnc:html-linechart-set-data!
+ chart
+ (apply zip (map (lambda (mlist)
+ (map monetary->double mlist))
+ (map cadr all-data)))))
+
+ ;; Labels and colors
+ (gnc:report-percent-done 94)
+ (gnc:html-linechart-set-col-labels!
+ chart (map (lambda (pair)
+ (if (string? (car pair))
+ (car pair)
+ ((if show-fullname?
+ gnc-account-get-full-name
+ xaccAccountGetName) (car pair))))
+ all-data))
+ (gnc:html-linechart-set-col-colors!
+ chart
+ (gnc:assign-colors (length all-data)))
+ )
+ )
+
;; set the URLs; the slices are links to other reports
-;; (gnc:report-percent-done 96)
-;; (let
-;; ((urls
-;; (map
-;; (lambda (pair)
-;; (if
-;; (string? (car pair))
-;; other-anchor
-;; (let* ((acct (car pair))
-;; (subaccts
-;; (gnc-account-get-children acct)))
-;; (if (null? subaccts)
-;; ;; if leaf-account, make this an anchor
-;; ;; to the register.
-;; (gnc:account-anchor-text acct)
-;; ;; if non-leaf account, make this a link
-;; ;; to another report which is run on the
-;; ;; immediate subaccounts of this account
-;; ;; (and including this account).
-;; (gnc:make-report-anchor
-;; reportguid
-;; report-obj
-;; (list
-;; (list gnc:pagename-accounts optname-accounts
-;; (cons acct subaccts))
-;; (list gnc:pagename-accounts optname-levels
-;; (+ 1 tree-depth))
-;; (list gnc:pagename-general
-;; gnc:optname-reportname
-;; ((if show-fullname?
-;; gnc-account-get-full-name
-;; xaccAccountGetName) acct))))))))
-;; all-data)))
-;; (if (eqv? chart-type 'barchart)
-;; (begin ;; bar chart
-;; (gnc:html-barchart-set-button-1-bar-urls!
-;; chart (append urls urls))
-;; ;; The legend urls do the same thing.
-;; (gnc:html-barchart-set-button-1-legend-urls!
-;; chart (append urls urls))
-;; )
-;; (begin ;; line chart
-;; (gnc:html-linechart-set-button-1-line-urls!
-;; chart (append urls urls))
-;; ;; The legend urls do the same thing.
-;; (gnc:html-linechart-set-button-1-legend-urls!
-;; chart (append urls urls))
-;; )
-;; )
-;; )
-
- (gnc:report-percent-done 98)
+ ;; (gnc:report-percent-done 96)
+ ;; (let
+ ;; ((urls
+ ;; (map
+ ;; (lambda (pair)
+ ;; (if
+ ;; (string? (car pair))
+ ;; other-anchor
+ ;; (let* ((acct (car pair))
+ ;; (subaccts
+ ;; (gnc-account-get-children acct)))
+ ;; (if (null? subaccts)
+ ;; ;; if leaf-account, make this an anchor
+ ;; ;; to the register.
+ ;; (gnc:account-anchor-text acct)
+ ;; ;; if non-leaf account, make this a link
+ ;; ;; to another report which is run on the
+ ;; ;; immediate subaccounts of this account
+ ;; ;; (and including this account).
+ ;; (gnc:make-report-anchor
+ ;; reportguid
+ ;; report-obj
+ ;; (list
+ ;; (list gnc:pagename-accounts optname-accounts
+ ;; (cons acct subaccts))
+ ;; (list gnc:pagename-accounts optname-levels
+ ;; (+ 1 tree-depth))
+ ;; (list gnc:pagename-general
+ ;; gnc:optname-reportname
+ ;; ((if show-fullname?
+ ;; gnc-account-get-full-name
+ ;; xaccAccountGetName) acct))))))))
+ ;; all-data)))
+ ;; (if (eqv? chart-type 'barchart)
+ ;; (begin ;; bar chart
+ ;; (gnc:html-barchart-set-button-1-bar-urls!
+ ;; chart (append urls urls))
+ ;; ;; The legend urls do the same thing.
+ ;; (gnc:html-barchart-set-button-1-legend-urls!
+ ;; chart (append urls urls))
+ ;; )
+ ;; (begin ;; line chart
+ ;; (gnc:html-linechart-set-button-1-line-urls!
+ ;; chart (append urls urls))
+ ;; ;; The legend urls do the same thing.
+ ;; (gnc:html-linechart-set-button-1-legend-urls!
+ ;; chart (append urls urls))
+ ;; )
+ ;; )
+ ;; )
+
+ (gnc:report-percent-done 98)
(gnc:html-document-add-object! document chart)
(if show-table?
(begin
@@ -753,11 +753,11 @@ developing over time"))
(append
(list (_ "Date"))
(map (lambda (pair)
- (if (string? (car pair))
- (car pair)
- ((if show-fullname?
- gnc-account-get-full-name
- xaccAccountGetName) (car pair))))
+ (if (string? (car pair))
+ (car pair)
+ ((if show-fullname?
+ gnc-account-get-full-name
+ xaccAccountGetName) (car pair))))
all-data)
(if (> (gnc:html-table-num-columns table) 2)
(list (_ "Grand Total"))
@@ -789,7 +789,7 @@ developing over time"))
)
)
)
- ;; set numeric columns to align right
+ ;; set numeric columns to align right
(for-each
(lambda (col)
(gnc:html-table-set-col-style!
@@ -805,28 +805,28 @@ developing over time"))
(gnc:html-document-add-object!
document
(gnc:html-make-empty-data-warning
- report-title (gnc:report-id report-obj)))))
-
- ;; else if no accounts selected
- (gnc:html-document-add-object!
- document
- (gnc:html-make-no-account-warning
- report-title (gnc:report-id report-obj))))
-
+ report-title (gnc:report-id report-obj)))))
+
+ ;; else if no accounts selected
+ (gnc:html-document-add-object!
+ document
+ (gnc:html-make-no-account-warning
+ report-title (gnc:report-id report-obj))))
+
(gnc:report-finished)
document))
;; Export reports
(export category-barchart-income-uuid category-barchart-expense-uuid
- category-barchart-asset-uuid category-barchart-liability-uuid)
+ category-barchart-asset-uuid category-barchart-liability-uuid)
(define category-barchart-income-uuid "44f81bee049b4b3ea908f8dac9a9474e")
(define category-barchart-expense-uuid "b1f15b2052c149df93e698fe85a81ea6")
(define category-barchart-asset-uuid "e9cf815f79db44bcb637d0295093ae3d")
(define category-barchart-liability-uuid "faf410e8f8da481fbc09e4763da40bcc")
-(for-each
+(for-each
(lambda (l)
(let ((tip-and-rev (cddddr l)))
(gnc:define-report
@@ -834,31 +834,31 @@ developing over time"))
'name (car l)
'report-guid (car (reverse l))
'menu-path (if (caddr l)
- (list gnc:menuname-income-expense)
- (list gnc:menuname-asset-liability))
+ (list gnc:menuname-income-expense)
+ (list gnc:menuname-asset-liability))
'menu-name (cadddr l)
'menu-tip (car tip-and-rev)
- 'options-generator (lambda () (options-generator (cadr l)
+ 'options-generator (lambda () (options-generator (cadr l)
(cadr tip-and-rev)
(caddr l)))
'renderer (lambda (report-obj)
- (category-barchart-renderer report-obj
- (car l)
- (car (reverse l))
- (cadr l)
- (caddr l))))))
- (list
- ;; reportname, account-types, do-intervals?,
+ (category-barchart-renderer report-obj
+ (car l)
+ (car (reverse l))
+ (cadr l)
+ (caddr l))))))
+ (list
+ ;; reportname, account-types, do-intervals?,
;; menu-reportname, menu-tip
(list reportname-income (list ACCT-TYPE-INCOME) #t menuname-income menutip-income (lambda (x) #t) category-barchart-income-uuid)
(list reportname-expense (list ACCT-TYPE-EXPENSE) #t menuname-expense menutip-expense (lambda (x) #f) category-barchart-expense-uuid)
- (list reportname-assets
+ (list reportname-assets
(list ACCT-TYPE-ASSET ACCT-TYPE-BANK ACCT-TYPE-CASH ACCT-TYPE-CHECKING
ACCT-TYPE-SAVINGS ACCT-TYPE-MONEYMRKT
ACCT-TYPE-RECEIVABLE ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL
ACCT-TYPE-CURRENCY)
#f menuname-assets menutip-assets (lambda (x) #f) category-barchart-asset-uuid)
- (list reportname-liabilities
+ (list reportname-liabilities
(list ACCT-TYPE-LIABILITY ACCT-TYPE-PAYABLE ACCT-TYPE-CREDIT
ACCT-TYPE-CREDITLINE)
#f menuname-liabilities menutip-liabilities (lambda (x) #t) category-barchart-liability-uuid)))
commit 6c59cd15cdafc490892349127a5af871436f91ec
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Oct 17 17:52:18 2018 +0800
[category-barchart] Deoptimize category-barchart
This aims to partially undo commit 8aed5c3f660, and removes dependency
unto collectors and report-collectors.
diff --git a/gnucash/report/standard-reports/category-barchart.scm b/gnucash/report/standard-reports/category-barchart.scm
index ba23a97..b3b9129 100644
--- a/gnucash/report/standard-reports/category-barchart.scm
+++ b/gnucash/report/standard-reports/category-barchart.scm
@@ -24,8 +24,6 @@
;; depends must be outside module scope -- and should eventually go away.
(define-module (gnucash report standard-reports category-barchart))
-(use-modules (gnucash report report-system report-collectors))
-(use-modules (gnucash report report-system collectors))
(use-modules (srfi srfi-1))
(use-modules (gnucash utilities))
(use-modules (gnucash gnc-module))
@@ -263,6 +261,8 @@ developing over time"))
(sort-method (get-option gnc:pagename-display optname-sort-method))
(reverse-balance? (get-option "__report" "reverse-balance?"))
+ (work-done 0)
+ (work-to-do 0)
(show-table? (get-option gnc:pagename-display (N_ "Show table")))
(document (gnc:make-html-document))
(chart
@@ -285,16 +285,8 @@ developing over time"))
(gnc:get-current-account-tree-depth)
account-levels))
- (define the-acount-destination-alist
- (account-destination-alist accounts account-types tree-depth))
-
;;(gnc:debug accounts)
(if (not (null? accounts))
- (if (null? the-acount-destination-alist)
- (gnc:html-document-add-object!
- document
- (gnc:html-make-empty-data-warning
- report-title (gnc:report-id report-obj)))
;; Define more helper variables.
(let* ((commodity-list #f)
@@ -404,6 +396,34 @@ developing over time"))
((list? data) (myor (map not-all-zeros data)))
(else #f)))
+ ;; Calculates the net balance (profit or loss) of an account in
+ ;; the given time interval. date-list-entry is a pair containing
+ ;; the start- and end-date of that interval. If subacct?==#t,
+ ;; the subaccount's balances are included as well. Returns a
+ ;; double, exchanged into the report-currency by the above
+ ;; conversion function, and possibly with reversed sign.
+ (define (get-balance account date-list-entry subacct?)
+ ((if (reverse-balance? account)
+ gnc:monetary-neg identity)
+ (if do-intervals?
+ (collector->monetary
+ (gnc:account-get-comm-balance-interval
+ account
+ (first date-list-entry)
+ (second date-list-entry) subacct?)
+ (second date-list-entry))
+ (collector->monetary
+ (gnc:account-get-comm-balance-at-date
+ account date-list-entry subacct?)
+ date-list-entry))))
+
+;; Creates the <balance-list> to be used in the function
+ ;; below.
+ (define (account->balance-list account subacct?)
+ (map
+ (lambda (d) (get-balance account d subacct?))
+ dates-list))
+
(define (count-accounts current-depth accts)
(if (< current-depth tree-depth)
(let ((sum 0))
@@ -429,34 +449,33 @@ developing over time"))
;; show-acct? is true. This is necessary because otherwise we
;; would forget an account that is selected but not its
;; parent.
- (define (apply-sign account x)
- (if (reverse-balance? account) (gnc:monetary-neg x) x))
- (define (calculate-report accounts progress-range)
- (let* ((account-reformat
- (if do-intervals?
- (lambda (account result)
- (map (lambda (collector datepair)
- (let ((date (second datepair)))
- (apply-sign account (collector->monetary collector date))))
- result dates-list))
- (lambda (account result)
- (let ((commodity-collector (gnc:make-commodity-collector)))
- (collector-end (fold (lambda (next date list-collector)
- (commodity-collector 'merge next #f)
- (collector-add list-collector
- (apply-sign account
- (collector->monetary commodity-collector
- date))))
- (collector-into-list)
- result dates-list))))))
-
- (the-work (category-by-account-report-work do-intervals?
- dates-list the-acount-destination-alist
- (lambda (account date)
- (make-gnc-collector-collector))
- account-reformat))
- (the-report (category-by-account-report-do-work the-work progress-range)))
- the-report))
+ (define (traverse-accounts current-depth accts)
+ (if (< current-depth tree-depth)
+ (let ((res '()))
+ (for-each
+ (lambda (a)
+ (begin
+ (set! work-done (1+ work-done))
+ (gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do))))
+ (if (show-acct? a)
+ (set! res
+ (cons (list a (account->balance-list a #f))
+ res)))
+ (set! res (append
+ (traverse-accounts
+ (+ 1 current-depth)
+ (gnc-account-get-children a))
+ res))))
+ accts)
+ res)
+ ;; else (i.e. current-depth == tree-depth)
+ (map
+ (lambda (a)
+ (set! work-done (1+ work-done))
+ (gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do))))
+ (list a (account->balance-list a #t)))
+ (filter show-acct? accts))))
+
;; The percentage done numbers here are a hack so that
;; something gets displayed. On my system the
@@ -476,12 +495,15 @@ developing over time"))
commodity-list to-date-t64
5 15))
+ (set! work-to-do (count-accounts 1 topl-accounts))
+
;; Sort the account list according to the account code field.
- (set! all-data (sort
- (filter (lambda (l)
- (not (gnc-numeric-equal (gnc-numeric-zero)
- (gnc:gnc-monetary-amount (apply monetary+ (cadr l))))))
- (calculate-report accounts (cons 0 90)))
+ (set! all-data (sort
+ (filter (lambda (l)
+ (not (zero?
+ (gnc:gnc-monetary-amount
+ (apply monetary+ (cadr l))))))
+ (traverse-accounts 1 topl-accounts))
(cond
((eq? sort-method 'acct-code)
(lambda (a b)
@@ -783,7 +805,7 @@ developing over time"))
(gnc:html-document-add-object!
document
(gnc:html-make-empty-data-warning
- report-title (gnc:report-id report-obj))))))
+ report-title (gnc:report-id report-obj)))))
;; else if no accounts selected
(gnc:html-document-add-object!
commit c13f076a331928d583892fd55397623038cbbe42
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Oct 18 14:19:07 2018 +0800
[report-utilities] modify gnc-account-get-balances-at-dates
instead of returning a list of numbers e.g. (list 200 400 600), return
a list of gnc-monetary objects (list $200 $400 $600) to be more
meaningful.
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index de98730..e2fa050 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -411,8 +411,10 @@ flawed. see report-utilities.scm. please update reports.")
;; in: account
;; dates-list (list of time64)
;; ignore-closing? - if #true, will skip closing entries
-;; out: (list bal0 bal1 ...), each entry is a scheme number
+;; out: (list bal0 bal1 ...), each entry is a gnc-monetary object
(define* (gnc:account-get-balances-at-dates account dates-list #:key ignore-closing?)
+ (define (amount->monetary bal)
+ (gnc:make-gnc-monetary (xaccAccountGetCommodity account) bal))
(let loop ((splits (xaccAccountGetSplitList account))
(dates-list dates-list)
(currentbal 0)
@@ -422,7 +424,7 @@ flawed. see report-utilities.scm. please update reports.")
;; end of dates. job done!
((null? dates-list)
- (reverse balancelist))
+ (map amount->monetary (reverse balancelist)))
;; end of splits, but still has dates. pad with last-bal
;; until end of dates.
diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm
index ff31e7e..ca8ecb3 100644
--- a/gnucash/report/standard-reports/net-charts.scm
+++ b/gnucash/report/standard-reports/net-charts.scm
@@ -295,7 +295,7 @@
(define (acc-balances->list-of-balances lst)
;; input: (list (list acc1 bal0 bal1 bal2 ...)
;; (list acc2 bal0 bal1 bal2 ...) ...)
- ;; whereby list of balances are numbers in the acc's currency
+ ;; whereby list of balances are gnc-monetary objects
;; output: (list <mon-coll0> <mon-coll1> <mon-coll2>)
(define list-of-collectors
(let loop ((n (length dates)) (result '()))
@@ -307,8 +307,8 @@
(list-of-balances (cdar lst)))
(when (pair? list-of-balances)
((car list-of-collectors) 'add
- (xaccAccountGetCommodity (caar lst))
- (car list-of-balances))
+ (gnc:gnc-monetary-commodity (car list-of-balances))
+ (gnc:gnc-monetary-amount (car list-of-balances)))
(innerloop (cdr list-of-collectors) (cdr list-of-balances))))
(loop (cdr lst))))
list-of-collectors)
commit 1444a58c0ea0bfc55081dd2d242cdd75a7c883af
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Oct 17 22:25:53 2018 +0800
[report-utilities] upgrade (gnc:account-get-balances-at-dates)
(gnc:account-get-balances-at-dates) is upgraded to
report-utilities. this function is slightly different to its
single-account counterpart because it does not retrieve subaccount
amounts.
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index f600835..ab45ea2 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -695,6 +695,7 @@
(export gnc:commodity-collectorlist-get-merged)
(export gnc-commodity-collector-commodity-count)
(export gnc:account-get-balance-at-date)
+(export gnc:account-get-balances-at-dates)
(export gnc:account-get-comm-balance-at-date)
(export gnc:account-get-comm-value-interval)
(export gnc:account-get-comm-value-at-date)
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 7b3f803..de98730 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -406,6 +406,63 @@ flawed. see report-utilities.scm. please update reports.")
account date include-children?)))
(cadr (collector 'getpair (xaccAccountGetCommodity account) #f))))
+;; this function will scan through the account splitlist, building
+;; a list of balances along the way at dates specified in dates-list.
+;; in: account
+;; dates-list (list of time64)
+;; ignore-closing? - if #true, will skip closing entries
+;; out: (list bal0 bal1 ...), each entry is a scheme number
+(define* (gnc:account-get-balances-at-dates account dates-list #:key ignore-closing?)
+ (let loop ((splits (xaccAccountGetSplitList account))
+ (dates-list dates-list)
+ (currentbal 0)
+ (lastbal 0)
+ (balancelist '()))
+ (cond
+
+ ;; end of dates. job done!
+ ((null? dates-list)
+ (reverse balancelist))
+
+ ;; end of splits, but still has dates. pad with last-bal
+ ;; until end of dates.
+ ((null? splits)
+ (loop '()
+ (cdr dates-list)
+ currentbal
+ lastbal
+ (cons lastbal balancelist)))
+
+ (else
+ (let* ((this (car splits))
+ (rest (cdr splits))
+ (currentbal (if (and ignore-closing?
+ (xaccTransGetIsClosingTxn (xaccSplitGetParent this)))
+ currentbal
+ (+ (xaccSplitGetAmount this) currentbal)))
+ (next (and (pair? rest) (car rest))))
+
+ (cond
+ ;; the next split is still before date
+ ((and next (< (xaccTransGetDate (xaccSplitGetParent next)) (car dates-list)))
+ (loop rest dates-list currentbal lastbal balancelist))
+
+ ;; this split after date, add previous bal to balancelist
+ ((< (car dates-list) (xaccTransGetDate (xaccSplitGetParent this)))
+ (loop splits
+ (cdr dates-list)
+ lastbal
+ lastbal
+ (cons lastbal balancelist)))
+
+ ;; this split before date, next split after date, or end.
+ (else
+ (loop rest
+ (cdr dates-list)
+ currentbal
+ currentbal
+ (cons currentbal balancelist)))))))))
+
;; This works similar as above but returns a commodity-collector,
;; thus takes care of children accounts with different currencies.
(define (gnc:account-get-comm-balance-at-date
diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm
index 317a220..ff31e7e 100644
--- a/gnucash/report/standard-reports/net-charts.scm
+++ b/gnucash/report/standard-reports/net-charts.scm
@@ -258,71 +258,13 @@
(warn "incompatible currencies in monetary+: " a b)))
(warn "wrong arguments for monetary+: " a b)))
- (define (split->date s)
- (xaccTransGetDate (xaccSplitGetParent s)))
-
- ;; this function will scan through the account splitlist, building
- ;; a list of balances along the way. it will use the dates
- ;; specified in the variable dates-list.
- ;; input: account
- ;; uses: dates-list (list of time64)
- ;; out: (list account bal0 bal1 ...)
+ ;; gets an account alist balances
+ ;; output: (list acc bal0 bal1 bal2 ...)
(define (account->balancelist account)
-
- ;; the test-closing? function will enable testing closing status
- ;; for inc-exp only. this may squeeze more speed for net-worth charts.
- (define test-closing?
- (gnc:account-is-inc-exp? account))
-
- (let loop ((splits (xaccAccountGetSplitList account))
- (dates dates-list)
- (currentbal 0)
- (lastbal 0)
- (balancelist '()))
- (cond
-
- ;; end of dates. job done!
- ((null? dates)
- (cons account (reverse balancelist)))
-
- ;; end of splits, but still has dates. pad with last-bal
- ;; until end of dates.
- ((null? splits)
- (loop '()
- (cdr dates)
- currentbal
- lastbal
- (cons lastbal balancelist)))
-
- (else
- (let* ((this (car splits))
- (rest (cdr splits))
- (currentbal (if (and test-closing?
- (xaccTransGetIsClosingTxn (xaccSplitGetParent this)))
- currentbal
- (+ (xaccSplitGetAmount this) currentbal)))
- (next (and (pair? rest) (car rest))))
-
- (cond
- ;; the next split is still before date
- ((and next (< (split->date next) (car dates)))
- (loop rest dates currentbal lastbal balancelist))
-
- ;; this split after date, add previous bal to balancelist
- ((< (car dates) (split->date this))
- (loop splits
- (cdr dates)
- lastbal
- lastbal
- (cons lastbal balancelist)))
-
- ;; this split before date, next split after date, or end.
- (else
- (loop rest
- (cdr dates)
- currentbal
- currentbal
- (cons currentbal balancelist)))))))))
+ (cons account
+ (gnc:account-get-balances-at-dates
+ account dates-list
+ #:ignore-closing? (gnc:account-is-inc-exp? account))))
;; This calculates the balances for all the 'account-balances' for
;; each element of the list 'dates'. Uses the collector->monetary
commit c94db1ac340c69832192d05813e565b4f68db41a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Oct 18 14:10:36 2018 +0800
[report-utilities] deprecate flawed function.
I think this (gnc:account-get-balance-at-date) is flawed in sub-acct handling.
Consider account structure:
Assets [USD] - bal=$0
Bank [USD] - bal=$100
Broker [USD] - bal=$200
Cash [USD] - bal=$800
Funds [FUND] - bal=3 FUND @ $1000 each = $3000
- Calling (gnc:account-get-balance-at-date BANK TODAY #f) returns 100
- Calling (gnc:account-get-balance-at-date BROKER TODAY #f) returns 200
- Calling (gnc:account-get-balance-at-date BROKER TODAY #t) returns 1000
this is because although it counts all subaccounts bal $200 + $800 + 3FUND,
it retrieves the parent account commodity USD $1000 only.
It needs to be deprecated.
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index f01a97a..7b3f803 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -386,7 +386,22 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
;; get the account balance at the specified date. if include-children?
;; is true, the balances of all children (not just direct children)
;; are included in the calculation.
+;; I think this (gnc:account-get-balance-at-date) is flawed in sub-acct handling.
+;; Consider account structure:
+;; Assets [USD] - bal=$0
+;; Bank [USD] - bal=$100
+;; Broker [USD] - bal=$200
+;; Cash [USD] - bal=$800
+;; Funds [FUND] - bal=3 FUND @ $1000 each = $3000
+;; - Calling (gnc:account-get-balance-at-date BANK TODAY #f) returns 100
+;; - Calling (gnc:account-get-balance-at-date BROKER TODAY #f) returns 200
+;; - Calling (gnc:account-get-balance-at-date BROKER TODAY #t) returns 1000
+;; this is because although it counts all subaccounts bal $200 + $800 + 3FUND,
+;; it retrieves the parent account commodity USD $1000 only.
+;; It needs to be deprecated.
(define (gnc:account-get-balance-at-date account date include-children?)
+ (issue-deprecation-warning "this gnc:account-get-balance-at-date function is \
+flawed. see report-utilities.scm. please update reports.")
(let ((collector (gnc:account-get-comm-balance-at-date
account date include-children?)))
(cadr (collector 'getpair (xaccAccountGetCommodity account) #f))))
Summary of changes:
gnucash/report/report-system/report-system.scm | 1 +
gnucash/report/report-system/report-utilities.scm | 74 ++
.../report/standard-reports/category-barchart.scm | 909 ++++++++++-----------
gnucash/report/standard-reports/net-charts.scm | 76 +-
4 files changed, 535 insertions(+), 525 deletions(-)
More information about the gnucash-changes
mailing list