From 119fdc368b41d0a1207e9d281deddcfe08e52d59 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Mon, 25 Nov 2019 22:52:36 +0800 Subject: [PATCH 01/19] [report-utilities] can strify records srfi-9 records can contain complex objects eg lists/vectors also gnc:monetary or gnc:html-table objects. previously gnc:strify would use the default printer; this commit modifies so that they are prettified. example output; a :col-datum record from balsheet-pnl. the record's split-balance contains a $0 monetary object. Rec::col-datum{last-split=#f, split-balance=[$0.00]} this last pretty-printer must be the last one before object->string, because we want previous printers which may be records too eg. monetary->str etc to use their own printer. --- gnucash/report/report-system/report-utilities.scm | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm index 3422fdeaae..f2cfaad445 100644 --- a/gnucash/report/report-system/report-utilities.scm +++ b/gnucash/report/report-system/report-utilities.scm @@ -1284,6 +1284,13 @@ flawed. see report-utilities.scm. please update reports.") (try owner->str) (try invoice->str) (try lot->str) + (and (record? d) + (let ((rtd (record-type-descriptor d))) + (define (fld->str fld) + (format #f "~a=~a" fld (gnc:strify ((record-accessor rtd fld) d)))) + (format #f "Rec:~a{~a}" + (record-type-name rtd) + (string-join (map fld->str (record-type-fields rtd)) ", ")))) (object->string d))) (define (pair->num pair) From 88644451ef29089c139a3ca643d3e5fbda04f4b6 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Tue, 26 Nov 2019 18:11:15 +0800 Subject: [PATCH 02/19] [test-balsheet-pnl] separate balance-sheet and pnl tests This is in preparation for balsheet-pnl tests. Note all tests use same data -- there's no (teardown). --- .../test/test-balsheet-pnl.scm | 599 +++++++++--------- 1 file changed, 299 insertions(+), 300 deletions(-) diff --git a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm index 8fed4fac5e..1ffdf1e6a6 100644 --- a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm +++ b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm @@ -23,7 +23,9 @@ (test-runner-factory gnc:test-runner) (test-begin "balsheet and profit&loss") (null-test) - (balsheet-pnl-tests) + (create-test-data) + (balance-sheet-tests) + (pnl-tests) (test-end "balsheet and profit&loss")) (define (options->sxml uuid options test-title) @@ -80,7 +82,7 @@ (let ((balance-sheet-options (gnc:make-report-options balance-sheet-uuid))) (test-assert "null-test" (options->sxml balance-sheet-uuid balance-sheet-options "null-test")))) -(define (balsheet-pnl-tests) +(define (create-test-data) ;; This function will perform implementation testing on the transaction report. (let* ((env (create-test-env)) (account-alist (env-create-account-structure-alist env structure)) @@ -95,23 +97,7 @@ (bank2creditcard (cdr (assoc "CreditCard" account-alist))) (equity (cdr (assoc "Equity" account-alist))) (income (cdr (assoc "Income" account-alist))) - (income-GBP (cdr (assoc "Income-GBP" account-alist))) - (YEAR (gnc:time64-get-year (gnc:get-today)))) - - (define (default-balsheet-testing-options) - (let ((balance-sheet-options (gnc:make-report-options balance-sheet-uuid))) - (set-option! balance-sheet-options "General" "Balance Sheet Date" (cons 'absolute (gnc-dmy2time64 1 1 1971))) - (set-option! balance-sheet-options "Accounts" "Levels of Subaccounts" 'all) - (set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #t) - balance-sheet-options)) - - (define (default-pnl-testing-options) - (let ((pnl-options (gnc:make-report-options pnl-uuid))) - (set-option! pnl-options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 1 1 1980))) - (set-option! pnl-options "General" "End Date" (cons 'absolute (gnc-dmy2time64 1 1 1981))) - (set-option! pnl-options "Accounts" "Levels of Subaccounts" 'all) - (set-option! pnl-options "Commodities" "Show Exchange Rates" #t) - pnl-options)) + (income-GBP (cdr (assoc "Income-GBP" account-alist)))) ;; $100 in Savings account (env-transfer env 01 01 1970 equity bank1savings 100) @@ -169,300 +155,313 @@ ;; a couple INCOME transactions, a decade later (env-transfer env 01 01 1980 income bank1current 250) (env-transfer env 01 01 1980 income-GBP foreignsavings 500) - (env-transfer-foreign env 01 02 1980 income-GBP bank1current 100 170 #:description "earn 100GBP into $170") + (env-transfer-foreign env 01 02 1980 income-GBP bank1current 100 170 #:description "earn 100GBP into $170"))) - ;; Finally we can begin testing balsheet - (display "\n\n balsheet tests\n\n") - (let* ((balance-sheet-options (default-balsheet-testing-options)) - (sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-default"))) - (test-equal "total assets = $116,009" - (list "$116,009.00") - (sxml->table-row-col sxml 1 15 6)) - (test-equal "total liabilities = $9,500.00" - (list "$9,500.00") - (sxml->table-row-col sxml 1 23 6)) - (test-equal "total equity = $106,509.00" - (list "$106,509.00") - (sxml->table-row-col sxml 1 28 6)) - - (set-option! balance-sheet-options "Commodities" "Price Source" 'weighted-average) - (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-weighted-average"))) - (test-equal "weighted average assets = $114,071.66" - (list "$114,071.66") - (sxml->table-row-col sxml 1 15 6))) - - (set-option! balance-sheet-options "Commodities" "Price Source" 'average-cost) - (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-average-cost"))) - (test-equal "average-cost assets = $113,100" - (list "$113,100.00") - (sxml->table-row-col sxml 1 15 6))) - - (set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-nearest) - (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-nearest"))) - (test-equal "pricedb-nearest assets = $116,009" - (list "$116,009.00") - (sxml->table-row-col sxml 1 15 6))) - - (set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-latest) - (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-latest"))) - (test-equal "pricedb-latest assets = $122,049" - (list "$122,049.00") - (sxml->table-row-col sxml 1 15 6))) - - ;; set multilevel subtotal style - ;; verifies amount in EVERY line of the report. - (set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal) - (set-option! balance-sheet-options "Display" "Parent account subtotals" 't) - (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-multilevel"))) - (test-equal "multilevel. root = $0.00" - (list "$0.00") - (sxml->table-row-col sxml 1 3 6)) - (test-equal "multilevel. assets = $0.00" - (list "$0.00") - (sxml->table-row-col sxml 1 4 5)) - (test-equal "multilevel. bank1 = $0.00" - (list "$0.00") - (sxml->table-row-col sxml 1 5 4)) - (test-equal "multilevel. bonds = $2,000.00" - (list "$2,000.00") - (sxml->table-row-col sxml 1 6 3)) - (test-equal "multilevel. current = $2609.00" - (list "$2,609.00") - (sxml->table-row-col sxml 1 7 3)) - (test-equal "multilevel. empty = $0.00" - (list "$0.00") - (sxml->table-row-col sxml 1 8 3)) - (test-equal "multilevel. savings = $100.00" - (list "$100.00") - (sxml->table-row-col sxml 1 9 3)) - (test-equal "multilevel. total bank1 = $4709" - (list "$4,709.00") - (sxml->table-row-col sxml 1 10 4)) - (test-equal "multilevel. broker = $2,000.00" - (list "$2,000.00") - (sxml->table-row-col sxml 1 11 4)) - (test-equal "multilevel. funds = $15,000.00" - (list "30 FUNDS" "$15,000.00" "$15,000.00") - (sxml->table-row-col sxml 1 12 3)) - (test-equal "multilevel. total broker = $17,000.00" - (list "$17,000.00") - (sxml->table-row-col sxml 1 13 4)) - (test-equal "multilevel. foreign = $0.00" - (list "$0.00") - (sxml->table-row-col sxml 1 14 4)) - (test-equal "multilevel. foreignsavings = #200.00 = $340" - (list "#200.00" "$340.00" "$340.00") - (sxml->table-row-col sxml 1 15 3)) - (test-equal "multilevel. total foreign = $340" - (list "$340.00") - (sxml->table-row-col sxml 1 16 4)) - (test-equal "multilevel. house = $100,000" - (list "$100,000.00") - (sxml->table-row-col sxml 1 17 4)) - (test-equal "multilevel. total asset = $122,049" - (list "$122,049.00") - (sxml->table-row-col sxml 1 18 5)) - (test-equal "multilevel. total root = $122,049" - (list "$122,049.00") - (sxml->table-row-col sxml 1 19 6)) - (test-equal "multilevel. total assets = $122,049" - (list "$122,049.00") - (sxml->table-row-col sxml 1 20 6))) - - ;; set recursive-subtotal subtotal style - (set-option! balance-sheet-options "Display" "Parent account balances" 'recursive-bal) - (set-option! balance-sheet-options "Display" "Parent account subtotals" 'f) - (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-recursive"))) - (test-equal "recursive. root = $760+15000+104600" - (list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00") - (sxml->table-row-col sxml 1 3 6)) - (test-equal "recursive. assets = $760+15000+104600" - (list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00") - (sxml->table-row-col sxml 1 4 5)) - (test-equal "recursive. bank1 = $4,709.00" - (list "$4,709.00") - (sxml->table-row-col sxml 1 5 4)) - (test-equal "recursive. bonds = $2,000.00" - (list "$2,000.00") - (sxml->table-row-col sxml 1 6 3)) - (test-equal "recursive. current = $2609.00" - (list "$2,609.00") - (sxml->table-row-col sxml 1 7 3)) - (test-equal "recursive. empty = $0.00" - (list "$0.00") - (sxml->table-row-col sxml 1 8 3)) - (test-equal "recursive. savings = $100.00" - (list "$100.00") - (sxml->table-row-col sxml 1 9 3)) - (test-equal "recursive. broker = $15000+2000.00" - (list "30 FUNDS" "$15,000.00" "$2,000.00" "$2,000.00") - (sxml->table-row-col sxml 1 10 4)) - (test-equal "recursive. funds = $15,000.00" - (list "30 FUNDS" "$15,000.00" "$15,000.00") - (sxml->table-row-col sxml 1 11 3)) - (test-equal "recursive. foreign = $340.00" - (list "#200.00" "$340.00") - (sxml->table-row-col sxml 1 12 4)) - (test-equal "recursive. foreignsavings = #200.00 = $340" - (list "#200.00" "$340.00" "$340.00") - (sxml->table-row-col sxml 1 13 3)) - (test-equal "recursive. house = $100,000" - (list "$100,000.00") - (sxml->table-row-col sxml 1 14 4)) - (test-equal "recursive. total assets = $122,049.00" - (list "$122,049.00") - (sxml->table-row-col sxml 1 15 6))) - - (set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #f) - (set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #f) - (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-disable show-fcur show-rates"))) - (test-equal "show-fcur disabled" - (list "$122,049.00") - (sxml->table-row-col sxml 1 3 6)) - (test-equal "show-rates disabled" - '() - (sxml->table-row-col sxml 2 #f #f))) - - (set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #t) +(define (balance-sheet-tests) + (define (default-balsheet-testing-options) + (let ((balance-sheet-options (gnc:make-report-options balance-sheet-uuid))) + (set-option! balance-sheet-options "General" "Balance Sheet Date" (cons 'absolute (gnc-dmy2time64 1 1 1971))) + (set-option! balance-sheet-options "Accounts" "Levels of Subaccounts" 'all) (set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #t) - (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-enable show-fcur show-rates"))) - (test-equal "show-fcur enabled" - (list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00") - (sxml->table-row-col sxml 1 3 6)) - (test-equal "show-rates enabled" - (list "1 FUNDS" "$500.00" "#1.00" "$1.70") - (sxml->table-row-col sxml 2 #f #f))) + balance-sheet-options)) + (display "\n\n balsheet tests\n\n") + (let* ((balance-sheet-options (default-balsheet-testing-options)) + (sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-default"))) - ;;make-multilevel - (set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal) - (set-option! balance-sheet-options "Display" "Parent account subtotals" 't) + (test-equal "total assets = $116,009" + (list "$116,009.00") + (sxml->table-row-col sxml 1 15 6)) + (test-equal "total liabilities = $9,500.00" + (list "$9,500.00") + (sxml->table-row-col sxml 1 23 6)) + (test-equal "total equity = $106,509.00" + (list "$106,509.00") + (sxml->table-row-col sxml 1 28 6)) - (set-option! balance-sheet-options "Display" "Omit zero balance figures" #t) - (set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #f) - (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#f omit-zb-bals=#t"))) - (test-equal "omit-zb-bals=#t" - '() - (sxml->table-row-col sxml 1 3 5)) - (test-equal "incl-zb-accts=#f" - '("Savings" "$100.00") ;i.e.skips "Empty" account with $0.00 - (sxml->table-row-col sxml 1 8 #f))) + (set-option! balance-sheet-options "Commodities" "Price Source" 'weighted-average) + (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-weighted-average"))) + (test-equal "weighted average assets = $114,071.66" + (list "$114,071.66") + (sxml->table-row-col sxml 1 15 6))) - (set-option! balance-sheet-options "Display" "Omit zero balance figures" #f) - (set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #t) - (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#t omit-zb-bals=#f"))) - (test-equal "omit-zb-bals=#f" - (list "$0.00") - (sxml->table-row-col sxml 1 3 6)) - (test-equal "incl-zb-accts=#t" - '("Empty" "$0.00") - (sxml->table-row-col sxml 1 8 #f))) - ) + (set-option! balance-sheet-options "Commodities" "Price Source" 'average-cost) + (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-average-cost"))) + (test-equal "average-cost assets = $113,100" + (list "$113,100.00") + (sxml->table-row-col sxml 1 15 6))) - (display "\n\n pnl tests\n\n") - (let* ((pnl-options (default-pnl-testing-options)) - (sxml (options->sxml pnl-uuid pnl-options "pnl-default"))) - (test-equal "total revenue = $1,270.00" + (set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-nearest) + (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-nearest"))) + (test-equal "pricedb-nearest assets = $116,009" + (list "$116,009.00") + (sxml->table-row-col sxml 1 15 6))) + + (set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-latest) + (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-latest"))) + (test-equal "pricedb-latest assets = $122,049" + (list "$122,049.00") + (sxml->table-row-col sxml 1 15 6))) + + ;; set multilevel subtotal style + ;; verifies amount in EVERY line of the report. + (set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal) + (set-option! balance-sheet-options "Display" "Parent account subtotals" 't) + (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-multilevel"))) + (test-equal "multilevel. root = $0.00" + (list "$0.00") + (sxml->table-row-col sxml 1 3 6)) + (test-equal "multilevel. assets = $0.00" + (list "$0.00") + (sxml->table-row-col sxml 1 4 5)) + (test-equal "multilevel. bank1 = $0.00" + (list "$0.00") + (sxml->table-row-col sxml 1 5 4)) + (test-equal "multilevel. bonds = $2,000.00" + (list "$2,000.00") + (sxml->table-row-col sxml 1 6 3)) + (test-equal "multilevel. current = $2609.00" + (list "$2,609.00") + (sxml->table-row-col sxml 1 7 3)) + (test-equal "multilevel. empty = $0.00" + (list "$0.00") + (sxml->table-row-col sxml 1 8 3)) + (test-equal "multilevel. savings = $100.00" + (list "$100.00") + (sxml->table-row-col sxml 1 9 3)) + (test-equal "multilevel. total bank1 = $4709" + (list "$4,709.00") + (sxml->table-row-col sxml 1 10 4)) + (test-equal "multilevel. broker = $2,000.00" + (list "$2,000.00") + (sxml->table-row-col sxml 1 11 4)) + (test-equal "multilevel. funds = $15,000.00" + (list "30 FUNDS" "$15,000.00" "$15,000.00") + (sxml->table-row-col sxml 1 12 3)) + (test-equal "multilevel. total broker = $17,000.00" + (list "$17,000.00") + (sxml->table-row-col sxml 1 13 4)) + (test-equal "multilevel. foreign = $0.00" + (list "$0.00") + (sxml->table-row-col sxml 1 14 4)) + (test-equal "multilevel. foreignsavings = #200.00 = $340" + (list "#200.00" "$340.00" "$340.00") + (sxml->table-row-col sxml 1 15 3)) + (test-equal "multilevel. total foreign = $340" + (list "$340.00") + (sxml->table-row-col sxml 1 16 4)) + (test-equal "multilevel. house = $100,000" + (list "$100,000.00") + (sxml->table-row-col sxml 1 17 4)) + (test-equal "multilevel. total asset = $122,049" + (list "$122,049.00") + (sxml->table-row-col sxml 1 18 5)) + (test-equal "multilevel. total root = $122,049" + (list "$122,049.00") + (sxml->table-row-col sxml 1 19 6)) + (test-equal "multilevel. total assets = $122,049" + (list "$122,049.00") + (sxml->table-row-col sxml 1 20 6))) + + ;; set recursive-subtotal subtotal style + (set-option! balance-sheet-options "Display" "Parent account balances" 'recursive-bal) + (set-option! balance-sheet-options "Display" "Parent account subtotals" 'f) + (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-recursive"))) + (test-equal "recursive. root = $760+15000+104600" + (list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00") + (sxml->table-row-col sxml 1 3 6)) + (test-equal "recursive. assets = $760+15000+104600" + (list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00") + (sxml->table-row-col sxml 1 4 5)) + (test-equal "recursive. bank1 = $4,709.00" + (list "$4,709.00") + (sxml->table-row-col sxml 1 5 4)) + (test-equal "recursive. bonds = $2,000.00" + (list "$2,000.00") + (sxml->table-row-col sxml 1 6 3)) + (test-equal "recursive. current = $2609.00" + (list "$2,609.00") + (sxml->table-row-col sxml 1 7 3)) + (test-equal "recursive. empty = $0.00" + (list "$0.00") + (sxml->table-row-col sxml 1 8 3)) + (test-equal "recursive. savings = $100.00" + (list "$100.00") + (sxml->table-row-col sxml 1 9 3)) + (test-equal "recursive. broker = $15000+2000.00" + (list "30 FUNDS" "$15,000.00" "$2,000.00" "$2,000.00") + (sxml->table-row-col sxml 1 10 4)) + (test-equal "recursive. funds = $15,000.00" + (list "30 FUNDS" "$15,000.00" "$15,000.00") + (sxml->table-row-col sxml 1 11 3)) + (test-equal "recursive. foreign = $340.00" + (list "#200.00" "$340.00") + (sxml->table-row-col sxml 1 12 4)) + (test-equal "recursive. foreignsavings = #200.00 = $340" + (list "#200.00" "$340.00" "$340.00") + (sxml->table-row-col sxml 1 13 3)) + (test-equal "recursive. house = $100,000" + (list "$100,000.00") + (sxml->table-row-col sxml 1 14 4)) + (test-equal "recursive. total assets = $122,049.00" + (list "$122,049.00") + (sxml->table-row-col sxml 1 15 6))) + + (set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #f) + (set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #f) + (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-disable show-fcur show-rates"))) + (test-equal "show-fcur disabled" + (list "$122,049.00") + (sxml->table-row-col sxml 1 3 6)) + (test-equal "show-rates disabled" + '() + (sxml->table-row-col sxml 2 #f #f))) + + (set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #t) + (set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #t) + (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-enable show-fcur show-rates"))) + (test-equal "show-fcur enabled" + (list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00") + (sxml->table-row-col sxml 1 3 6)) + (test-equal "show-rates enabled" + (list "1 FUNDS" "$500.00" "#1.00" "$1.70") + (sxml->table-row-col sxml 2 #f #f))) + + ;;make-multilevel + (set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal) + (set-option! balance-sheet-options "Display" "Parent account subtotals" 't) + + (set-option! balance-sheet-options "Display" "Omit zero balance figures" #t) + (set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #f) + (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#f omit-zb-bals=#t"))) + (test-equal "omit-zb-bals=#t" + '() + (sxml->table-row-col sxml 1 3 5)) + (test-equal "incl-zb-accts=#f" + '("Savings" "$100.00") ;i.e.skips "Empty" account with $0.00 + (sxml->table-row-col sxml 1 8 #f))) + + (set-option! balance-sheet-options "Display" "Omit zero balance figures" #f) + (set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #t) + (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#t omit-zb-bals=#f"))) + (test-equal "omit-zb-bals=#f" + (list "$0.00") + (sxml->table-row-col sxml 1 3 6)) + (test-equal "incl-zb-accts=#t" + '("Empty" "$0.00") + (sxml->table-row-col sxml 1 8 #f))))) + +(define (pnl-tests) + (define (default-pnl-testing-options) + (let ((pnl-options (gnc:make-report-options pnl-uuid))) + (set-option! pnl-options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 1 1 1980))) + (set-option! pnl-options "General" "End Date" (cons 'absolute (gnc-dmy2time64 1 1 1981))) + (set-option! pnl-options "Accounts" "Levels of Subaccounts" 'all) + (set-option! pnl-options "Commodities" "Show Exchange Rates" #t) + pnl-options)) + (display "\n\n pnl tests\n\n") + (let* ((pnl-options (default-pnl-testing-options)) + (sxml (options->sxml pnl-uuid pnl-options "pnl-default"))) + (test-equal "total revenue = $1,270.00" + (list "$1,270.00") + ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) + sxml)) + (test-equal "total expenses = $0.00" + (list "$0.00") + ((sxpath '(// table // (tr 2) // table // (tr 3) // (td 6) // *text*)) + sxml)) + + (set-option! pnl-options "Commodities" "Price Source" 'weighted-average) + (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-weighted-average"))) + (test-equal "weighted average revenue = $1160.36" + (list "$1,160.36") + ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) + sxml))) + + (set-option! pnl-options "Commodities" "Price Source" 'average-cost) + (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-average-cost"))) + (test-equal "average-cost revenue = $976" + (list "$976.00") + ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) + sxml))) + + (set-option! pnl-options "Commodities" "Price Source" 'pricedb-nearest) + (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-nearest"))) + (test-equal "pricedb-nearest revenue = $1270" (list "$1,270.00") ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) + sxml))) + + (set-option! pnl-options "Commodities" "Price Source" 'pricedb-latest) + (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-latest"))) + (test-equal "pricedb-latest revenue = $1270" + (list "$1,270.00") + ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) + sxml))) + + ;; set multilevel subtotal style + ;; verifies amount in EVERY line of the report. + (set-option! pnl-options "Display" "Parent account balances" 'immediate-bal) + (set-option! pnl-options "Display" "Parent account subtotals" 't) + (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-multilevel"))) + (test-equal "multilevel. income = -$250.00" + (list "-$250.00") + ((sxpath '(// table // (tr 1) // table // (tr 3) // (td 6) // *text*)) sxml)) - (test-equal "total expenses = $0.00" + (test-equal "multilevel. income-GBP = -#600" + (list "-#600.00" "-$1,020.00") + ((sxpath '(// table // (tr 1) // table // (tr 4) // (td 5) // *text*)) + sxml)) + (test-equal "multilevel. total income = -$1,270.00" + (list "-$1,270.00") + ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) + sxml)) + (test-equal "multilevel. total revenue = $1,270.00" + (list "$1,270.00") + ((sxpath '(// table // (tr 1) // table // (tr 6) // (td 6) // *text*)) + sxml)) + (test-equal "multilevel. expenses = $0.00" (list "$0.00") ((sxpath '(// table // (tr 2) // table // (tr 3) // (td 6) // *text*)) sxml)) + (test-equal "multilevel. net-income = $1,270" + (list "$1,270.00") + ((sxpath '(// table // (tr 2) // table // (tr 4) // (td 6) // *text*)) + sxml))) - (set-option! pnl-options "Commodities" "Price Source" 'weighted-average) - (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-weighted-average"))) - (test-equal "weighted average revenue = $1160.36" - (list "$1,160.36") - ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) - sxml))) + ;; set recursive-subtotal subtotal style + (set-option! pnl-options "Display" "Parent account balances" 'recursive-bal) + (set-option! pnl-options "Display" "Parent account subtotals" 'f) + (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-recursive"))) + (test-equal "recursive. income = $1020+250" + (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00") + (sxml->table-row-col sxml 1 3 6)) + (test-equal "recursive. income-gbp = $1020" + (list "-#600.00" "-$1,020.00" "-#600.00" "-$1,020.00") + (sxml->table-row-col sxml 1 4 5)) + (test-equal "recursive. total revenue = $1270" + (list "$1,270.00" "$1,270.00") + (sxml->table-row-col sxml 1 5 6))) - (set-option! pnl-options "Commodities" "Price Source" 'average-cost) - (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-average-cost"))) - (test-equal "average-cost revenue = $976" - (list "$976.00") - ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) - sxml))) + (set-option! pnl-options "Commodities" "Show Foreign Currencies" #f) + (set-option! pnl-options "Commodities" "Show Exchange Rates" #f) + (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-disable show-fcur show-rates"))) + (test-equal "show-fcur disabled" + (list "-$1,270.00" "$0.00" "-$1,270.00" "$0.00") + (sxml->table-row-col sxml 1 3 6)) + (test-equal "show-rates disabled" + '() + (sxml->table-row-col sxml 2 #f #f))) - (set-option! pnl-options "Commodities" "Price Source" 'pricedb-nearest) - (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-nearest"))) - (test-equal "pricedb-nearest revenue = $1270" - (list "$1,270.00") - ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) - sxml))) + (set-option! pnl-options "Commodities" "Show Foreign Currencies" #t) + (set-option! pnl-options "Commodities" "Show Exchange Rates" #t) + (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-enable show-fcur show-rates"))) + (test-equal "show-fcur enabled" + (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00") + (sxml->table-row-col sxml 1 3 6)) + (test-equal "show-rates enabled" + (list "#1.00" "$1.70") + (sxml->table-row-col sxml 2 #f #f))) - (set-option! pnl-options "Commodities" "Price Source" 'pricedb-latest) - (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-latest"))) - (test-equal "pricedb-latest revenue = $1270" - (list "$1,270.00") - ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) - sxml))) - - ;; set multilevel subtotal style - ;; verifies amount in EVERY line of the report. - (set-option! pnl-options "Display" "Parent account balances" 'immediate-bal) - (set-option! pnl-options "Display" "Parent account subtotals" 't) - (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-multilevel"))) - (test-equal "multilevel. income = -$250.00" - (list "-$250.00") - ((sxpath '(// table // (tr 1) // table // (tr 3) // (td 6) // *text*)) - sxml)) - (test-equal "multilevel. income-GBP = -#600" - (list "-#600.00" "-$1,020.00") - ((sxpath '(// table // (tr 1) // table // (tr 4) // (td 5) // *text*)) - sxml)) - (test-equal "multilevel. total income = -$1,270.00" - (list "-$1,270.00") - ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) - sxml)) - (test-equal "multilevel. total revenue = $1,270.00" - (list "$1,270.00") - ((sxpath '(// table // (tr 1) // table // (tr 6) // (td 6) // *text*)) - sxml)) - (test-equal "multilevel. expenses = $0.00" - (list "$0.00") - ((sxpath '(// table // (tr 2) // table // (tr 3) // (td 6) // *text*)) - sxml)) - (test-equal "multilevel. net-income = $1,270" - (list "$1,270.00") - ((sxpath '(// table // (tr 2) // table // (tr 4) // (td 6) // *text*)) - sxml))) - - ;; set recursive-subtotal subtotal style - (set-option! pnl-options "Display" "Parent account balances" 'recursive-bal) - (set-option! pnl-options "Display" "Parent account subtotals" 'f) - (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-recursive"))) - (test-equal "recursive. income = $1020+250" - (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00") - (sxml->table-row-col sxml 1 3 6)) - (test-equal "recursive. income-gbp = $1020" - (list "-#600.00" "-$1,020.00" "-#600.00" "-$1,020.00") - (sxml->table-row-col sxml 1 4 5)) - (test-equal "recursive. total revenue = $1270" - (list "$1,270.00" "$1,270.00") - (sxml->table-row-col sxml 1 5 6))) - - (set-option! pnl-options "Commodities" "Show Foreign Currencies" #f) - (set-option! pnl-options "Commodities" "Show Exchange Rates" #f) - (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-disable show-fcur show-rates"))) - (test-equal "show-fcur disabled" - (list "-$1,270.00" "$0.00" "-$1,270.00" "$0.00") - (sxml->table-row-col sxml 1 3 6)) - (test-equal "show-rates disabled" - '() - (sxml->table-row-col sxml 2 #f #f))) - - (set-option! pnl-options "Commodities" "Show Foreign Currencies" #t) - (set-option! pnl-options "Commodities" "Show Exchange Rates" #t) - (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-enable show-fcur show-rates"))) - (test-equal "show-fcur enabled" - (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00") - (sxml->table-row-col sxml 1 3 6)) - (test-equal "show-rates enabled" - (list "#1.00" "$1.70") - (sxml->table-row-col sxml 2 #f #f))) - - ;;make-multilevel - (set-option! pnl-options "Display" "Parent account balances" 'immediate-bal) - (set-option! pnl-options "Display" "Parent account subtotals" 't) - ))) + ;;make-multilevel + (set-option! pnl-options "Display" "Parent account balances" 'immediate-bal) + (set-option! pnl-options "Display" "Parent account subtotals" 't))) From ff298b365f83346e68638abf530d022e8367c459 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Tue, 26 Nov 2019 18:18:14 +0800 Subject: [PATCH 03/19] [test-balsheet-pnl] add multicol-balsheet and multicol-pnl tests This commit adds tests for multicolumn balance-sheet and income-statement. It mainly tests: * multiple periods * unrealized gains calculators * amounts/balances are predictable --- .../test/test-balsheet-pnl.scm | 116 ++++++++++++++++++ 1 file changed, 116 insertions(+) diff --git a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm index 1ffdf1e6a6..9fa490a884 100644 --- a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm +++ b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm @@ -3,6 +3,8 @@ (use-modules (gnucash engine test test-extras)) (use-modules (gnucash report standard-reports balance-sheet)) (use-modules (gnucash report standard-reports income-statement)) +(use-modules (gnucash report standard-reports balsheet-pnl)) +(use-modules (gnucash report standard-reports transaction)) (use-modules (gnucash report stylesheets)) (use-modules (gnucash report report-system)) (use-modules (gnucash report report-system test test-extras)) @@ -15,6 +17,8 @@ (define balance-sheet-uuid "c4173ac99b2b448289bf4d11c731af13") (define pnl-uuid "0b81a3bdfd504aff849ec2e8630524bc") +(define multicol-balsheet-uuid "065d5d5a77ba11e8b31e83ada73c5eea") +(define multicol-pnl-uuid "0e94fd0277ba11e8825d43e27232c9d4") ;; Explicitly set locale to make the report output predictable (setlocale LC_ALL "C") @@ -26,6 +30,8 @@ (create-test-data) (balance-sheet-tests) (pnl-tests) + (multicol-balsheet-tests) + (multicol-pnl-tests) (test-end "balsheet and profit&loss")) (define (options->sxml uuid options test-title) @@ -465,3 +471,113 @@ ;;make-multilevel (set-option! pnl-options "Display" "Parent account balances" 'immediate-bal) (set-option! pnl-options "Display" "Parent account subtotals" 't))) + +(define (multicol-balsheet-tests) + (define (default-testing-options) + (let ((options (gnc:make-report-options multicol-balsheet-uuid))) + (set-option! options "General" "Start Date" + (cons 'absolute (gnc-dmy2time64 1 1 1970))) + (set-option! options "General" "End Date" + (cons 'absolute (gnc-dmy2time64 1 1 1972))) + (set-option! options "General" "Enable dual columns" #f) + (set-option! options "General" "Disable amount indenting" #t) + (set-option! options "Display" "Account full name instead of indenting" #t) + (set-option! options "Accounts" "Levels of Subaccounts" 'all) + (set-option! options "Commodities" "Show Exchange Rates" #t) + options)) + (display "\n\n multicol-balsheet tests\n\n") + (let* ((multi-bs-options (default-testing-options)) + (sxml (options->sxml multicol-balsheet-uuid multi-bs-options + "multicol-balsheet-default"))) + (test-equal "default row headers" + '("Asset" "Root" "Root.Asset" "Root.Asset.Bank1" "Root.Asset.Bank1.Bonds" + "Root.Asset.Bank1.Current" "Root.Asset.Bank1.Empty" "Root.Asset.Bank1.Savings" + "Root.Asset.Broker" "Root.Asset.Broker" "Root.Asset.Broker.Funds" + "Root.Asset.ForeignBank" "Root.Asset.ForeignBank.ForeignSavings" + "Root.Asset.House" "Total For Asset" "Liability" "Root.Liability" + "Root.Liability.Bank2" "Root.Liability.Bank2.CreditCard" + "Root.Liability.Bank2.Loan" "Total For Liability" "Equity" "Root.Equity" + "Unrealized Gains" "Retained Earnings" "Total For Equity") + (sxml->table-row-col sxml 1 #f 1)) + (test-equal "default balances" + '("#200.00" "$106,709.00" "30 FUNDS" "#200.00" "$106,709.00" "30 FUNDS" + "$4,709.00" "$2,000.00" "$2,609.00" "$0.00" "$100.00" "$2,000.00" + "30 FUNDS" "$2,000.00" "30 FUNDS" "#200.00" "#200.00" "$100,000.00" + "30 FUNDS" "#200.00" "$106,709.00" "$9,500.00" "$9,500.00" "$500.00" + "$9,000.00" "$9,500.00" "$103,600.00" "$0.00" "#0.00" "$103,600.00" + "#0.00") + (sxml->table-row-col sxml 1 #f 2)) + + ;; the following tests many parts of multicolumn balance sheet: + ;; multiple-dates balances, unrealized-gain calculator, pricelists + (set-option! multi-bs-options "General" "Period duration" 'YearDelta) + (set-option! multi-bs-options "Commodities" "Common Currency" #t) + (set-option! multi-bs-options "Commodities" "Report's currency" USD) + (let ((sxml (options->sxml multicol-balsheet-uuid multi-bs-options + "multicol-balsheet-halfyear"))) + (test-equal "bal-1/1/70" + '("01/01/70" "$113,100.00" "$113,100.00" "$8,970.00" "$2,000.00" "$6,870.00" + "$0.00" "$100.00" "$4,000.00" "$2,000.00" "$2,000.00" "10 FUNDS " "$130.00" + "$130.00" "#100.00 " "$100,000.00" "$113,100.00" "$9,500.00" "$9,500.00" + "$500.00" "$9,000.00" "$9,500.00" "$103,600.00" "$0.00" "$0.00" + "$103,600.00" "1 FUNDS $200.00" "#1.00 $1.30") + (sxml->table-row-col sxml 1 #f 2)) + (test-equal "bal-1/1/71" + '("01/01/71" "$116,009.00" "$116,009.00" "$4,709.00" "$2,000.00" "$2,609.00" + "$0.00" "$100.00" "$11,000.00" "$2,000.00" "$9,000.00" "30 FUNDS " "$300.00" + "$300.00" "#200.00 " "$100,000.00" "$116,009.00" "$9,500.00" "$9,500.00" + "$500.00" "$9,000.00" "$9,500.00" "$103,600.00" "$2,909.00" "$0.00" + "$106,509.00" "1 FUNDS $300.00" "#1.00 $1.50") + (sxml->table-row-col sxml 1 #f 3)) + (test-equal "bal-1/1/72" + '("01/01/72" "$117,529.00" "$117,529.00" "$4,709.00" "$2,000.00" "$2,609.00" + "$0.00" "$100.00" "$12,500.00" "$2,000.00" "$10,500.00" "30 FUNDS " "$320.00" + "$320.00" "#200.00 " "$100,000.00" "$117,529.00" "$9,500.00" "$9,500.00" + "$500.00" "$9,000.00" "$9,500.00" "$103,600.00" "$4,429.00" "$0.00" + "$108,029.00" "1 FUNDS $350.00" "#1.00 $1.60") + (sxml->table-row-col sxml 1 #f 4))))) + +(define (multicol-pnl-tests) + (define (default-testing-options) + (let ((options (gnc:make-report-options multicol-pnl-uuid))) + (set-option! options "General" "Start Date" + (cons 'absolute (gnc-dmy2time64 1 1 1980))) + (set-option! options "General" "End Date" + (cons 'absolute (gnc-dmy2time64 31 3 1980))) + (set-option! options "General" "Enable dual columns" #f) + (set-option! options "General" "Disable amount indenting" #t) + (set-option! options "Display" "Account full name instead of indenting" #t) + (set-option! options "Accounts" "Levels of Subaccounts" 'all) + (set-option! options "Commodities" "Show Exchange Rates" #t) + options)) + (display "\n\n multicol-pnl tests\n\n") + (let* ((multi-bs-options (default-testing-options)) + (sxml (options->sxml multicol-pnl-uuid multi-bs-options + "multicol-pnl-default"))) + (test-equal "default row headers" + '("Income" "Root.Income" "Root.Income" "Root.Income.Income-GBP" + "Total For Income") + (sxml->table-row-col sxml 1 #f 1)) + (test-equal "default pnl" + '("$250.00" "#600.00" "$250.00" "#600.00" "$250.00" "#600.00") + (sxml->table-row-col sxml 1 #f 2)) + + ;; the following tests many parts of multicolumn pnl: + ;; multiple-dates pnl + (set-option! multi-bs-options "General" "Period duration" 'MonthDelta) + (set-option! multi-bs-options "Commodities" "Common Currency" #t) + (set-option! multi-bs-options "Commodities" "Report's currency" USD) + (let ((sxml (options->sxml multicol-pnl-uuid multi-bs-options + "multicol-pnl-halfyear"))) + (test-equal "pnl-1/80" + '("01/01/80" " to 01/31/80" "$1,100.00" "$250.00" "$850.00" "#500.00 " + "$1,100.00" "#1.00 $1.70") + (sxml->table-row-col sxml 1 #f 2)) + (test-equal "pnl-2/80" + '("02/01/80" " to 02/29/80" "$170.00" "$0.00" "$170.00" "#100.00 " + "$170.00" "#1.00 $1.70") + (sxml->table-row-col sxml 1 #f 3)) + (test-equal "pnl-3/80" + '("03/01/80" " to 03/31/80" "$0.00" "$0.00" "$0.00" "#0.00 " + "$0.00" "#1.00 $1.70") + (sxml->table-row-col sxml 1 #f 4))))) From 1af8e272c7603cd08bad11a2f9374e234710783c Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Tue, 26 Nov 2019 21:33:33 +0800 Subject: [PATCH 04/19] [balsheet-pnl] unrealized-gain calculator is now much faster. Previous code would call gnc:account-get-comm-value-at-date for each report-date; this function generates qof-query, retrieves account splits, scans them to accumulate split->transaction->currency and split->value into a commodity collector. This commit will hook into the existing gnc:account-accumulate function, accumulating the same split->transaction->currency and split->value into a collector. Note we must make a copy of the accumulator at each report-date via (gnc:collector+ val-coll) otherwise the same val-coll will be mutated through subsequent splits. For a multicolumn balsheet, for every account with N old splits, and reporting on M report dates, it would run in O(N*M) time. This algorithm will hook into existing accumulator, i.e. I think O(1). The majority speed-up however comes from avoiding M qof-queries per report. --- .../report/standard-reports/balsheet-pnl.scm | 56 ++++++++++++++++--- 1 file changed, 48 insertions(+), 8 deletions(-) diff --git a/gnucash/report/standard-reports/balsheet-pnl.scm b/gnucash/report/standard-reports/balsheet-pnl.scm index de0d44e492..d8a48d471e 100644 --- a/gnucash/report/standard-reports/balsheet-pnl.scm +++ b/gnucash/report/standard-reports/balsheet-pnl.scm @@ -38,10 +38,11 @@ ;; the column-data record. the gnc:account-accumulate-at-dates will ;; create a record for each report-date with split-data as follows: (define-record-type :col-datum - (make-datum last-split split-balance) + (make-datum last-split split-balance split-value-balance) col-datum? (last-split col-datum-get-last-split) - (split-balance col-datum-get-split-balance)) + (split-balance col-datum-get-split-balance) + (split-value-balance col-datum-get-split-value-balance)) (define FOOTER-TEXT (gnc:make-html-text @@ -785,14 +786,20 @@ also show overall period profit & loss.")) (map (lambda (acc) (let* ((comm (xaccAccountGetCommodity acc)) + (val-coll (gnc:make-commodity-collector)) (amt->monetary (lambda (amt) (gnc:make-gnc-monetary comm amt)))) (cons acc (gnc:account-accumulate-at-dates acc report-dates - #:nosplit->elt (make-datum #f (amt->monetary 0)) + #:nosplit->elt (make-datum #f (amt->monetary 0) + (gnc:make-commodity-collector)) #:split->elt (lambda (s) - (make-datum s (amt->monetary (xaccSplitGetBalance s)))))))) + (val-coll 'add + (xaccTransGetCurrency (xaccSplitGetParent s)) + (xaccSplitGetValue s)) + (make-datum s (amt->monetary (xaccSplitGetBalance s)) + (gnc:collector+ val-coll))))))) accounts)) ;; an alist of (cons account account-balances) whereby @@ -945,6 +952,8 @@ also show overall period profit & loss.")) (split (vector-ref date-splits col-idx))) (gnc:split-anchor-text split)))) + ;; a list of collectors whereby collector is the sum of + ;; asset and liabilities at report dates (asset-liability-balances (let ((asset-liab-balances (map cdr (filter @@ -955,6 +964,8 @@ also show overall period profit & loss.")) (map (const (gnc:make-commodity-collector)) report-dates) (apply map gnc:monetaries-add asset-liab-balances)))) + ;; a list of collectors whereby collector is the sum of + ;; incomes and expenses at report dates (income-expense-balances (let ((inc-exp-balances (map cdr @@ -967,6 +978,30 @@ also show overall period profit & loss.")) (map gnc:commodity-collector-get-negated (apply map gnc:monetaries-add inc-exp-balances))))) + ;; an (cons account list-of-collectors) whereby each + ;; collector is the split-value-balances at report + ;; dates. split-value-balance determined by transaction currency. + (accounts-value-balances + (map + (lambda (acc) + (cons acc (let ((cols-data (assoc-ref accounts-cols-data acc))) + (map col-datum-get-split-value-balance cols-data)))) + accounts)) + + ;; a list of collectors whereby each collector is the sum + ;; of asset and liability split-value-balances at report + ;; dates + (asset-liability-value-balances + (let ((asset-liab-value-balances + (map cdr (filter + (lambda (acc-balances) + (member (car acc-balances) asset-liability)) + accounts-value-balances)))) + (if (null? asset-liab-value-balances) + (map (const (gnc:make-commodity-collector)) report-dates) + (apply map gnc:collector+ asset-liab-value-balances)))) + + ;; converts monetaries to common currency (monetaries->exchanged (lambda (monetaries target-currency price-source date) (let ((exchange-fn (gnc:case-exchange-fn @@ -978,6 +1013,10 @@ also show overall period profit & loss.")) (exchange-fn mon target-currency)) (monetaries 'format gnc:make-gnc-monetary #f))))))) + ;; the unrealized gain calculator retrieves the + ;; asset-and-liability report-date balance and + ;; value-balance, and calculates the difference, + ;; converted to report currency. (unrealized-gain-fn (lambda (col-idx) (and common-currency @@ -987,14 +1026,15 @@ also show overall period profit & loss.")) (asset-liability-balance (list-ref asset-liability-balances col-idx)) (asset-liability-basis - (gnc:accounts-get-comm-total-assets - asset-liability - (lambda (acc) - (gnc:account-get-comm-value-at-date acc date #f)))) + (list-ref asset-liability-value-balances col-idx)) (unrealized (gnc:collector- asset-liability-basis asset-liability-balance))) (monetaries->exchanged unrealized common-currency price-source date))))) + + ;; the retained earnings calculator retrieves the + ;; income-and-expense report-date balance, and converts + ;; to report currency. (retained-earnings-fn (lambda (col-idx) (let* ((date (case price-source From 7853f5a24a4ed6e5cf32fdf6e5eba217a1e312cd Mon Sep 17 00:00:00 2001 From: John Ralls Date: Thu, 28 Nov 2019 09:17:59 -0800 Subject: [PATCH 05/19] Ignore trailing noise on imported transaction account numbers. AQBanking6 uses a separate method for retrieving account numbers for account info and transactions, where the transactions method can have additional characters, most often the ISO4217 currency code. That results in match failures when importing. As a work-around, compare only the length of the account-info-generated online id when comparing it to the transaction-generated one. Note that this is only a partial solution: At least one German bank also appends characters to the transaction-generated bank id and that will still cause the match to fail. --- gnucash/import-export/import-account-matcher.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gnucash/import-export/import-account-matcher.c b/gnucash/import-export/import-account-matcher.c index 0837150d44..7cbbcd7bb4 100644 --- a/gnucash/import-export/import-account-matcher.c +++ b/gnucash/import-export/import-account-matcher.c @@ -86,7 +86,8 @@ static gpointer test_acct_online_id_match(Account *acct, gpointer param_online_i const gchar * current_online_id = gnc_import_get_acc_online_id(acct); if ( (current_online_id != NULL && param_online_id != NULL ) - && strcmp( current_online_id, param_online_id ) == 0 ) + && strncmp( current_online_id, param_online_id, + strlen( current_online_id ) ) == 0 ) { return (gpointer *) acct; } From 34c14b44a9f98035206465ab3543d43bc06ddd3d Mon Sep 17 00:00:00 2001 From: Andrey Legayev Date: Fri, 29 Nov 2019 18:32:50 +0200 Subject: [PATCH 06/19] Remove not needed semicolons in Python bindings --- .../example_scripts/rest-api/gnucash_simple.py | 16 ++++++++-------- bindings/python/gnucash_core.py | 6 +++--- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/bindings/python/example_scripts/rest-api/gnucash_simple.py b/bindings/python/example_scripts/rest-api/gnucash_simple.py index 1bc56de026..2aa234f953 100644 --- a/bindings/python/example_scripts/rest-api/gnucash_simple.py +++ b/bindings/python/example_scripts/rest-api/gnucash_simple.py @@ -34,14 +34,14 @@ def addressToDict(address): return None else: simple_address = {} - simple_address['name'] = address.GetName(); - simple_address['line_1'] = address.GetAddr1(); - simple_address['line_2'] = address.GetAddr2(); - simple_address['line_3'] = address.GetAddr3(); - simple_address['line_4'] = address.GetAddr4(); - simple_address['phone'] = address.GetPhone(); - simple_address['fax'] = address.GetFax(); - simple_address['email'] = address.GetEmail(); + simple_address['name'] = address.GetName() + simple_address['line_1'] = address.GetAddr1() + simple_address['line_2'] = address.GetAddr2() + simple_address['line_3'] = address.GetAddr3() + simple_address['line_4'] = address.GetAddr4() + simple_address['phone'] = address.GetPhone() + simple_address['fax'] = address.GetFax() + simple_address['email'] = address.GetEmail() return simple_address diff --git a/bindings/python/gnucash_core.py b/bindings/python/gnucash_core.py index 9b1416f9de..c7a7901e41 100644 --- a/bindings/python/gnucash_core.py +++ b/bindings/python/gnucash_core.py @@ -619,7 +619,7 @@ methods_return_instance(GncLot, gnclot_dict) # Transaction Transaction.add_methods_with_prefix('xaccTrans') -Transaction.add_method('gncTransGetGUID', 'GetGUID'); +Transaction.add_method('gncTransGetGUID', 'GetGUID') Transaction.add_method('xaccTransGetDescription', 'GetDescription') Transaction.add_method('xaccTransDestroy', 'Destroy') @@ -648,7 +648,7 @@ Transaction.decorate_functions( # Split Split.add_methods_with_prefix('xaccSplit') -Split.add_method('gncSplitGetGUID', 'GetGUID'); +Split.add_method('gncSplitGetGUID', 'GetGUID') Split.add_method('xaccSplitDestroy', 'Destroy') split_dict = { @@ -677,7 +677,7 @@ Split.parent = property( Split.GetParent, Split.SetParent ) # Account Account.add_methods_with_prefix('xaccAccount') Account.add_methods_with_prefix('gnc_account_') -Account.add_method('gncAccountGetGUID', 'GetGUID'); +Account.add_method('gncAccountGetGUID', 'GetGUID') Account.add_method('xaccAccountGetPlaceholder', 'GetPlaceholder') account_dict = { From 54c4575f27a6b6033aac147ee542b2fc6943cc3a Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Thu, 28 Nov 2019 12:17:34 +0800 Subject: [PATCH 07/19] [balsheet-pnl] fix: hide Equity sections when not needed * If currencies are not converted, Unrealized Gains are meaningless. Hide them. * If there are no income/expense accounts, retained earnings will be nil. Remove row. --- gnucash/report/standard-reports/balsheet-pnl.scm | 13 ++++++++----- .../standard-reports/test/test-balsheet-pnl.scm | 2 +- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/gnucash/report/standard-reports/balsheet-pnl.scm b/gnucash/report/standard-reports/balsheet-pnl.scm index d8a48d471e..36804aabbe 100644 --- a/gnucash/report/standard-reports/balsheet-pnl.scm +++ b/gnucash/report/standard-reports/balsheet-pnl.scm @@ -1125,11 +1125,14 @@ also show overall period profit & loss.")) (add-to-table multicol-table-right (_ "Equity") (append equity-accounts - (list - (vector (_ "Unrealized Gains") - unrealized-gain-fn) - (vector (_ "Retained Earnings") - retained-earnings-fn))) + (if common-currency + (list (vector (_ "Unrealized Gains") + unrealized-gain-fn)) + '()) + (if (null? income-expense) + '() + (list (vector (_ "Retained Earnings") + retained-earnings-fn)))) #:negate-amounts? #t) (if (and common-currency show-rates?) diff --git a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm index 9fa490a884..98e272c35c 100644 --- a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm +++ b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm @@ -497,7 +497,7 @@ "Root.Asset.House" "Total For Asset" "Liability" "Root.Liability" "Root.Liability.Bank2" "Root.Liability.Bank2.CreditCard" "Root.Liability.Bank2.Loan" "Total For Liability" "Equity" "Root.Equity" - "Unrealized Gains" "Retained Earnings" "Total For Equity") + "Retained Earnings" "Total For Equity") (sxml->table-row-col sxml 1 #f 1)) (test-equal "default balances" '("#200.00" "$106,709.00" "30 FUNDS" "#200.00" "$106,709.00" "30 FUNDS" From e97b78df80251ef21eb268575ae80e08a0fd151e Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Thu, 28 Nov 2019 22:41:47 +0800 Subject: [PATCH 08/19] [balsheet-pnl] fix: single-date balsheet missed printing date --- gnucash/report/standard-reports/balsheet-pnl.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnucash/report/standard-reports/balsheet-pnl.scm b/gnucash/report/standard-reports/balsheet-pnl.scm index 36804aabbe..f483120f56 100644 --- a/gnucash/report/standard-reports/balsheet-pnl.scm +++ b/gnucash/report/standard-reports/balsheet-pnl.scm @@ -917,7 +917,7 @@ also show overall period profit & loss.")) (if (or incr (eq? report-type 'pnl)) (format #t (_ "~a to ~a") (qof-print-date startdate) (qof-print-date enddate)) - (qof-print-date enddate))))) + (display (qof-print-date enddate)))))) (if (eq? (get-option gnc:pagename-general optname-options-summary) 'always) (gnc:html-document-add-object! From def0caa011c32fcb77d40d28527a4d6d174bc22c Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Thu, 28 Nov 2019 12:29:47 +0800 Subject: [PATCH 09/19] [balsheet-pnl] use and-let*, reindent --- .../report/standard-reports/balsheet-pnl.scm | 152 +++++++++--------- 1 file changed, 78 insertions(+), 74 deletions(-) diff --git a/gnucash/report/standard-reports/balsheet-pnl.scm b/gnucash/report/standard-reports/balsheet-pnl.scm index f483120f56..566c659e44 100644 --- a/gnucash/report/standard-reports/balsheet-pnl.scm +++ b/gnucash/report/standard-reports/balsheet-pnl.scm @@ -1019,18 +1019,18 @@ also show overall period profit & loss.")) ;; converted to report currency. (unrealized-gain-fn (lambda (col-idx) - (and common-currency - (let* ((date (case price-source - ((pricedb-latest) (current-time)) - (else (list-ref report-dates col-idx)))) - (asset-liability-balance - (list-ref asset-liability-balances col-idx)) - (asset-liability-basis - (list-ref asset-liability-value-balances col-idx)) - (unrealized (gnc:collector- asset-liability-basis - asset-liability-balance))) - (monetaries->exchanged - unrealized common-currency price-source date))))) + (and-let* (common-currency + (date (case price-source + ((pricedb-latest) (current-time)) + (else (list-ref report-dates col-idx)))) + (asset-liability-balance + (list-ref asset-liability-balances col-idx)) + (asset-liability-basis + (list-ref asset-liability-value-balances col-idx)) + (unrealized (gnc:collector- asset-liability-basis + asset-liability-balance))) + (monetaries->exchanged + unrealized common-currency price-source date)))) ;; the retained earnings calculator retrieves the ;; income-and-expense report-date balance, and converts @@ -1052,26 +1052,30 @@ also show overall period profit & loss.")) gnc:monetary-neg (income-expense-balance 'format gnc:make-gnc-monetary #f)))))) - (chart (and include-chart? incr - (gnc:make-report-anchor - networth-barchart-uuid report-obj - (list (list "General" "Start Date" (cons 'absolute startdate)) - (list "General" "End Date" (cons 'absolute enddate)) - (list "General" "Report's currency" - (or common-currency book-main-currency)) - (list "General" "Step Size" incr) - (list "General" "Price Source" - (or price-source 'pricedb-nearest)) - (list "Accounts" "Accounts" asset-liability))))) - (get-col-header-fn (lambda (accounts col-idx) - (let* ((date (list-ref report-dates col-idx)) - (header (qof-print-date date)) - (cell (gnc:make-html-table-cell/markup - "total-label-cell" header))) - (gnc:html-table-cell-set-style! - cell "total-label-cell" - 'attribute '("style" "text-align:right")) - cell))) + (chart (and-let* (include-chart? + incr + (curr (or common-currency book-main-currency)) + (price (or price-source 'pricedb-nearest))) + (gnc:make-report-anchor + networth-barchart-uuid report-obj + (list (list "General" "Start Date" (cons 'absolute startdate)) + (list "General" "End Date" (cons 'absolute enddate)) + (list "General" "Report's currency" curr) + (list "General" "Step Size" incr) + (list "General" "Price Source" price) + (list "Accounts" "Accounts" asset-liability))))) + + (get-col-header-fn + (lambda (accounts col-idx) + (let* ((date (list-ref report-dates col-idx)) + (header (qof-print-date date)) + (cell (gnc:make-html-table-cell/markup + "total-label-cell" header))) + (gnc:html-table-cell-set-style! + cell "total-label-cell" + 'attribute '("style" "text-align:right")) + cell))) + (add-to-table (lambda* (table title accounts #:key (get-col-header-fn #f) (show-accounts? #t) @@ -1170,6 +1174,7 @@ also show overall period profit & loss.")) (cons (car balancelist) (last balancelist)) (cons (list-ref balancelist idx) (list-ref balancelist (1+ idx)))))) + (closing-entries (let ((query (qof-query-create-for-splits))) (qof-query-set-book query (gnc-get-current-book)) (xaccQueryAddAccountMatch @@ -1183,6 +1188,7 @@ also show overall period profit & loss.")) (let ((splits (qof-query-run query))) (qof-query-destroy query) splits))) + ;; this function will query the above closing-entries for ;; splits within the date range, and produce the total ;; amount for these closing entries @@ -1198,52 +1204,49 @@ also show overall period profit & loss.")) (gnc:make-gnc-monetary (xaccAccountGetCommodity account) (apply + (map xaccSplitGetAmount account-closing-splits)))))) + (get-cell-monetary-fn (lambda (account col-idx) - (let ((account-balance-list (assoc account accounts-balances))) - (and account-balance-list - (let ((monetarypair (col-idx->monetarypair - (cdr account-balance-list) - col-idx))) - (monetary-less - (cdr monetarypair) - (car monetarypair) - (closing-adjustment account col-idx))))))) + (let* ((balances (assoc-ref accounts-balances account)) + (monetarypair (col-idx->monetarypair balances col-idx))) + (monetary-less + (cdr monetarypair) + (car monetarypair) + (closing-adjustment account col-idx))))) - (get-cell-anchor-fn (lambda (account col-idx) - (define datepair (col-idx->datepair col-idx)) - (gnc:make-report-anchor - trep-uuid report-obj - (list - (list "General" "Start Date" - (cons 'absolute (car datepair))) - (list "General" "End Date" - (cons 'absolute (cdr datepair))) - (list "General" "Show original currency amount" - (and common-currency #t)) - (list "General" "Common Currency" - common-currency) - (list "General" "Report's currency" - (or common-currency book-main-currency)) - (list "Display" "Amount" 'double) - (list "Accounts" "Accounts" - (if (pair? account) - account - (list account))))))) + (get-cell-anchor-fn + (lambda (account col-idx) + (let ((datepair (col-idx->datepair col-idx)) + (show-orig? (and common-currency #t)) + (curr (or common-currency book-main-currency)) + (delta (or incr 'MonthDelta)) + (price (or price-source 'pricedb-nearest)) + (accts (if (pair? account) account (list account)))) + (gnc:make-report-anchor + trep-uuid report-obj + (list + (list "General" "Start Date" (cons 'absolute (car datepair))) + (list "General" "End Date" (cons 'absolute (cdr datepair))) + (list "General" "Show original currency amount" show-orig?) + (list "General" "Common Currency" common-currency) + (list "General" "Report's currency" curr) + (list "Display" "Amount" 'double) + (list "Accounts" "Accounts" accts)))))) + + (chart + (and-let* (include-chart? + (curr (or common-currency book-main-currency)) + (delta (or incr 'MonthDelta)) + (price (or price-source 'pricedb-nearest))) + (gnc:make-report-anchor + pnl-barchart-uuid report-obj + (list (list "General" "Start Date" (cons 'absolute startdate)) + (list "General" "End Date" (cons 'absolute enddate)) + (list "General" "Report's currency" curr) + (list "General" "Step Size" delta) + (list "General" "Price Source" price) + (list "Accounts" "Accounts" income-expense))))) - (chart (and include-chart? - (gnc:make-report-anchor - pnl-barchart-uuid report-obj - (list (list "General" "Start Date" - (cons 'absolute startdate)) - (list "General" "End Date" - (cons 'absolute enddate)) - (list "General" "Report's currency" - (or common-currency book-main-currency)) - (list "General" "Step Size" (or incr 'MonthDelta)) - (list "General" "Price Source" - (or price-source 'pricedb-nearest)) - (list "Accounts" "Accounts" income-expense))))) (get-col-header-fn (lambda (accounts col-idx) (let* ((datepair (col-idx->datepair col-idx)) @@ -1258,6 +1261,7 @@ also show overall period profit & loss.")) cell "total-label-cell" 'attribute '("style" "text-align:right")) cell))) + (add-to-table (lambda* (table title accounts #:key (get-col-header-fn #f) (show-accounts? #t) From c21bb66d689972042c95694801f9932e8b982a97 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Thu, 28 Nov 2019 22:42:31 +0800 Subject: [PATCH 10/19] [balsheet-pnl] refactor common account-balance-list adder * use fold, more efficient, removes the need for intermediate list (map cdr (filter filter-fn accounts-balances)): filter will create 1 intermediate list, which is passed as an argument to map which creates the final list. using fold will remove the need for intermediate list. * list->vector for O(1) access --- .../report/standard-reports/balsheet-pnl.scm | 55 ++++++++----------- 1 file changed, 22 insertions(+), 33 deletions(-) diff --git a/gnucash/report/standard-reports/balsheet-pnl.scm b/gnucash/report/standard-reports/balsheet-pnl.scm index 566c659e44..ac616febc9 100644 --- a/gnucash/report/standard-reports/balsheet-pnl.scm +++ b/gnucash/report/standard-reports/balsheet-pnl.scm @@ -909,6 +909,15 @@ also show overall period profit & loss.")) (maxindent (1+ (apply max (cons 0 (map gnc-account-get-current-depth accounts)))))) + (define (sum-balances-of-accounts alist accts adder) + (let ((balances + (fold (lambda (a b) (if (member (car a) accts) (cons (cdr a) b) b)) + '() alist))) + (list->vector + (if (null? balances) + (map (const (adder)) report-dates) + (apply map adder balances))))) + (gnc:html-document-set-title! doc (with-output-to-string (lambda () @@ -952,33 +961,19 @@ also show overall period profit & loss.")) (split (vector-ref date-splits col-idx))) (gnc:split-anchor-text split)))) - ;; a list of collectors whereby collector is the sum of + ;; a vector of collectors whereby collector is the sum of ;; asset and liabilities at report dates (asset-liability-balances - (let ((asset-liab-balances - (map cdr (filter - (lambda (acc-balances) - (member (car acc-balances) asset-liability)) - accounts-balances)))) - (if (null? asset-liab-balances) - (map (const (gnc:make-commodity-collector)) report-dates) - (apply map gnc:monetaries-add asset-liab-balances)))) + (sum-balances-of-accounts + accounts-balances asset-liability gnc:monetaries-add)) - ;; a list of collectors whereby collector is the sum of + ;; a vector of collectors whereby collector is the sum of ;; incomes and expenses at report dates (income-expense-balances - (let ((inc-exp-balances - (map cdr - (filter - (lambda (acc-balances) - (member (car acc-balances) income-expense)) - accounts-balances)))) - (if (null? inc-exp-balances) - (map (const (gnc:make-commodity-collector)) report-dates) - (map gnc:commodity-collector-get-negated - (apply map gnc:monetaries-add inc-exp-balances))))) + (sum-balances-of-accounts + accounts-balances income-expense gnc:monetaries-add)) - ;; an (cons account list-of-collectors) whereby each + ;; an alist of (cons account list-of-collectors) whereby each ;; collector is the split-value-balances at report ;; dates. split-value-balance determined by transaction currency. (accounts-value-balances @@ -988,18 +983,12 @@ also show overall period profit & loss.")) (map col-datum-get-split-value-balance cols-data)))) accounts)) - ;; a list of collectors whereby each collector is the sum + ;; a vector of collectors whereby each collector is the sum ;; of asset and liability split-value-balances at report ;; dates (asset-liability-value-balances - (let ((asset-liab-value-balances - (map cdr (filter - (lambda (acc-balances) - (member (car acc-balances) asset-liability)) - accounts-value-balances)))) - (if (null? asset-liab-value-balances) - (map (const (gnc:make-commodity-collector)) report-dates) - (apply map gnc:collector+ asset-liab-value-balances)))) + (sum-balances-of-accounts + accounts-value-balances asset-liability gnc:collector+)) ;; converts monetaries to common currency (monetaries->exchanged @@ -1024,9 +1013,9 @@ also show overall period profit & loss.")) ((pricedb-latest) (current-time)) (else (list-ref report-dates col-idx)))) (asset-liability-balance - (list-ref asset-liability-balances col-idx)) + (vector-ref asset-liability-balances col-idx)) (asset-liability-basis - (list-ref asset-liability-value-balances col-idx)) + (vector-ref asset-liability-value-balances col-idx)) (unrealized (gnc:collector- asset-liability-basis asset-liability-balance))) (monetaries->exchanged @@ -1041,7 +1030,7 @@ also show overall period profit & loss.")) ((pricedb-latest) (current-time)) (else (list-ref report-dates col-idx)))) (income-expense-balance - (list-ref income-expense-balances col-idx))) + (vector-ref income-expense-balances col-idx))) (if (and common-currency (every has-price? (gnc:accounts-get-commodities income-expense #f))) From df1f033f4156c3a3b068591350c0156f74711868 Mon Sep 17 00:00:00 2001 From: Geert Janssens Date: Sat, 30 Nov 2019 13:20:08 +0100 Subject: [PATCH 11/19] bindings-python - drop references to gnucash-env We no longer ship a gnucash-env script, directly use python(3) instead --- bindings/python/example_scripts/account_analysis.py | 6 +++--- .../example_scripts/new_book_with_opening_balances.py | 8 ++++---- bindings/python/example_scripts/priceDB_test.py | 5 +++-- bindings/python/example_scripts/price_database_example.py | 5 +++-- bindings/python/example_scripts/simple_business_create.py | 4 ++-- bindings/python/example_scripts/simple_invoice_insert.py | 2 +- .../python/example_scripts/test_imbalance_transaction.py | 2 +- 7 files changed, 17 insertions(+), 15 deletions(-) diff --git a/bindings/python/example_scripts/account_analysis.py b/bindings/python/example_scripts/account_analysis.py index fe51e8d7b6..135d2e60ef 100644 --- a/bindings/python/example_scripts/account_analysis.py +++ b/bindings/python/example_scripts/account_analysis.py @@ -38,7 +38,7 @@ import csv from gnucash import Session, GncNumeric, Split # Invoke this script like the following example -# $ gnucash-env python account_analysis.py gnucash_file.gnucash \ +# $ python3 account_analysis.py gnucash_file.gnucash \ # 2010 1 monthly 12 \ # debits-show credits-show Assets 'Test Account' # @@ -156,9 +156,9 @@ def main(): print('usage: account_analysis.py {book url} {start year} {start month, numeric} {period type: monthly, quarterly, or yearly} {number of periods to show, from start year and month} {whether to show debits: debits-show for true, all other values false} {whether to show credits: credits-show for true, all other values false} {space separated account path, as many nested levels as desired} ') print('examples:\n') print("The following example analyzes 12 months of 'Assets:Test Account' from /home/username/test.gnucash, starting in January of 2010, and shows both credits and debits") - print("gnucash-env python account_analysis.py '/home/username/test.gnucash' 2010 1 monthly 12 debits-show credits-show Assets 'Test Account'\n") + print("python3 account_analysis.py '/home/username/test.gnucash' 2010 1 monthly 12 debits-show credits-show Assets 'Test Account'\n") print("The following example analyzes 2 quarters of 'Liabilities:First Level:Second Level' from /home/username/test.gnucash, starting March 2011, and shows credits but not debits") - print("gnucash-env python account_analysis.py '/home/username/test.gnucash' 2011 3 quarterly 2 debits-noshow credits-show Liabilities 'First Level' 'Second Level") + print("python3 account_analysis.py '/home/username/test.gnucash' 2011 3 quarterly 2 debits-noshow credits-show Liabilities 'First Level' 'Second Level") return try: diff --git a/bindings/python/example_scripts/new_book_with_opening_balances.py b/bindings/python/example_scripts/new_book_with_opening_balances.py index 7c7ee4c45e..df2d29ae7a 100644 --- a/bindings/python/example_scripts/new_book_with_opening_balances.py +++ b/bindings/python/example_scripts/new_book_with_opening_balances.py @@ -51,11 +51,11 @@ from datetime import date # mutual, and trading, you'll have to put the opening balance in yourself # # Invocation examples: -# gnucash-env python new_book_with_opening_balances.py \ +# python3 new_book_with_opening_balances.py \ # '/home/mark/test.gnucash' # 'sqlite3:///home/mark/new_test.gnucash' # -# gnucash-env python new_book_with_opening_balances.py \ +# python3 new_book_with_opening_balances.py \ # '/home/mark/test.gnucash' \ # 'xml:///crypthome/mark/parit-financial-system/new_test.gnucash' # @@ -293,8 +293,8 @@ def main(): print('not enough parameters') print('usage: new_book_with_opening_balances.py {source_book_url} {destination_book_url}') print('examples:') - print("gnucash-env python new_book_with_opening_balances.py '/home/username/test.gnucash' 'sqlite3:///home/username/new_test.gnucash'") - print("gnucash-env python new_book_with_opening_balances.py '/home/username/test.gnucash' 'xml:///crypthome/username/finances/new_test.gnucash'") + print("python3 new_book_with_opening_balances.py '/home/username/test.gnucash' 'sqlite3:///home/username/new_test.gnucash'") + print("python3 new_book_with_opening_balances.py '/home/username/test.gnucash' 'xml:///crypthome/username/finances/new_test.gnucash'") return #have everything in a try block to unable us to release our hold on stuff to the extent possible diff --git a/bindings/python/example_scripts/priceDB_test.py b/bindings/python/example_scripts/priceDB_test.py index 8ec671500d..a1ce64784f 100644 --- a/bindings/python/example_scripts/priceDB_test.py +++ b/bindings/python/example_scripts/priceDB_test.py @@ -5,8 +5,9 @@ # before running this. # Adding to a calling bash script would be better # Although calling it from here would be even better! -# OR: export PYTHONPATH=$HOME/progs/lib/python2.6/site-packages -# Then: gnucash-env ipython +# OR: export PYTHONPATH=/lib/python3.7/site-packages:$PYTHONPATH +# You may have to adjust the above path to your local system (lib->lib64, python3.7->...) +# Then: ipython3 # The account file is not saved but always use a disposable copy. # Change, FILE, CURRENCY and STOCK to those defined in your test account. diff --git a/bindings/python/example_scripts/price_database_example.py b/bindings/python/example_scripts/price_database_example.py index 49c5d28d91..2df02b5ebb 100755 --- a/bindings/python/example_scripts/price_database_example.py +++ b/bindings/python/example_scripts/price_database_example.py @@ -5,8 +5,9 @@ # before running this. # Adding to a calling bash script would be better # Although calling it from here would be even better! -# OR: export PYTHONPATH=$HOME/progs/lib/python2.6/site-packages -# Then: gnucash-env ipython +# OR: export PYTHONPATH=/lib/python3.7/site-packages:$PYTHONPATH +# You may have to adjust the above path to your local system (lib->lib64, python3.7->...) +# Then: ipython3 # The account file is not saved but always use a disposable copy. # Thanks for contributions by Christoph Holtermann and Mark Jenkins diff --git a/bindings/python/example_scripts/simple_business_create.py b/bindings/python/example_scripts/simple_business_create.py index 22c5f87dc2..bb00846df9 100644 --- a/bindings/python/example_scripts/simple_business_create.py +++ b/bindings/python/example_scripts/simple_business_create.py @@ -24,7 +24,7 @@ # Creates a new book file (or *overwrites* an existing one) that has elements # in it for business use -- intended as a demonstration program. # Syntax: -# gnucash-env python simple_business_create.py \ +# python3 simple_business_create.py \ # sqlite3:///home/blah/blah.gnucash # # Specifically, this sets up a simple tree, creates a customer, job, @@ -65,7 +65,7 @@ if len(argv) < 2: print('not enough parameters') print('usage: simple_business_create.py {new_book_url}') print('example:') - print("gnucash-env python simple_business_create.py sqlite3:///home/blah/blah.gnucash") + print("python3 simple_business_create.py sqlite3:///home/blah/blah.gnucash") exit() diff --git a/bindings/python/example_scripts/simple_invoice_insert.py b/bindings/python/example_scripts/simple_invoice_insert.py index 63633d72cb..eef4c03baa 100644 --- a/bindings/python/example_scripts/simple_invoice_insert.py +++ b/bindings/python/example_scripts/simple_invoice_insert.py @@ -30,7 +30,7 @@ # this to become an invoice importer for your own books # # Syntax: -# gnucash-env python simple_invoice_insert.py \ +# python3 simple_invoice_insert.py \ # /home/blah/blah.gnucash # dda2ec8e3e63c7715097f852851d6b22 1001 'The Goods' 201.43 # diff --git a/bindings/python/example_scripts/test_imbalance_transaction.py b/bindings/python/example_scripts/test_imbalance_transaction.py index aa5eef0d41..a119bb730b 100644 --- a/bindings/python/example_scripts/test_imbalance_transaction.py +++ b/bindings/python/example_scripts/test_imbalance_transaction.py @@ -45,7 +45,7 @@ if len(argv) < 2: print('not enough parameters') print('usage: test_imbalance_transaction.py {book_url}') print('examples:') - print("gnucash-env python test_imbalance_transaction.py '/home/username/test.gnucash'") + print("python3 test_imbalance_transaction.py '/home/username/test.gnucash'") exit() From a52d60f48e738ee4c91bfa03887dea1014f104fa Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sun, 1 Dec 2019 22:30:45 +0800 Subject: [PATCH 12/19] [business-reports] compact gnc:owner-report-text --- .../business-reports/business-reports.scm | 34 ++++++------------- 1 file changed, 11 insertions(+), 23 deletions(-) diff --git a/gnucash/report/business-reports/business-reports.scm b/gnucash/report/business-reports/business-reports.scm index 7c50821a9f..a9bb791eca 100644 --- a/gnucash/report/business-reports/business-reports.scm +++ b/gnucash/report/business-reports/business-reports.scm @@ -71,29 +71,17 @@ (define (gnc:owner-report-text owner acc) (let* ((end-owner (gncOwnerGetEndOwner owner)) - (type (gncOwnerGetType end-owner)) - (ref #f)) - - (cond - ((eqv? type GNC-OWNER-CUSTOMER) - (set! ref "owner=c:")) - - ((eqv? type GNC-OWNER-VENDOR) - (set! ref "owner=v:")) - - ((eqv? type GNC-OWNER-EMPLOYEE) - (set! ref "owner=e:")) - - (else (set! ref "unknown-type="))) - - (if ref - (begin - (set! ref (string-append ref (gncOwnerReturnGUID end-owner))) - (if (not (null? acc)) - (set! ref (string-append ref "&acct=" - (gncAccountGetGUID acc)))) - (gnc-build-url URL-TYPE-OWNERREPORT ref "")) - ref))) + (type (gncOwnerGetType end-owner))) + (gnc-build-url + URL-TYPE-OWNERREPORT + (string-append + (cond ((eqv? type GNC-OWNER-CUSTOMER) "owner=c:") + ((eqv? type GNC-OWNER-VENDOR) "owner=v:") + ((eqv? type GNC-OWNER-EMPLOYEE) "owner=e:") + (else "unknown-type=")) + (gncOwnerReturnGUID end-owner) + (if (null? acc) "" (string-append "&acct=" (gncAccountGetGUID acc)))) + ""))) ;; Creates a new report instance for the given invoice. The given ;; report-template-id must refer to an existing report template, which From 4aa17ef65bb0bd1cec3be632fc8af54769169431 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sun, 1 Dec 2019 22:17:19 +0800 Subject: [PATCH 13/19] [html-text][API] gnc:html-markup-ol, gnc:multiline-to-html-text * (gnc:html-markup-ol lst) creates an ordered list * gnc:multiline-to-html-text: creates html-text with
elements "line1\nline2\nline3" -> (gnc:make-html-text "line1" (gnc:html-markup-br) "line2" (gnc:html-markup-br) "line3") --- gnucash/report/report-system/html-text.scm | 3 +++ gnucash/report/report-system/report-system.scm | 2 ++ gnucash/report/report-system/report-utilities.scm | 10 ++++++++++ 3 files changed, 15 insertions(+) diff --git a/gnucash/report/report-system/html-text.scm b/gnucash/report/report-system/html-text.scm index fd1f29ade6..d34e2154bf 100644 --- a/gnucash/report/report-system/html-text.scm +++ b/gnucash/report/report-system/html-text.scm @@ -182,6 +182,9 @@ (gnc:html-markup "li" obj)) items))) +(define (gnc:html-markup-ol lst) + (apply gnc:html-markup "ol" + (map (lambda (elt) (gnc:html-markup "li" elt)) lst))) (define (gnc:html-markup-anchor href . rest) (apply gnc:html-markup/attr diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm index a351038b0b..cd0e32526f 100644 --- a/gnucash/report/report-system/report-system.scm +++ b/gnucash/report/report-system/report-system.scm @@ -666,6 +666,7 @@ (export gnc:html-markup-h3) (export gnc:html-markup-br) (export gnc:html-markup-hr) +(export gnc:html-markup-ol) (export gnc:html-markup-ul) (export gnc:html-markup-anchor) (export gnc:html-markup-img) @@ -744,6 +745,7 @@ (export gnc:get-assoc-account-balances) (export gnc:select-assoc-account-balance) (export gnc:get-assoc-account-balances-total) +(export gnc:multiline-to-html-text) (export make-file-url) (export gnc:strify) (export gnc:pk) diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm index f2cfaad445..75b5afb061 100644 --- a/gnucash/report/report-system/report-utilities.scm +++ b/gnucash/report/report-system/report-utilities.scm @@ -1109,6 +1109,16 @@ flawed. see report-utilities.scm. please update reports.") account-balances) total)) +(define (gnc:multiline-to-html-text str) + ;; simple function - splits string containing #\newline into + ;; substrings, and convert to a gnc:make-html-text construct which + ;; adds gnc:html-markup-br after each substring. + (let loop ((list-of-substrings (string-split str #\newline)) + (result '())) + (if (null? list-of-substrings) + (apply gnc:make-html-text (if (null? result) '() (reverse (cdr result)))) + (loop (cdr list-of-substrings) + (cons* (gnc:html-markup-br) (car list-of-substrings) result))))) ;; *************************************************************************** ;; Business Functions From 3ee434edf6658fde0d79bceb0516e7789b6cd230 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sun, 1 Dec 2019 22:17:37 +0800 Subject: [PATCH 14/19] [new-aging] use gnc:html-markup-ol --- gnucash/report/business-reports/new-aging.scm | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/gnucash/report/business-reports/new-aging.scm b/gnucash/report/business-reports/new-aging.scm index cd5362a999..5f0f8ba5ab 100644 --- a/gnucash/report/business-reports/new-aging.scm +++ b/gnucash/report/business-reports/new-aging.scm @@ -225,10 +225,6 @@ exist but have no suitable transactions.")) ((if (eq? sort-order 'increasing) string?) (gncOwnerGetName a) (gncOwnerGetName b))) - (define (html-markup-ol lst) - (apply gnc:html-markup "ol" - (map (lambda (elt) (gnc:html-markup "li" elt)) lst))) - ;; set default title (gnc:html-document-set-title! document report-title) @@ -340,7 +336,7 @@ exist but have no suitable transactions.")) document (gnc:make-html-text (_ "Please note some transactions were not processed") - (html-markup-ol + (gnc:html-markup-ol (map (lambda (invalid-split) (gnc:html-markup-anchor From 2333b6db271ad50bf5a3c5825990647b73077913 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sun, 1 Dec 2019 23:10:22 +0800 Subject: [PATCH 15/19] [reports] avoid "
" literal: use gnc:multiline-to-html-text --- .../business-reports/customer-summary.scm | 14 +------ gnucash/report/business-reports/invoice.scm | 10 +---- .../report/business-reports/job-report.scm | 36 +++++------------ .../report/business-reports/owner-report.scm | 39 ++++++------------- 4 files changed, 24 insertions(+), 75 deletions(-) diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm index e0ab202cdf..1f05883df0 100644 --- a/gnucash/report/business-reports/customer-summary.scm +++ b/gnucash/report/business-reports/customer-summary.scm @@ -179,17 +179,6 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (string-expand string character replace-string) - (with-output-to-string - (lambda () - (string-for-each - (lambda (c) - (display - (if (char=? c character) - replace-string - c))) - string)))) - (define (query owner account-list start-date end-date) (let* ((q (qof-query-create-for-splits)) (guid (and owner @@ -232,8 +221,7 @@ 'attribute (list "cellspacing" 0) 'attribute (list "cellpadding" 0)) (if name (gnc:html-table-append-row! table (list name))) - (if addy (gnc:html-table-append-row! - table (list (string-expand addy #\newline "
")))) + (if addy (gnc:html-table-append-row! table (gnc:multiline-to-html-text addy))) (gnc:html-table-append-row! table (list (gnc-print-time64 (gnc:get-today) date-format))) (let ((table-outer (gnc:make-html-table))) diff --git a/gnucash/report/business-reports/invoice.scm b/gnucash/report/business-reports/invoice.scm index 0beef5c12f..84bf7eedbf 100644 --- a/gnucash/report/business-reports/invoice.scm +++ b/gnucash/report/business-reports/invoice.scm @@ -178,15 +178,7 @@ keylist)) (define (multiline-to-html-text str) - ;; simple function - splits string containing #\newline into - ;; substrings, and convert to a gnc:make-html-text construct which - ;; adds gnc:html-markup-br after each substring. - (let loop ((list-of-substrings (string-split str #\newline)) - (result '())) - (if (null? list-of-substrings) - (apply gnc:make-html-text (if (null? result) '() (reverse (cdr result)))) - (loop (cdr list-of-substrings) - (cons* (gnc:html-markup-br) (car list-of-substrings) result))))) + (gnc:multiline-to-html-text str)) (define (options-generator variant) diff --git a/gnucash/report/business-reports/job-report.scm b/gnucash/report/business-reports/job-report.scm index 60954b02d5..c8fc66cfd9 100644 --- a/gnucash/report/business-reports/job-report.scm +++ b/gnucash/report/business-reports/job-report.scm @@ -416,24 +416,6 @@ (options-generator (list ACCT-TYPE-PAYABLE) GNC-OWNER-EMPLOYEE (_ "Expense Report") #t)) -(define (string-expand string character replace-string) - (define (car-line chars) - (take-while (lambda (c) (not (eqv? c character))) chars)) - (define (cdr-line chars) - (let ((rest (drop-while (lambda (c) (not (eqv? c character))) chars))) - (if (null? rest) - '() - (cdr rest)))) - (define (line-helper chars) - (if (null? chars) - "" - (let ((first (car-line chars)) - (rest (cdr-line chars))) - (string-append (list->string first) - (if (null? rest) "" replace-string) - (line-helper rest))))) - (line-helper (string->list string))) - (define (setup-query q owner account end-date) (let* ((guid (gncOwnerReturnGUID owner))) @@ -464,13 +446,15 @@ 'attribute (list "border" 0) 'attribute (list "cellspacing" 0) 'attribute (list "cellpadding" 0)) + (gnc:html-table-append-row! table - (list - (string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "
"))) + (list (gnc:multiline-to-html-text + (gnc:owner-get-name-and-address-dep owner)))) + (gnc:html-table-append-row! - table - (list "
")) + table (gnc:make-html-text (gnc:html-markup-br))) + (gnc:html-table-set-last-row-style! table "td" 'attribute (list "valign" "top")) @@ -507,10 +491,10 @@ 'attribute (list "cellspacing" 0) 'attribute (list "cellpadding" 0)) - (gnc:html-table-append-row! table (list (if name name ""))) - (gnc:html-table-append-row! table (list (string-expand - (if addy addy "") - #\newline "
"))) + (gnc:html-table-append-row! table (list (or name ""))) + + (gnc:html-table-append-row! table (list (gnc:multiline-to-html-text (or addy "")))) + (gnc:html-table-append-row! table (list (gnc-print-time64 (current-time) date-format))) table)) diff --git a/gnucash/report/business-reports/owner-report.scm b/gnucash/report/business-reports/owner-report.scm index 6c956d5df7..dbec875117 100644 --- a/gnucash/report/business-reports/owner-report.scm +++ b/gnucash/report/business-reports/owner-report.scm @@ -627,24 +627,6 @@ (define (employee-options-generator) (options-generator (list ACCT-TYPE-PAYABLE) GNC-OWNER-EMPLOYEE #t)) -(define (string-expand string character replace-string) - (define (car-line chars) - (take-while (lambda (c) (not (eqv? c character))) chars)) - (define (cdr-line chars) - (let ((rest (drop-while (lambda (c) (not (eqv? c character))) chars))) - (if (null? rest) - '() - (cdr rest)))) - (define (line-helper chars) - (if (null? chars) - "" - (let ((first (car-line chars)) - (rest (cdr-line chars))) - (string-append (list->string first) - (if (null? rest) "" replace-string) - (line-helper rest))))) - (line-helper (string->list string))) - (define (setup-query q owner account end-date) (let* ((guid (gncOwnerReturnGUID (gncOwnerGetEndOwner owner)))) @@ -675,16 +657,17 @@ 'attribute (list "border" 0) 'attribute (list "cellspacing" 0) 'attribute (list "cellpadding" 0)) + (gnc:html-table-append-row! - table - (list - (string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "
"))) + table (gnc:multiline-to-html-text (gnc:owner-get-name-and-address-dep owner))) + (gnc:html-table-append-row! - table - (list "
")) + table (gnc:make-html-text (gnc:html-markup-br))) + (gnc:html-table-set-last-row-style! table "td" 'attribute (list "valign" "top")) + table)) (define (make-date-row! table label date) @@ -718,12 +701,14 @@ 'attribute (list "cellspacing" 0) 'attribute (list "cellpadding" 0)) - (gnc:html-table-append-row! table (list (if name name ""))) - (gnc:html-table-append-row! table (list (string-expand - (if addy addy "") - #\newline "
"))) + (gnc:html-table-append-row! table (list (or name ""))) + + (gnc:html-table-append-row! + table (list (gnc:multiline-to-html-text (or addy "")))) + (gnc:html-table-append-row! table (list (gnc-print-time64 (gnc:get-today) date-format))) + table)) (define (make-break! document) From ab20071d828c6541cebb233954cd748b32b1f2ba Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Mon, 2 Dec 2019 08:26:01 +0800 Subject: [PATCH 16/19] [report-utilities] strify hash-table to Hash(kvp-list) Hash tables are strified to "Hash()" "Hash(key=value,...)" --- .../report/report-system/report-utilities.scm | 21 ++++++++++++------- .../test/test-report-utilities.scm | 10 +++++++++ 2 files changed, 24 insertions(+), 7 deletions(-) diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm index 75b5afb061..459609e9be 100644 --- a/gnucash/report/report-system/report-utilities.scm +++ b/gnucash/report/report-system/report-utilities.scm @@ -1259,6 +1259,18 @@ flawed. see report-utilities.scm. please update reports.") (gnc-lot-get-notes lot) (gnc-lot-get-balance lot) (gnc-lot-count-splits lot))) + (define (record->str rec) + (let ((rtd (record-type-descriptor rec))) + (define (fld->str fld) + (format #f "~a=~a" fld (gnc:strify ((record-accessor rtd fld) rec)))) + (format #f "Rec:~a{~a}" + (record-type-name rtd) + (string-join (map fld->str (record-type-fields rtd)) ", ")))) + (define (hash-table->str hash) + (string-append + "Hash(" (string-join + (hash-map->list (lambda (k v) (format #f "~a=~a" k v)) hash) ",") + ")")) (define (try proc) ;; Try proc with d as a parameter, catching exceptions to return ;; #f to the (or) evaluator below. @@ -1294,13 +1306,8 @@ flawed. see report-utilities.scm. please update reports.") (try owner->str) (try invoice->str) (try lot->str) - (and (record? d) - (let ((rtd (record-type-descriptor d))) - (define (fld->str fld) - (format #f "~a=~a" fld (gnc:strify ((record-accessor rtd fld) d)))) - (format #f "Rec:~a{~a}" - (record-type-name rtd) - (string-join (map fld->str (record-type-fields rtd)) ", ")))) + (try hash-table->str) + (try record->str) (object->string d))) (define (pair->num pair) diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm index b0f12da769..13921d47c9 100644 --- a/gnucash/report/report-system/test/test-report-utilities.scm +++ b/gnucash/report/report-system/test/test-report-utilities.scm @@ -152,6 +152,16 @@ (test-equal "gnc:strify " "coll<10>" (gnc:strify coll))) + + (let ((ht (make-hash-table))) + (test-equal "gnc:strify Hash()" + "Hash()" + (gnc:strify ht)) + (hash-set! ht 'one "uno") + (test-equal "gnc:strify Hash(one=uno)" + "Hash(one=uno)" + (gnc:strify ht))) + (test-end "debugging tools")) (define (test-commodity-collector) From 8bf54ebfc1c2da11bb1c16c41ed12d1e5ae2b2c8 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Mon, 2 Dec 2019 08:50:56 +0800 Subject: [PATCH 17/19] [html-acct-table] compact traverse-accounts! * convert for-each to named-let * allows reduction of set! calls --- .../report/report-system/html-acct-table.scm | 356 +++++++----------- 1 file changed, 144 insertions(+), 212 deletions(-) diff --git a/gnucash/report/report-system/html-acct-table.scm b/gnucash/report/report-system/html-acct-table.scm index 721330c87a..e8cf33e126 100644 --- a/gnucash/report/report-system/html-acct-table.scm +++ b/gnucash/report/report-system/html-acct-table.scm @@ -616,7 +616,6 @@ ) ;; the following function was adapted from html-utilities.scm - ;; ;; helper to calculate the balances for all required accounts (define (calculate-balances accts start-date end-date get-balance-fn) @@ -673,19 +672,18 @@ (define (traverse-accounts! accts acct-depth logi-depth new-balances) (define (use-acct? acct) - ;; BUG? when depth-limit is not integer but boolean? - (and (or (eq? limit-behavior 'flatten) + (and (or (eq? limit-behavior 'flatten) (< logi-depth depth-limit)) - (member acct accounts))) - - ;; helper function to return a cached balance from a list of + (member acct accounts))) + + ;; helper function to return a cached balance from a list of ;; ( acct . balance ) cells (define (get-balance acct-balances acct) - (let ((this-collector (gnc:make-commodity-collector)) + (let ((this-collector (gnc:make-commodity-collector)) (acct-coll (hash-ref acct-balances (gncAccountGetGUID acct) (gnc:make-commodity-collector)))) - (this-collector 'merge acct-coll #f) - this-collector)) + (this-collector 'merge acct-coll #f) + this-collector)) ;; helper function that returns a cached balance from a list of ;; ( acct . balance) cells for the given account *and* its @@ -696,217 +694,151 @@ (lambda (acct) (this-collector 'merge (get-balance acct-balances acct) #f)) (gnc:accounts-and-all-descendants (list account))) - this-collector)) + this-collector)) - (let ((disp-depth (if (integer? depth-limit) - (min (- depth-limit 1) logi-depth) - logi-depth)) - (row-added? #f)) - - (for-each - (lambda (acct) - (let* ((subaccts (gnc-account-get-children-sorted acct)) - ;; assign output parameters - (account acct) - (account-name (xaccAccountGetName acct)) - (account-code (xaccAccountGetCode acct)) - (account-path (gnc-account-get-full-name acct)) - (account-anchor (gnc:html-account-anchor acct)) - (account-parent (gnc-account-get-parent acct)) - (account-children subaccts) - (account-depth acct-depth) - (logical-depth logi-depth) - (account-commodity (xaccAccountGetCommodity acct)) - (account-type (xaccAccountGetType acct)) - ;; N.B.: xaccAccountGetTypeStr really should be - ;; called gnc:account-type-get-string - (account-type-string (xaccAccountGetTypeStr - (xaccAccountGetType acct))) - (account-guid (gncAccountGetGUID acct)) - (account-description (xaccAccountGetDescription acct)) - (account-notes (xaccAccountGetNotes acct)) - ;; These next two are commodity-collectors. - (account-bal (get-balance - new-balances acct)) - (recursive-bal (get-balance-sub - new-balances acct)) - ;; These next two are of type , right? - (report-comm-account-bal - (gnc:sum-collector-commodity - account-bal report-commodity exchange-fn)) - (report-comm-recursive-bal - (gnc:sum-collector-commodity - recursive-bal report-commodity exchange-fn)) - (grp-env - (append env - (list - (list 'initial-indent indent) - (list 'account account) - (list 'account-name account-name) - (list 'account-code account-code) - (list 'account-type account-type) - (list 'account-type-string account-type-string) - (list 'account-guid account-guid) - (list 'account-description account-description) - (list 'account-notes account-notes) - (list 'account-path account-path) - (list 'account-parent account-parent) - (list 'account-children account-children) - (list 'account-depth account-depth) - (list 'logical-depth logical-depth) - (list 'account-commodity account-commodity) - (list 'account-anchor account-anchor) - (list 'account-bal account-bal) - (list 'recursive-bal recursive-bal) - (list 'report-comm-account-bal - report-comm-account-bal) - (list 'report-comm-recursive-bal - report-comm-recursive-bal) - (list 'report-commodity report-commodity) - (list 'exchange-fn exchange-fn) - ))) - (row-env #f) - (label (case label-mode - ((anchor) account-anchor) - ((name) (gnc:make-html-text account-name)))) - (row #f) - (children-displayed? #f) - ) + (let lp ((accounts (if less-p (sort accts less-p) accts)) + (row-added? #f) + (disp-depth (if (integer? depth-limit) + (min (1- depth-limit) logi-depth) + logi-depth))) - (set! acct-depth-reached (max acct-depth-reached acct-depth)) - (set! logi-depth-reached (max logi-depth-reached logi-depth)) - (set! disp-depth-reached (max disp-depth-reached disp-depth)) + (cond - (or (not (use-acct? acct)) - ;; ok, so we'll consider parent accounts with zero - ;; recursive-bal to be zero balance leaf accounts - (and (gnc-commodity-collector-allzero? recursive-bal) - (or (not report-budget) - (gnc-numeric-zero-p - (gnc:budget-account-get-rolledup-net - report-budget account #f #f))) - (equal? zero-mode 'omit-leaf-acct)) - (begin - (set! row-env - (append grp-env - (list - (list 'account-label label) - (list 'row-type 'account-row) - (list 'display-depth disp-depth) - (list 'indented-depth - (+ disp-depth indent)) - ) - )) - (set! row (add-row row-env)) - ) - ) - ;; Recurse: - ;; Dive into an account even if it isn't selected! - ;; why? because some subaccts may be selected. - (set! children-displayed? - (traverse-accounts! subaccts - (+ acct-depth 1) - (if (use-acct? acct) - (+ logi-depth 1) - logi-depth) - new-balances)) + ((null? accounts) row-added?) - ;; record whether any children were displayed - (if row (append-to-row row (list (list 'children-displayed? children-displayed?)))) + (else + (let* ((acct (car accounts)) + (subaccts (gnc-account-get-children-sorted acct)) - ;; after the return from recursion: subtotals - (or (not (use-acct? acct)) - (not subtotal-mode) - ;; ditto that remark concerning zero recursive-bal... - (and (gnc-commodity-collector-allzero? recursive-bal) - (equal? zero-mode 'omit-leaf-acct)) - ;; ignore use-acct for subtotals...? - ;; (not (use-acct? acct)) - (not children-displayed?) - (let* ((lbl-txt (gnc:make-html-text (_ "Total") " "))) - (apply gnc:html-text-append! lbl-txt - (gnc:html-text-body label)) - (if (equal? subtotal-mode 'canonically-tabbed) - (set! disp-depth (+ disp-depth 1)) - (set! disp-depth-reached - (max disp-depth-reached disp-depth)) - ) - (set! row-env - (append grp-env - (list - (list 'account-label lbl-txt) - (list 'row-type 'subtotal-row) - (list 'display-depth disp-depth) - (list 'indented-depth - (+ disp-depth indent)) - ) - )) - (add-row row-env) - ) - ) - (if (or row-added? children-displayed? row) (set! row-added? #t)) - )) ;; end of (lambda (acct) ...) - ;; lambda is applied to each item in the (sorted) account list - (if less-p - (sort accts less-p) - accts) - ) ;; end of for-each - row-added? - ) - ) ;; end of definition of traverse-accounts! + ;; These next two are commodity-collectors. + (account-bal (get-balance new-balances acct)) + (recursive-bal (get-balance-sub new-balances acct)) + + ;; These next two are of type + (report-comm-account-bal + (gnc:sum-collector-commodity + account-bal report-commodity exchange-fn)) + (report-comm-recursive-bal + (gnc:sum-collector-commodity + recursive-bal report-commodity exchange-fn)) + + (grp-env + (cons* + (list 'initial-indent indent) + (list 'account acct) + (list 'account-name (xaccAccountGetName acct)) + (list 'account-code (xaccAccountGetCode acct)) + (list 'account-type (xaccAccountGetType acct)) + (list 'account-type-string (xaccAccountGetTypeStr + (xaccAccountGetType acct))) + (list 'account-guid (gncAccountGetGUID acct)) + (list 'account-description (xaccAccountGetDescription acct)) + (list 'account-notes (xaccAccountGetNotes acct)) + (list 'account-path (gnc-account-get-full-name acct)) + (list 'account-parent (gnc-account-get-parent acct)) + (list 'account-children subaccts) + (list 'account-depth acct-depth) + (list 'logical-depth logi-depth) + (list 'account-commodity (xaccAccountGetCommodity acct)) + (list 'account-anchor (gnc:html-account-anchor acct)) + (list 'account-bal account-bal) + (list 'recursive-bal recursive-bal) + (list 'report-comm-account-bal report-comm-account-bal) + (list 'report-comm-recursive-bal report-comm-recursive-bal) + (list 'report-commodity report-commodity) + (list 'exchange-fn exchange-fn) + env)) + (label (case label-mode + ((anchor) (gnc:html-account-anchor acct)) + ((name) (gnc:make-html-text (xaccAccountGetName acct))))) + (row #f) + (children-displayed? #f)) + + (set! acct-depth-reached (max acct-depth-reached acct-depth)) + (set! logi-depth-reached (max logi-depth-reached logi-depth)) + (set! disp-depth-reached (max disp-depth-reached disp-depth)) + + (unless (or (not (use-acct? acct)) + ;; ok, so we'll consider parent accounts with zero + ;; recursive-bal to be zero balance leaf accounts + (and (gnc-commodity-collector-allzero? recursive-bal) + (eq? zero-mode 'omit-leaf-acct) + (or (not report-budget) + (zero? (gnc:budget-account-get-rolledup-net + report-budget acct #f #f))))) + (set! row + (add-row + (cons* (list 'account-label label) + (list 'row-type 'account-row) + (list 'display-depth disp-depth) + (list 'indented-depth (+ disp-depth indent)) + grp-env)))) + + ;; Recurse: + ;; Dive into an account even if it isn't selected! + ;; why? because some subaccts may be selected. + (set! children-displayed? + (traverse-accounts! subaccts + (1+ acct-depth) + (if (use-acct? acct) + (1+ logi-depth) + logi-depth) + new-balances)) + + ;; record whether any children were displayed + (when row + (append-to-row + row (list (list 'children-displayed? children-displayed?)))) + + ;; after the return from recursion: subtotals + (unless (or (not (use-acct? acct)) + (not subtotal-mode) + (not children-displayed?) + (and (gnc-commodity-collector-allzero? recursive-bal) + (eq? zero-mode 'omit-leaf-acct))) + (let ((lbl-txt (gnc:make-html-text (_ "Total") " "))) + (apply gnc:html-text-append! lbl-txt (gnc:html-text-body label)) + (if (eq? subtotal-mode 'canonically-tabbed) + (set! disp-depth (+ disp-depth 1)) + (set! disp-depth-reached (max disp-depth-reached disp-depth))) + (add-row + (cons* (list 'account-label lbl-txt) + (list 'row-type 'subtotal-row) + (list 'display-depth disp-depth) + (list 'indented-depth (+ disp-depth indent)) + grp-env)))) + + (lp (cdr accounts) + (or row-added? children-displayed? row) + disp-depth)))))) ;; do it - (traverse-accounts! toplvl-accts 0 0 - (calculate-balances accounts start-date end-date get-balance-fn)) - + (traverse-accounts! + toplvl-accts 0 0 + (calculate-balances accounts start-date end-date get-balance-fn)) + ;; now set the account-colspan entries - ;; he he... (let ((x 0)) (while (< x 5) (display x) (set! x (+ x 1)))) - ;; now I know how to loop in scheme... yay! - (let ((row 0) - (rows (gnc:html-acct-table-num-rows acct-table))) - (while (< row rows) - (let* ((orig-env - (gnc:html-acct-table-get-row-env acct-table row)) - (display-depth (get-val orig-env 'display-depth)) - (depth-limit (get-val orig-env 'display-tree-depth)) - (indent (get-val orig-env 'initial-indent)) - (indented-depth (get-val orig-env 'indented-depth)) - (subtotal-mode - (get-val orig-env 'parent-account-subtotal-mode)) - (label-cols (+ disp-depth-reached 1)) - (logical-cols (if depth-limit - (min - (+ logi-depth-reached 1) - ;; BUG? when depth-limit is not integer? - depth-limit) - (+ logi-depth-reached 1))) - (colspan (- label-cols display-depth)) - ;; these parameters *should* always, by now, be set... - (new-env - (append - orig-env - (list - (list 'account-colspan colspan) - (list 'label-cols label-cols) - (list 'logical-cols logical-cols) - (list 'account-cols - (+ indent - (max label-cols - (if depth-limit depth-limit 0) - ) - ) - ) - ) - )) - ) - (gnc:html-acct-table-set-row-env! acct-table row new-env) - (set! row (+ row 1)))) - ) - - ;; done - - ) - ) + (let lp ((row 0) + (rows (gnc:html-acct-table-num-rows acct-table))) + (when (< row rows) + (let* ((orig-env (gnc:html-acct-table-get-row-env acct-table row)) + (display-depth (get-val orig-env 'display-depth)) + (depth-limit (get-val orig-env 'display-tree-depth)) + (indent (get-val orig-env 'initial-indent)) + (indented-depth (get-val orig-env 'indented-depth)) + (subtotal-mode (get-val orig-env 'parent-account-subtotal-mode)) + (label-cols (+ disp-depth-reached 1)) + ;; these parameters *should* always, by now, be set... + (new-env + (cons* + (list 'account-colspan (- label-cols display-depth)) + (list 'label-cols label-cols) + (list 'account-cols (+ indent (max label-cols (or depth-limit 0)))) + (list 'logical-cols (min (+ logi-depth-reached) + (or depth-limit +inf.0))) + orig-env))) + (gnc:html-acct-table-set-row-env! acct-table row new-env) + (lp (1+ row) rows)))))) (define (gnc:html-acct-table-num-rows acct-table) (gnc:html-table-num-rows (gnc:_html-acct-table-matrix_ acct-table))) From 7ad4c4afbdd50dec5751f93d5e25bea39c806e25 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Mon, 2 Dec 2019 18:19:28 +0800 Subject: [PATCH 18/19] [html-acct-table] compact gnc:html-acct-table-get-cell --- gnucash/report/report-system/html-acct-table.scm | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/gnucash/report/report-system/html-acct-table.scm b/gnucash/report/report-system/html-acct-table.scm index e8cf33e126..71f668b827 100644 --- a/gnucash/report/report-system/html-acct-table.scm +++ b/gnucash/report/report-system/html-acct-table.scm @@ -850,12 +850,9 @@ (define (gnc:html-acct-table-get-cell acct-table row col) ;; we'll only ever store one object in an html-table-cell ;; returns the first object stored in that cell - (let* ((cell (gnc:html-table-get-cell - (gnc:_html-acct-table-matrix_ acct-table) - row (+ col 1)))) - (and cell (car (gnc:html-table-cell-data cell))) - ) - ) + (and-let* ((cell (gnc:html-table-get-cell + (gnc:_html-acct-table-matrix_ acct-table) row (1+ col)))) + (car (gnc:html-table-cell-data cell)))) (define (gnc:html-acct-table-set-cell! acct-table row col obj) (gnc:html-table-set-cell! From 7833c59896b2d2705084732407277778ebb8ed85 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Mon, 2 Dec 2019 16:38:25 +0800 Subject: [PATCH 19/19] Bug 724219 - Customer Summary includes Closing Entries when reporting across the end of year --- gnucash/report/business-reports/customer-summary.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm index 1f05883df0..f2ed8f4deb 100644 --- a/gnucash/report/business-reports/customer-summary.scm +++ b/gnucash/report/business-reports/customer-summary.scm @@ -203,6 +203,7 @@ ;; guid QOF-QUERY-OR) (xaccQueryAddAccountMatch q account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND) (xaccQueryAddDateMatchTT q #t start-date #t end-date QOF-QUERY-AND) + (xaccQueryAddClosingTransMatch q #f QOF-QUERY-AND) (qof-query-set-book q (gnc-get-current-book)) (let ((result (qof-query-run q))) (qof-query-destroy q)