From 1444a58c0ea0bfc55081dd2d242cdd75a7c883af Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Wed, 17 Oct 2018 22:25:53 +0800 Subject: [PATCH] [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. --- .../report/report-system/report-system.scm | 1 + .../report/report-system/report-utilities.scm | 57 +++++++++++++++ .../report/standard-reports/net-charts.scm | 70 ++----------------- 3 files changed, 64 insertions(+), 64 deletions(-) diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm index f600835cf1..ab45ea26c0 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 7b3f803b96..de98730e58 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 317a2200ba..ff31e7e9f6 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