diff --git a/gnucash/report/reports/CMakeLists.txt b/gnucash/report/reports/CMakeLists.txt index 9aac9e62f4..ad0a66fac5 100644 --- a/gnucash/report/reports/CMakeLists.txt +++ b/gnucash/report/reports/CMakeLists.txt @@ -4,6 +4,7 @@ add_subdirectory(support) set (reports_common_SCHEME aging.scm + cash-flow-calc.scm ) # The 'with exposed generator' reports are standard reports that can @@ -34,6 +35,7 @@ set (reports_standard_SCHEME standard/budget-income-statement.scm standard/budget.scm standard/cash-flow.scm + standard/cashflow-barchart.scm standard/category-barchart.scm standard/dashboard.scm standard/equity-statement.scm @@ -57,8 +59,7 @@ set (reports_standard_SCHEME ) set (reports_standard_SCHEME_2 - standard/cashflow-barchart.scm #depends on cash-flow report - standard/customer-summary.scm # Depends on owner-report + standard/customer-summary.scm # Depends on gnc:owner-report-create ) set(reports_example_SCHEME diff --git a/gnucash/report/reports/cash-flow-calc.scm b/gnucash/report/reports/cash-flow-calc.scm new file mode 100644 index 0000000000..472c484f0b --- /dev/null +++ b/gnucash/report/reports/cash-flow-calc.scm @@ -0,0 +1,107 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; cash-flow-calc.scm: Cash Flow in-out calculation. +;; +;; copyright 2015 Peter Broadberry +;; copyright 2019 Christopher Lam +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, contact: +;; +;; Free Software Foundation Voice: +1-617-542-5942 +;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 +;; Boston, MA 02110-1301, USA gnu@gnu.org +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-module (gnucash reports cash-flow-calc)) +(use-modules (gnucash engine)) +(use-modules (gnucash utilities)) +(use-modules (gnucash core-utils)) +(use-modules (gnucash app-utils)) +(use-modules (gnucash report)) + +;; function to add inflow and outflow of money +(define-public (cash-flow-calc-money-in-out settings) + (let* ((accounts (cdr (assq 'accounts settings))) + (to-date-t64 (cdr (assq 'to-date-t64 settings))) + (from-date-t64 (cdr (assq 'from-date-t64 settings))) + (report-currency (cdr (assq 'report-currency settings))) + (include-trading-accounts + (cdr (assq 'include-trading-accounts settings))) + (to-report-currency (cdr (assq 'to-report-currency settings))) + (money-in '()) + (money-in-collector (gnc:make-commodity-collector)) + (money-out '()) + (money-out-collector (gnc:make-commodity-collector)) + (all-splits (gnc:account-get-trans-type-splits-interval + accounts '() from-date-t64 to-date-t64)) + (splits-to-do (length all-splits)) + (splits-seen-list '())) + + (let loop ((splits all-splits) + (work-done 0)) + (unless (null? splits) + (if (zero? (modulo work-done 100)) + (gnc:report-percent-done (* 85 (/ work-done splits-to-do)))) + (let* ((split (car splits)) + (parent (xaccSplitGetParent split))) + (for-each + (lambda (s) + (let* ((s-account (xaccSplitGetAccount s)) + (s-value (xaccSplitGetValue s)) + (s-report-value (to-report-currency (xaccTransGetCurrency parent) + (abs s-value) + (xaccTransGetDate parent)))) + (cond + ((null? s-account) + (format #t "WARNING: s-account is NULL for split: ~a\n" + (gncSplitGetGUID s))) + ((or (and include-trading-accounts + (eqv? (xaccAccountGetType s-account) + ACCT-TYPE-TRADING)) + (member s-account accounts) + (member s splits-seen-list)) + #f) + ((negative? s-value) + (let ((s-account-in-collector + (or (assoc-ref money-in s-account) + (let ((coll (gnc:make-commodity-collector))) + (set! money-in + (assoc-set! money-in s-account coll)) + coll)))) + (set! splits-seen-list (cons s splits-seen-list)) + (money-in-collector 'add report-currency s-report-value) + (s-account-in-collector + 'add report-currency s-report-value))) + ((positive? s-value) + (let ((s-account-out-collector + (or (assoc-ref money-out s-account) + (let ((coll (gnc:make-commodity-collector))) + (set! money-out + (assoc-set! money-out s-account coll)) + coll)))) + (set! splits-seen-list (cons s splits-seen-list)) + (money-out-collector 'add report-currency s-report-value) + (s-account-out-collector + 'add report-currency s-report-value)))))) + (xaccTransGetSplitList parent))) + (loop (cdr splits) (1+ work-done)))) + + ;; Return an association list of results + (list + (cons 'money-in-accounts (map car money-in)) + (cons 'money-in-alist (map (lambda (p) (list (car p) (cdr p))) money-in)) + (cons 'money-in-collector money-in-collector) + (cons 'money-out-accounts (map car money-out)) + (cons 'money-out-alist (map (lambda (p) (list (car p) (cdr p))) money-out)) + (cons 'money-out-collector money-out-collector)))) + diff --git a/gnucash/report/reports/standard/cash-flow.scm b/gnucash/report/reports/standard/cash-flow.scm index b9a86b71d6..98992f9e77 100644 --- a/gnucash/report/reports/standard/cash-flow.scm +++ b/gnucash/report/reports/standard/cash-flow.scm @@ -33,8 +33,7 @@ (use-modules (gnucash core-utils)) (use-modules (gnucash app-utils)) (use-modules (gnucash report)) - -(export cash-flow-calc-money-in-out) +(use-modules (gnucash reports cash-flow-calc)) (define reportname (N_ "Cash Flow")) @@ -336,82 +335,6 @@ doc)) -;; function to add inflow and outflow of money -(define (cash-flow-calc-money-in-out settings) - (let* ((accounts (cdr (assq 'accounts settings))) - (to-date-t64 (cdr (assq 'to-date-t64 settings))) - (from-date-t64 (cdr (assq 'from-date-t64 settings))) - (report-currency (cdr (assq 'report-currency settings))) - (include-trading-accounts - (cdr (assq 'include-trading-accounts settings))) - (to-report-currency (cdr (assq 'to-report-currency settings))) - (money-in '()) - (money-in-collector (gnc:make-commodity-collector)) - (money-out '()) - (money-out-collector (gnc:make-commodity-collector)) - (all-splits (gnc:account-get-trans-type-splits-interval - accounts '() from-date-t64 to-date-t64)) - (splits-to-do (length all-splits)) - (splits-seen-list '())) - - (let loop ((splits all-splits) - (work-done 0)) - (unless (null? splits) - (if (zero? (modulo work-done 100)) - (gnc:report-percent-done (* 85 (/ work-done splits-to-do)))) - (let* ((split (car splits)) - (parent (xaccSplitGetParent split))) - (for-each - (lambda (s) - (let* ((s-account (xaccSplitGetAccount s)) - (s-value (xaccSplitGetValue s)) - (s-report-value (to-report-currency (xaccTransGetCurrency parent) - (abs s-value) - (xaccTransGetDate parent)))) - (cond - ((null? s-account) - (format #t "WARNING: s-account is NULL for split: ~a\n" - (gncSplitGetGUID s))) - ((or (and include-trading-accounts - (eqv? (xaccAccountGetType s-account) - ACCT-TYPE-TRADING)) - (member s-account accounts) - (member s splits-seen-list)) - #f) - ((negative? s-value) - (let ((s-account-in-collector - (or (assoc-ref money-in s-account) - (let ((coll (gnc:make-commodity-collector))) - (set! money-in - (assoc-set! money-in s-account coll)) - coll)))) - (set! splits-seen-list (cons s splits-seen-list)) - (money-in-collector 'add report-currency s-report-value) - (s-account-in-collector - 'add report-currency s-report-value))) - ((positive? s-value) - (let ((s-account-out-collector - (or (assoc-ref money-out s-account) - (let ((coll (gnc:make-commodity-collector))) - (set! money-out - (assoc-set! money-out s-account coll)) - coll)))) - (set! splits-seen-list (cons s splits-seen-list)) - (money-out-collector 'add report-currency s-report-value) - (s-account-out-collector - 'add report-currency s-report-value)))))) - (xaccTransGetSplitList parent))) - (loop (cdr splits) (1+ work-done)))) - - ;; Return an association list of results - (list - (cons 'money-in-accounts (map car money-in)) - (cons 'money-in-alist (map (lambda (p) (list (car p) (cdr p))) money-in)) - (cons 'money-in-collector money-in-collector) - (cons 'money-out-accounts (map car money-out)) - (cons 'money-out-alist (map (lambda (p) (list (car p) (cdr p))) money-out)) - (cons 'money-out-collector money-out-collector)))) - (gnc:define-report 'version 1 'name reportname diff --git a/gnucash/report/reports/standard/cashflow-barchart.scm b/gnucash/report/reports/standard/cashflow-barchart.scm index 4034af9c81..b3415783dc 100644 --- a/gnucash/report/reports/standard/cashflow-barchart.scm +++ b/gnucash/report/reports/standard/cashflow-barchart.scm @@ -33,7 +33,7 @@ (use-modules (gnucash utilities)) (use-modules (gnucash core-utils)) (use-modules (gnucash app-utils)) -(use-modules (gnucash reports standard cash-flow)) +(use-modules (gnucash reports cash-flow-calc)) (use-modules (gnucash report)) (define reportname (N_ "Cash Flow Barchart")) diff --git a/po/POTFILES.in b/po/POTFILES.in index cbcd104dec..9dfab16e44 100644 --- a/po/POTFILES.in +++ b/po/POTFILES.in @@ -455,6 +455,7 @@ gnucash/report/options-utilities.scm gnucash/report/report-core.scm gnucash/report/report-register-hooks.scm gnucash/report/reports/aging.scm +gnucash/report/reports/cash-flow-calc.scm gnucash/report/reports/example/average-balance.scm gnucash/report/reports/example/daily-reports.scm gnucash/report/reports/example/hello-world.scm