gnucash unstable: Multiple changes pushed
John Ralls
jralls at code.gnucash.org
Fri Oct 27 14:40:52 EDT 2017
Updated via https://github.com/Gnucash/gnucash/commit/e64e73b6 (commit)
via https://github.com/Gnucash/gnucash/commit/85fae7ef (commit)
via https://github.com/Gnucash/gnucash/commit/04b51002 (commit)
via https://github.com/Gnucash/gnucash/commit/fa789371 (commit)
via https://github.com/Gnucash/gnucash/commit/eda22039 (commit)
from https://github.com/Gnucash/gnucash/commit/115c0bf4 (commit)
commit e64e73b6556ec1f0e55704787f88ab4592d0d03d
Merge: 115c0bf 85fae7e
Author: John Ralls <jralls at ceridwen.us>
Date: Fri Oct 27 11:31:46 2017 -0700
Merge branch J. Marino's cashflow-barchart report into unstable.
commit 85fae7ef526cb24b3954a8a610b0ab4d55225d27
Author: Jose Marino <jmarino at users.noreply.github.com>
Date: Tue Oct 17 10:37:45 2017 -0600
add unit test for cashflow-barchart report
Heavily inspired by test-generic-net-barchart.scm with a touch of
test-cash-flow.scm
diff --git a/gnucash/report/standard-reports/cashflow-barchart.scm b/gnucash/report/standard-reports/cashflow-barchart.scm
index d4992af..0589a34 100644
--- a/gnucash/report/standard-reports/cashflow-barchart.scm
+++ b/gnucash/report/standard-reports/cashflow-barchart.scm
@@ -507,10 +507,14 @@
(cons 'money-in-collector money-in-collector)
(cons 'money-out-collector money-out-collector))))
+;; export to make uuid available to unit test: test-cashflow-barchart
+(export cashflow-barchart-uuid)
+(define cashflow-barchart-uuid "5426e4d987f6444387fe70880e5b28a0")
+
(gnc:define-report
'version 1
'name reportname
- 'report-guid "5426e4d987f6444387fe70880e5b28a0"
+ 'report-guid cashflow-barchart-uuid
'menu-tip (N_ "Shows a barchart with cash flow over time")
'menu-path (list gnc:menuname-income-expense)
'options-generator cashflow-barchart-options-generator
diff --git a/gnucash/report/standard-reports/test/CMakeLists.txt b/gnucash/report/standard-reports/test/CMakeLists.txt
index a771186..7be4c9c 100644
--- a/gnucash/report/standard-reports/test/CMakeLists.txt
+++ b/gnucash/report/standard-reports/test/CMakeLists.txt
@@ -1,4 +1,5 @@
GNC_ADD_SCHEME_TEST(test-cash-flow test-cash-flow.scm)
+GNC_ADD_SCHEME_TEST(test-cashflow-barchart test-cashflow-barchart.scm)
GNC_ADD_SCHEME_TEST(test-standard-category-report test-standard-category-report.scm)
GNC_ADD_SCHEME_TEST(test-standard-net-barchart test-standard-net-barchart.scm)
GNC_ADD_SCHEME_TEST(test-standard-net-linechart test-standard-net-linechart.scm)
@@ -20,5 +21,5 @@ GNC_ADD_SCHEME_TARGETS(scm-test-standard-reports
)
SET_DIST_LIST(test_standard_reports_DIST CMakeLists.txt Makefile.am ${scm_test_standard_reports_SOURCES}
- test-cash-flow.scm test-standard-category-report.scm test-standard-net-barchart.scm
+ test-cash-flow.scm test-cashflow-barchart.scm test-standard-category-report.scm test-standard-net-barchart.scm
test-standard-net-linechart.scm)
diff --git a/gnucash/report/standard-reports/test/Makefile.am b/gnucash/report/standard-reports/test/Makefile.am
index d6d5153..2a4e808 100644
--- a/gnucash/report/standard-reports/test/Makefile.am
+++ b/gnucash/report/standard-reports/test/Makefile.am
@@ -2,6 +2,7 @@ TESTS = $(SCM_TESTS)
SCM_TESTS = \
test-cash-flow \
+ test-cashflow-barchart \
test-standard-category-report \
test-standard-net-barchart \
test-standard-net-linechart
diff --git a/gnucash/report/standard-reports/test/test-cashflow-barchart.scm b/gnucash/report/standard-reports/test/test-cashflow-barchart.scm
new file mode 100644
index 0000000..e4f7dde
--- /dev/null
+++ b/gnucash/report/standard-reports/test/test-cashflow-barchart.scm
@@ -0,0 +1,288 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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 at gnu.org
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(use-modules (gnucash gnc-module))
+
+(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
+(gnc:module-load "gnucash/report/report-system" 0)
+
+(use-modules (gnucash engine))
+(use-modules (sw_engine))
+
+(use-modules (gnucash engine test test-extras))
+(use-modules (gnucash report report-system))
+(use-modules (gnucash report report-system test test-extras))
+(use-modules (gnucash report standard-reports cashflow-barchart))
+
+(add-to-load-path "../../stylesheets/")
+(use-modules (gnucash report stylesheets))
+
+(use-modules (ice-9 format))
+(use-modules (ice-9 streams))
+(use-modules (srfi srfi-1))
+
+
+(define (run-test)
+ (logging-and (test-in-txn)
+ (test-out-txn)
+ (test-null-txn)))
+
+
+(define (set-option report page tag value)
+ ((gnc:option-setter (gnc:lookup-option (gnc:report-options report)
+ page tag)) value))
+
+
+(define constructor (record-constructor <report>))
+
+
+(define structure
+ (list "Root" (list (cons 'type ACCT-TYPE-ASSET))
+ (list "Asset"
+ (list "Bank")
+ (list "Wallet"))
+ (list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
+ (list "Income" (list (cons 'type ACCT-TYPE-INCOME)))))
+
+
+;; Test two transactions from income to two different assets in two different days
+(define (test-in-txn)
+ (let* ((template (gnc:find-report-template cashflow-barchart-uuid))
+ (options (gnc:make-report-options cashflow-barchart-uuid))
+ (report (constructor cashflow-barchart-uuid "bar" options
+ #t #t #f #f ""))
+ (renderer (gnc:report-template-renderer template)))
+ (let* ((env (create-test-env))
+ (account-alist (env-create-account-structure-alist env structure))
+ (bank-account (cdr (assoc "Bank" account-alist)))
+ (wallet-account (cdr (assoc "Wallet" account-alist)))
+ (expense-account (cdr (assoc "Expenses" account-alist)))
+ (income-account (cdr (assoc "Income" account-alist)))
+ (date-0 (gnc:get-start-this-month))
+ (date-1 (gnc:timepair-next-day date-0))
+ (date-2 (gnc:timepair-next-day date-1)))
+ (env-create-transaction env
+ date-1
+ bank-account
+ income-account
+ (gnc:make-gnc-numeric 1 1))
+ (env-create-transaction env
+ date-2
+ wallet-account
+ income-account
+ (gnc:make-gnc-numeric 5 1))
+ (begin
+ (set-option report gnc:pagename-display "Show Table" #t)
+ (set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
+ (set-option report gnc:pagename-general "End Date" (cons 'absolute date-2))
+ (set-option report gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option report gnc:pagename-accounts "Accounts" (list wallet-account bank-account))
+
+ (let ((doc (renderer report)))
+ (gnc:html-document-set-style-sheet! doc (gnc:report-stylesheet report))
+ (let* ((result (gnc:html-document-render doc #f))
+ (tbl (stream->list
+ (pattern-streamer "<tr>"
+ (list (list "<td>([0-9]+)/([0-9]+)/([0-9]+)</td>"
+ 1 2 3)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
+ result)))
+ (total (stream->list
+ (pattern-streamer "<tr><td>Total</td>"
+ (list (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
+ result))))
+ (and (every (lambda (row) ; test in=net & out=0 in all rows (all days)
+ (and (equal? (second row) (fourth row))
+ (= 0 (string->number (car (third row))))))
+ tbl)
+ (= 0 (tbl-ref->number tbl 0 1)) ; 1st day in =0
+ (= 1 (tbl-ref->number tbl 1 1)) ; 2nd day in =1
+ (= 5 (tbl-ref->number tbl 2 1)) ; 3rd day in =5
+ (= (tbl-ref->number total 0 0) (tbl-ref->number total 0 2)) ; total in=total net
+ (= 0 (tbl-ref->number total 0 1)) ; total out=0
+ (= 3 (tbl-row-count tbl))
+ (= 4 (tbl-column-count tbl)))))
+ )
+ )
+ )
+ )
+
+
+;; Test two transactions from two different assets to expense in two different days
+(define (test-out-txn)
+ (let* ((template (gnc:find-report-template cashflow-barchart-uuid))
+ (options (gnc:make-report-options cashflow-barchart-uuid))
+ (report (constructor cashflow-barchart-uuid "bar" options
+ #t #t #f #f ""))
+ (renderer (gnc:report-template-renderer template)))
+ (let* ((env (create-test-env))
+ (account-alist (env-create-account-structure-alist env structure))
+ (bank-account (cdr (assoc "Bank" account-alist)))
+ (wallet-account (cdr (assoc "Wallet" account-alist)))
+ (expense-account (cdr (assoc "Expenses" account-alist)))
+ (income-account (cdr (assoc "Income" account-alist)))
+ (date-0 (gnc:get-start-this-month))
+ (date-1 (gnc:timepair-next-day date-0))
+ (date-2 (gnc:timepair-next-day date-1)))
+ (env-create-transaction env
+ date-1
+ bank-account
+ income-account
+ (gnc:make-gnc-numeric 100 1)) ; large in txn to avoid negative net (hard to parse)
+ (env-create-transaction env
+ date-1
+ expense-account
+ bank-account
+ (gnc:make-gnc-numeric 1 1))
+ (env-create-transaction env
+ date-2
+ wallet-account
+ income-account
+ (gnc:make-gnc-numeric 100 1)) ; large in txn to avoid negative net (hard to parse)
+ (env-create-transaction env
+ date-2
+ expense-account
+ wallet-account
+ (gnc:make-gnc-numeric 5 1))
+ (begin
+ (set-option report gnc:pagename-display "Show Table" #t)
+ (set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
+ (set-option report gnc:pagename-general "End Date" (cons 'absolute date-2))
+ (set-option report gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option report gnc:pagename-accounts "Accounts" (list wallet-account bank-account))
+
+ (let ((doc (renderer report)))
+ (gnc:html-document-set-style-sheet! doc (gnc:report-stylesheet report))
+ (let* ((result (gnc:html-document-render doc #f))
+ (tbl (stream->list
+ (pattern-streamer "<tr>"
+ (list (list "<td>([0-9]+)/([0-9]+)/([0-9]+)</td>"
+ 1 2 3)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
+ result)))
+ (total (stream->list
+ (pattern-streamer "<tr><td>Total</td>"
+ (list (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
+ result))))
+ (and (every (lambda (row) ; test in-out=net in all rows (all days)
+ (let ((in (string->number (car (second row))))
+ (out (string->number (car (third row))))
+ (net (string->number (car (fourth row)))))
+ (= (- in out) net)))
+ tbl)
+ (= 0 (tbl-ref->number tbl 0 2)) ; 1st day out =0
+ (= 1 (tbl-ref->number tbl 1 2)) ; 2nd day out =1
+ (= 5 (tbl-ref->number tbl 2 2)) ; 3rd day out =5
+ (= (- (tbl-ref->number total 0 0) (tbl-ref->number total 0 1)) ; total in-total out=total net
+ (tbl-ref->number total 0 2))
+ (= 6 (tbl-ref->number total 0 1)) ; total out=6
+ (= 3 (tbl-row-count tbl))
+ (= 4 (tbl-column-count tbl)))))
+ )
+ )
+ )
+ )
+
+
+;; Test null transaction (transaction between assets)
+;; This test is identical to test-in-txn but with an extra transaction between assets
+(define (test-null-txn)
+ (let* ((template (gnc:find-report-template cashflow-barchart-uuid))
+ (options (gnc:make-report-options cashflow-barchart-uuid))
+ (report (constructor cashflow-barchart-uuid "bar" options
+ #t #t #f #f ""))
+ (renderer (gnc:report-template-renderer template)))
+ (let* ((env (create-test-env))
+ (account-alist (env-create-account-structure-alist env structure))
+ (bank-account (cdr (assoc "Bank" account-alist)))
+ (wallet-account (cdr (assoc "Wallet" account-alist)))
+ (expense-account (cdr (assoc "Expenses" account-alist)))
+ (income-account (cdr (assoc "Income" account-alist)))
+ (date-0 (gnc:get-start-this-month))
+ (date-1 (gnc:timepair-next-day date-0))
+ (date-2 (gnc:timepair-next-day date-1)))
+ (env-create-transaction env
+ date-1
+ bank-account
+ income-account
+ (gnc:make-gnc-numeric 1 1))
+ (env-create-transaction env
+ date-1
+ bank-account
+ wallet-account
+ (gnc:make-gnc-numeric 20 1)) ; this transaction should not be counted
+ (env-create-transaction env
+ date-2
+ wallet-account
+ income-account
+ (gnc:make-gnc-numeric 5 1))
+
+ (begin
+ (set-option report gnc:pagename-display "Show Table" #t)
+ (set-option report gnc:pagename-general "Start Date" (cons 'absolute date-0))
+ (set-option report gnc:pagename-general "End Date" (cons 'absolute date-2))
+ (set-option report gnc:pagename-general "Step Size" 'DayDelta)
+ (set-option report gnc:pagename-general "Price Source" 'pricedb-nearest)
+ (set-option report gnc:pagename-general "Report's currency" (gnc-default-report-currency))
+ (set-option report gnc:pagename-accounts "Accounts" (list wallet-account bank-account))
+
+ (let ((doc (renderer report)))
+ (gnc:html-document-set-style-sheet! doc (gnc:report-stylesheet report))
+ (let* ((result (gnc:html-document-render doc #f))
+ (tbl (stream->list
+ (pattern-streamer "<tr>"
+ (list (list "<td>([0-9]+)/([0-9]+)/([0-9]+)</td>"
+ 1 2 3)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
+ result)))
+ (total (stream->list
+ (pattern-streamer "<tr><td>Total</td>"
+ (list (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
+ result))))
+ (and (every (lambda (row) ; test in=net & out=0 in all rows (all days)
+ (and (equal? (second row) (fourth row))
+ (= 0 (string->number (car (third row))))))
+ tbl)
+ (= 0 (tbl-ref->number tbl 0 1)) ; 1st day in =0
+ (= 1 (tbl-ref->number tbl 1 1)) ; 2nd day in =1
+ (= 5 (tbl-ref->number tbl 2 1)) ; 3rd day in =5
+ (= (tbl-ref->number total 0 0) (tbl-ref->number total 0 2)) ; total in=total net
+ (= 0 (tbl-ref->number total 0 1)) ; total out=0
+ (= 3 (tbl-row-count tbl))
+ (= 4 (tbl-column-count tbl)))))
+ )
+ )
+ )
+ )
commit 04b510022d839794256ce468b601669a06fee030
Author: Jose Marino <jmarino at users.noreply.github.com>
Date: Mon Oct 16 16:07:03 2017 -0600
add new report 'cashflow-barchart.scm' to build system
diff --git a/gnucash/report/standard-reports/CMakeLists.txt b/gnucash/report/standard-reports/CMakeLists.txt
index 35c53c2..2ff9016 100644
--- a/gnucash/report/standard-reports/CMakeLists.txt
+++ b/gnucash/report/standard-reports/CMakeLists.txt
@@ -15,6 +15,7 @@ SET (standard_reports_SCHEME_2
budget-income-statement.scm
budget.scm
cash-flow.scm
+ cashflow-barchart.scm
category-barchart.scm
daily-reports.scm
equity-statement.scm
diff --git a/gnucash/report/standard-reports/Makefile.am b/gnucash/report/standard-reports/Makefile.am
index e95f369..7040d88 100644
--- a/gnucash/report/standard-reports/Makefile.am
+++ b/gnucash/report/standard-reports/Makefile.am
@@ -17,6 +17,7 @@ gncscmrpt_DATA = \
budget-flow.scm \
budget-income-statement.scm \
cash-flow.scm \
+ cashflow-barchart.scm \
category-barchart.scm \
daily-reports.scm \
equity-statement.scm \
commit fa7893710f7ea453b22d3d271fec51284a24bfb8
Author: Jose Marino <jmarino at users.noreply.github.com>
Date: Mon Oct 16 16:20:00 2017 -0600
fix module location of new cashflow-barchart report
diff --git a/gnucash/report/standard-reports/cashflow-barchart.scm b/gnucash/report/standard-reports/cashflow-barchart.scm
index 547a0fb..d4992af 100644
--- a/gnucash/report/standard-reports/cashflow-barchart.scm
+++ b/gnucash/report/standard-reports/cashflow-barchart.scm
@@ -27,14 +27,13 @@
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define-module (gnucash report cashflow-barchart))
+(define-module (gnucash report standard-reports cashflow-barchart))
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
(use-modules (gnucash engine))
(use-modules (gnucash printf))
-(use-modules (gnucash report stylesheets))
(gnc:module-load "gnucash/report/report-system" 0)
commit eda22039add5717df92296c80de0dde6107e0cf1
Author: Jose Marino <jmarino at users.noreply.github.com>
Date: Wed Oct 11 12:13:27 2017 -0600
add new report: cashflow-barchart.scm
This report displays a bar chart showing cash flow over time per
given time interval (money in, money out and net flow). It provides
a graphical representation over time of the data provided by
existing report "Cash Flow".
It can be viewed as a hybrid between existing reports "Cash Flow"
and "Income & Expense Barchart". It displays the data shown by
"Cash Flow" in a format similar to "Income & Expense Barchart".
diff --git a/gnucash/report/standard-reports/cashflow-barchart.scm b/gnucash/report/standard-reports/cashflow-barchart.scm
new file mode 100644
index 0000000..547a0fb
--- /dev/null
+++ b/gnucash/report/standard-reports/cashflow-barchart.scm
@@ -0,0 +1,518 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; cashflow-barchart.scm: cash flow barchart report
+;;
+;; By Jose Marino <jmarino at users.noreply.github.com>
+;;
+;; based on cash-flow.scm by:
+;; Herbert Thoma <herbie at hthoma.de>
+;; and net-barchart by:
+;; Robert Merkel <rgmerk at mira.net>
+;;
+;; 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 at gnu.org
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-module (gnucash report cashflow-barchart))
+
+(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
+(use-modules (gnucash gnc-module))
+(use-modules (gnucash gettext))
+(use-modules (gnucash engine))
+(use-modules (gnucash printf))
+(use-modules (gnucash report stylesheets))
+
+(gnc:module-load "gnucash/report/report-system" 0)
+
+;; Define these utilities to avoid using module srfi-1
+(define first car)
+(define second cadr)
+
+(define reportname (N_ "Cash Flow Barchart"))
+
+;; define all option's names so that they are properly defined
+;; in *one* place.
+;; Accounts
+(define optname-accounts (N_ "Accounts"))
+(define optname-include-trading-accounts (N_ "Include Trading Accounts in report"))
+;; Display
+(define optname-show-inout (N_ "Show Money In/Out"))
+(define optname-show-net (N_ "Show Net Flow"))
+(define optname-show-table (N_ "Show Table"))
+(define optname-plot-width (N_ "Plot Width"))
+(define optname-plot-height (N_ "Plot Height"))
+;; General
+(define optname-from-date (N_ "Start Date"))
+(define optname-to-date (N_ "End Date"))
+(define optname-stepsize (N_ "Step Size"))
+(define optname-report-currency (N_ "Report's currency"))
+(define optname-price-source (N_ "Price Source"))
+
+
+;; options generator function
+(define (cashflow-barchart-options-generator)
+ (let* ((options (gnc:new-options))
+ (add-option
+ (lambda (new-option)
+ (gnc:register-option options new-option))))
+
+ ;; General tab
+ (gnc:options-add-date-interval!
+ options gnc:pagename-general
+ optname-from-date optname-to-date "a")
+
+ (gnc:options-add-interval-choice!
+ options gnc:pagename-general optname-stepsize "b" 'MonthDelta)
+
+ (gnc:options-add-currency!
+ options gnc:pagename-general optname-report-currency "c")
+
+ (gnc:options-add-price-source!
+ options gnc:pagename-general
+ optname-price-source "d" 'pricedb-nearest)
+
+ ;; Accounts tab
+ (add-option
+ (gnc:make-account-list-option
+ gnc:pagename-accounts optname-accounts
+ "a" (N_ "Report on these accounts.")
+ (lambda () ; account getter
+ (gnc:filter-accountlist-type
+ (list ACCT-TYPE-BANK ACCT-TYPE-CASH ACCT-TYPE-ASSET
+ ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL)
+ (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
+ #f #t))
+
+ (gnc:register-option
+ options
+ (gnc:make-simple-boolean-option
+ gnc:pagename-accounts optname-include-trading-accounts
+ "b" (N_ "Include transfers to and from Trading Accounts in the report.") #f))
+
+ ;; Display tab
+ (gnc:register-option
+ options
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-show-inout
+ "a" (N_ "Show money in/out?") #t))
+
+ (gnc:register-option
+ options
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-show-net
+ "b" (N_ "Show net money flow?") #t))
+
+ (gnc:register-option
+ options
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-show-table
+ "c" (N_ "Display a table of the selected data.") #f))
+
+ ;; Plot size options
+ (gnc:options-add-plot-size!
+ options gnc:pagename-display
+ optname-plot-width optname-plot-height "d" (cons 'percent 100.0) (cons 'percent 100.0))
+
+ ;; Set the general page as default option tab
+ (gnc:options-set-default-section options gnc:pagename-general)
+
+ options))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; cashflow-barchart-renderer
+;; set up the document and add the barchart and table
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (cashflow-barchart-renderer report-obj)
+ (define (get-option pagename optname)
+ (gnc:option-value
+ (gnc:lookup-option
+ (gnc:report-options report-obj) pagename optname)))
+
+ (gnc:report-starting reportname)
+
+ ;; get all option's values
+ (let* ((accounts (get-option gnc:pagename-accounts
+ optname-accounts))
+ (include-trading-accounts (get-option gnc:pagename-accounts
+ optname-include-trading-accounts))
+ (row-num 0)
+ (work-done 0)
+ (work-to-do 0)
+ (report-currency (get-option gnc:pagename-general
+ optname-report-currency))
+ (price-source (get-option gnc:pagename-general
+ optname-price-source))
+ (from-date-tp (gnc:timepair-start-day-time
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general
+ optname-from-date))))
+ (to-date-tp (gnc:timepair-end-day-time
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general
+ optname-to-date))))
+
+ ;; calculate the exchange rates
+ (exchange-fn (gnc:case-exchange-fn
+ price-source report-currency to-date-tp))
+
+ (interval (get-option gnc:pagename-general optname-stepsize))
+ (show-inout? (get-option gnc:pagename-display optname-show-inout))
+ (show-net? (get-option gnc:pagename-display optname-show-net))
+ (show-table? (get-option gnc:pagename-display optname-show-table))
+ (height (get-option gnc:pagename-display optname-plot-height))
+ (width (get-option gnc:pagename-display optname-plot-width))
+
+ (dates-list (gnc:make-date-interval-list
+ (gnc:timepair-start-day-time from-date-tp)
+ (gnc:timepair-end-day-time to-date-tp)
+ (gnc:deltasym-to-delta interval)))
+ (report-title (get-option gnc:pagename-general
+ gnc:optname-reportname))
+
+ (doc (gnc:make-html-document))
+ (table (gnc:make-html-table))
+ (txt (gnc:make-html-text))
+ (chart (gnc:make-html-barchart))
+ (non-zeros #f))
+
+ ;; utility function used to generate chart (from net-barchart.scm)
+ (define (add-column! data-list)
+ (begin
+ (gnc:html-barchart-append-column! chart data-list)
+ (if (gnc:not-all-zeros data-list) (set! non-zeros #t))
+ #f))
+
+ (if (not (null? accounts))
+ (let* ((money-diff-collector (gnc:make-commodity-collector))
+ (account-disp-list '())
+
+ (time-exchange-fn #f)
+ (commodity-list (gnc:accounts-get-commodities
+ accounts
+ report-currency))
+ ;; Get an exchange function that will convert each transaction using the
+ ;; nearest available exchange rate if that is what is specified
+ (time-exchange-fn (gnc:case-exchange-time-fn
+ price-source report-currency
+ commodity-list to-date-tp
+ 0 0))
+ (date-string-list (map (lambda (date-list-item) ; date-list-item is (start . end)
+ (gnc-print-date (car date-list-item)))
+ dates-list))
+ (results-by-date '())
+ (in-list '())
+ (out-list '())
+ (net-list '())
+ (in-value-list #f)
+ (out-value-list #f)
+ (net-value-list #f)
+ (in-total-collector (gnc:make-commodity-collector))
+ (out-total-collector (gnc:make-commodity-collector))
+ (net-total-collector (gnc:make-commodity-collector))
+ )
+
+ ;; Helper function to convert currencies
+ (define (to-report-currency currency amount date)
+ (gnc:gnc-monetary-amount
+ (time-exchange-fn (gnc:make-gnc-monetary currency amount)
+ report-currency
+ date)))
+ ;; Sum a collector to return a gnc-monetary
+ (define (sum-collector collector)
+ (gnc:sum-collector-commodity
+ collector report-currency exchange-fn)
+ )
+ ;; Convert gnc:monetary to number (used to generate data for the chart)
+ (define (monetary->double monetary)
+ (gnc-numeric-to-double (gnc:gnc-monetary-amount monetary))
+ )
+
+ ;; gather money in/out data for all date intervals
+ (set! work-done 0)
+ (set! work-to-do (length dates-list))
+ (for-each
+ (lambda (date-pair)
+ (set! work-done (+ 1 work-done))
+ (gnc:report-percent-done (* 80 (/ work-done work-to-do)))
+ (let* ((settings (list (cons 'accounts accounts)
+ (cons 'to-date-tp (second date-pair))
+ (cons 'from-date-tp (first date-pair))
+ (cons 'report-currency report-currency)
+ (cons 'include-trading-accounts include-trading-accounts)
+ (cons 'to-report-currency to-report-currency)))
+ (result (cashflow-barchart-calc-money-in-out settings))
+ (money-in-collector (cdr (assq 'money-in-collector result)))
+ (money-out-collector (cdr (assq 'money-out-collector result)))
+ (money-net-collector (gnc:make-commodity-collector))
+ (money-in-monetary (sum-collector money-in-collector))
+ (money-out-monetary (sum-collector money-out-collector))
+ (money-net-monetary #f)
+ )
+ (money-net-collector 'merge money-in-collector #f)
+ (money-net-collector 'minusmerge money-out-collector #f)
+ (set! money-net-monetary (sum-collector money-net-collector))
+ (set! in-list (cons money-in-monetary in-list))
+ (set! out-list (cons money-out-monetary out-list))
+ (set! net-list (cons money-net-monetary net-list))
+ (in-total-collector 'merge money-in-collector #f)
+ (out-total-collector 'merge money-out-collector #f)
+ ))
+ dates-list)
+
+ (net-total-collector 'merge in-total-collector #f)
+ (net-total-collector 'minusmerge out-total-collector #f)
+
+ ;; flip result lists (they were built by appending to the front)
+ (set! in-list (reverse in-list))
+ (set! out-list (reverse out-list))
+
+ (set! in-value-list (map monetary->double in-list))
+ (set! out-value-list (map monetary->double out-list))
+
+ (if show-net?
+ (begin
+ (set! net-list (reverse net-list))
+ (set! net-value-list (map monetary->double net-list)))
+ )
+ (gnc:report-percent-done 90)
+
+ (gnc:html-barchart-set-title! chart report-title)
+ (gnc:html-barchart-set-subtitle!
+ chart (sprintf #f
+ (_ "%s to %s")
+ (gnc-print-date from-date-tp)
+ (gnc-print-date to-date-tp)))
+ (gnc:html-barchart-set-width! chart width)
+ (gnc:html-barchart-set-height! chart height)
+ (gnc:html-barchart-set-row-labels! chart date-string-list)
+ (gnc:html-barchart-set-y-axis-label!
+ chart (gnc-commodity-get-mnemonic report-currency))
+
+ (if show-inout?
+ (begin
+ (add-column! in-value-list)
+ (add-column! out-value-list)
+ ))
+ (if show-net?
+ (add-column! net-value-list))
+
+ ;; Legend labels, colors
+ (gnc:html-barchart-set-col-labels!
+ chart (append
+ (if show-inout?
+ (list (_ "Money In") (_ "Money Out")) '())
+ (if show-net?
+ (list (_ "Net Flow")) '())))
+ (gnc:html-barchart-set-col-colors!
+ chart (append
+ (if show-inout?
+ '("blue" "red") '())
+ (if show-net?
+ '("green") '())))
+ (gnc:report-percent-done 95)
+
+ ;; If we have no data in the plot, display warning message
+ (if non-zeros
+ (gnc:html-document-add-object! doc chart)
+ (gnc:html-document-add-object!
+ doc
+ (gnc:html-make-empty-data-warning
+ report-title (gnc:report-id report-obj)))
+ )
+
+ (if (and non-zeros show-table?)
+ (let* ((table (gnc:make-html-table)))
+ (set! date-string-list (append date-string-list (list "Total")))
+ (set! in-list (append in-list (list (sum-collector in-total-collector))))
+ (set! out-list (append out-list (list (sum-collector out-total-collector))))
+ (if show-net?
+ (set! net-list (append net-list (list (sum-collector net-total-collector)))))
+
+ (gnc:html-table-set-col-headers!
+ table (append (list (_ "Date"))
+ (if show-inout?
+ (list (_ "Money In") (_ "Money Out")) '())
+ (if show-net?
+ (list (_ "Net Flow")) '())
+ ))
+
+ (gnc:html-document-add-object!
+ doc (gnc:make-html-text (gnc:html-markup-h3 (_ "Overview:"))))
+ (gnc:html-table-append-column! table date-string-list)
+
+ (if show-inout?
+ (begin
+ (gnc:html-table-append-column! table in-list)
+ (gnc:html-table-append-column! table out-list)
+ ))
+ (if show-net?
+ (gnc:html-table-append-column! table net-list))
+
+ ;; set numeric columns to align right
+ (for-each
+ (lambda (col)
+ (gnc:html-table-set-col-style!
+ table col "td"
+ 'attribute (list "class" "number-cell")))
+ '(1 2 3))
+
+ (gnc:html-document-add-object! doc table)
+ )
+ )
+
+ )
+ ;; else: error condition: no accounts specified
+ (gnc:html-document-add-object!
+ doc
+ (gnc:html-make-no-account-warning
+ reportname (gnc:report-id report-obj)))
+ ) ;; if not null? accounts
+
+ (gnc:report-finished)
+
+ doc))
+
+
+;; function to add inflow and outflow of money
+(define (cashflow-barchart-calc-money-in-out settings)
+ (let* ((accounts (cdr (assq 'accounts settings)))
+ (to-date-tp (cdr (assq 'to-date-tp settings)))
+ (from-date-tp (cdr (assq 'from-date-tp 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)))
+
+ (is-report-account? (account-in-list-pred accounts))
+
+ (money-in-accounts '())
+ (money-in-hash (make-hash-table))
+ (money-in-collector (gnc:make-commodity-collector))
+
+ (money-out-accounts '())
+ (money-out-hash (make-hash-table))
+ (money-out-collector (gnc:make-commodity-collector))
+
+ (all-splits (gnc:account-get-trans-type-splits-interval accounts '() from-date-tp to-date-tp))
+ (splits-seen-table (make-hash-table)))
+
+ (define (split-seen? split)
+ (if (split-hashtable-ref splits-seen-table split) #t
+ (begin
+ (split-hashtable-set! splits-seen-table split #t)
+ #f)))
+
+ (define (work-per-split split)
+ (let ((parent (xaccSplitGetParent split)))
+ (if (and (gnc:timepair-le (gnc-transaction-get-date-posted parent) to-date-tp)
+ (gnc:timepair-ge (gnc-transaction-get-date-posted parent) from-date-tp))
+ (let* ((parent-description (xaccTransGetDescription parent))
+ (parent-currency (xaccTransGetCurrency parent)))
+ ;(gnc:debug parent-description
+ ; " - "
+ ; (gnc-commodity-get-printname parent-currency))
+ (for-each
+ (lambda (s)
+ (let* ((s-account (xaccSplitGetAccount s))
+ (s-account-type (xaccAccountGetType s-account))
+ (s-amount (xaccSplitGetAmount s))
+ (s-value (xaccSplitGetValue s))
+ (s-commodity (xaccAccountGetCommodity s-account)))
+ ;; Check if this is a dangling split
+ ;; and print a warning
+ (if (null? s-account)
+ (display
+ (string-append
+ "WARNING: s-account is NULL for split: "
+ (gncSplitGetGUID s) "\n")))
+ ;(gnc:debug (xaccAccountGetName s-account))
+ (if (and ;; make sure we don't have
+ (not (null? s-account)) ;; any dangling splits
+ (or include-trading-accounts (not (eq? s-account-type ACCT-TYPE-TRADING)))
+ (not (is-report-account? s-account)))
+ (if (not (split-seen? s))
+ (begin
+ (if (gnc-numeric-negative-p s-value)
+ (let ((s-account-in-collector (account-hashtable-ref money-in-hash s-account)))
+ ;(gnc:debug "in:" (gnc-commodity-get-printname s-commodity)
+ ; (gnc-numeric-to-double s-amount)
+ ; (gnc-commodity-get-printname parent-currency)
+ ; (gnc-numeric-to-double s-value))
+ (if (not s-account-in-collector)
+ (begin
+ (set! s-account-in-collector (gnc:make-commodity-collector))
+ (account-hashtable-set! money-in-hash s-account
+ s-account-in-collector)
+ (set! money-in-accounts (cons s-account money-in-accounts))
+ )
+ )
+ (let ((s-report-value (to-report-currency parent-currency
+ (gnc-numeric-neg s-value)
+ (gnc-transaction-get-date-posted
+ parent))))
+ (money-in-collector 'add report-currency s-report-value)
+ (s-account-in-collector 'add report-currency s-report-value))
+ )
+ (let ((s-account-out-collector (account-hashtable-ref money-out-hash s-account)))
+ ;(gnc:debug "out:" (gnc-commodity-get-printname s-commodity)
+ ; (gnc-numeric-to-double s-amount)
+ ; (gnc-commodity-get-printname parent-currency)
+ ; (gnc-numeric-to-double s-value))
+ (if (not s-account-out-collector)
+ (begin
+ (set! s-account-out-collector (gnc:make-commodity-collector))
+ (account-hashtable-set! money-out-hash s-account
+ s-account-out-collector)
+ (set! money-out-accounts (cons s-account money-out-accounts))
+ )
+ )
+ (let ((s-report-value (to-report-currency parent-currency
+ s-value
+ (gnc-transaction-get-date-posted
+ parent))))
+ (money-out-collector 'add report-currency s-report-value)
+ (s-account-out-collector 'add report-currency s-report-value))
+ )
+ )
+ )
+ )
+ )
+ )
+ )
+ (xaccTransGetSplitList parent)
+ )
+ )
+ )
+ )
+ )
+
+ ;; Calculate money in and out for each split
+ (for-each work-per-split all-splits)
+
+ ;; Return an association list of results
+ (list
+ (cons 'money-in-collector money-in-collector)
+ (cons 'money-out-collector money-out-collector))))
+
+(gnc:define-report
+ 'version 1
+ 'name reportname
+ 'report-guid "5426e4d987f6444387fe70880e5b28a0"
+ 'menu-tip (N_ "Shows a barchart with cash flow over time")
+ 'menu-path (list gnc:menuname-income-expense)
+ 'options-generator cashflow-barchart-options-generator
+ 'renderer cashflow-barchart-renderer)
Summary of changes:
gnucash/report/standard-reports/CMakeLists.txt | 1 +
gnucash/report/standard-reports/Makefile.am | 1 +
.../report/standard-reports/cashflow-barchart.scm | 521 +++++++++++++++++++++
.../report/standard-reports/test/CMakeLists.txt | 3 +-
gnucash/report/standard-reports/test/Makefile.am | 1 +
.../test/test-cashflow-barchart.scm | 288 ++++++++++++
6 files changed, 814 insertions(+), 1 deletion(-)
create mode 100644 gnucash/report/standard-reports/cashflow-barchart.scm
create mode 100644 gnucash/report/standard-reports/test/test-cashflow-barchart.scm
More information about the gnucash-changes
mailing list