From 24393b6f5c31d55b939c9c3366b9f4848d484d54 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 21 Sep 2019 14:51:59 +0800 Subject: [PATCH 1/6] [utilities] fix comment use official gnu mail archive --- libgnucash/scm/utilities.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libgnucash/scm/utilities.scm b/libgnucash/scm/utilities.scm index 6665f1b97d..574097558e 100644 --- a/libgnucash/scm/utilities.scm +++ b/libgnucash/scm/utilities.scm @@ -174,7 +174,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; avoid using strftime, still broken in guile-2.2. see explanation at -;; https://www.mail-archive.com/bug-guile@gnu.org/msg09778.html +;; https://lists.gnu.org/archive/html/bug-guile/2019-05/msg00003.html ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (let ((strftime-old strftime)) (set! strftime From cda11dbd6f082c08a4cd6f6cc780d6511d9b8b1b Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 21 Sep 2019 18:20:05 +0800 Subject: [PATCH 2/6] [test-account-summary] initial commit --- .../standard-reports/test/CMakeLists.txt | 1 + .../test/test-account-summary.scm | 82 +++++++++++++++++++ 2 files changed, 83 insertions(+) create mode 100644 gnucash/report/standard-reports/test/test-account-summary.scm diff --git a/gnucash/report/standard-reports/test/CMakeLists.txt b/gnucash/report/standard-reports/test/CMakeLists.txt index 4b5994550c..97b09f68a0 100644 --- a/gnucash/report/standard-reports/test/CMakeLists.txt +++ b/gnucash/report/standard-reports/test/CMakeLists.txt @@ -9,6 +9,7 @@ set(scm_test_with_srfi64_SOURCES test-cashflow-barchart.scm test-charts.scm test-transaction.scm + test-account-summary.scm test-balsheet-pnl.scm test-income-gst.scm test-budget.scm diff --git a/gnucash/report/standard-reports/test/test-account-summary.scm b/gnucash/report/standard-reports/test/test-account-summary.scm new file mode 100644 index 0000000000..e09e79e609 --- /dev/null +++ b/gnucash/report/standard-reports/test/test-account-summary.scm @@ -0,0 +1,82 @@ +(use-modules (gnucash gnc-module)) +(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0)) +(use-modules (gnucash engine test test-extras)) +(use-modules (gnucash report standard-reports account-summary)) +(use-modules (gnucash report standard-reports sx-summary)) +(use-modules (gnucash report stylesheets)) +(use-modules (gnucash report report-system)) +(use-modules (gnucash report report-system test test-extras)) +(use-modules (srfi srfi-64)) +(use-modules (gnucash engine test srfi64-extras)) +(use-modules (sxml simple)) +(use-modules (sxml xpath)) + +(define accsum-uuid "3298541c236b494998b236dfad6ad752") +(define fsts-uuid "47f45d7d6d57b68518481c1fc8d4e4ba") + +;; Explicitly set locale to make the report output predictable +(setlocale LC_ALL "C") + +(define (run-test) + (test-runner-factory gnc:test-runner) + (test-setup) + (test-begin "accsum-and-fsts") + (accsum-tests) + (test-end "accsum-and-fsts")) + +(define (test-setup) + (define (mnemonic->commodity sym) + (gnc-commodity-table-lookup + (gnc-commodity-table-get-table (gnc-get-current-book)) + (gnc-commodity-get-namespace (gnc-default-report-currency)) + sym)) + (define GBP (mnemonic->commodity "GBP")) + (gnc-commodity-set-user-symbol GBP "#")) + +(define (options->sxml uuid options test-title) + (gnc:options->sxml uuid options "test-accsum" test-title)) + +(define (set-option! options section name value) + (let ((option (gnc:lookup-option options section name))) + (if option + (gnc:option-set-value option value) + (test-assert (format #f "wrong-option ~a ~a" section name) #f)))) + +(define (accsum-tests) + (let* ((account-alist (create-test-data)) + (income (assoc-ref "Income" account-alist))) + + (define (default-testing-options uuid) + (gnc:make-report-options uuid)) + + + (test-begin "account-summary") + (let* ((options (default-testing-options accsum-uuid)) + (sxml (options->sxml accsum-uuid options "accsum"))) + (test-equal "accsum col 1" + '("Code" "#608.00" "-#612.00" "#608.00" "-#612.00" "#608.00" "-#612.00") + (sxml->table-row-col sxml 1 #f 1)) + (test-equal "accsum col 2" + '("Account title" "Root" "Asset" "Bank" "GBP Bank" "Wallet" + "Liabilities" "Income" "Income-GBP" "Expenses" "Equity") + (sxml->table-row-col sxml 1 #f 2)) + (test-equal "accsum col 3" + '("$2,186.00" "#608.00" "$912.00" "$912.00" "$20.00" + "-$918.00" "$912.00" "-$918.00" "$912.00" "-$918.00") + (sxml->table-row-col sxml 1 #f 3))) + (test-end "account-summary") + + (test-begin "fsts") + (let* ((options (default-testing-options fsts-uuid)) + (sxml (options->sxml fsts-uuid options "fsts"))) + (test-equal "fsts col 1" + '("Code") + (sxml->table-row-col sxml 1 #f 1)) + (test-equal "fsts col 2" + '("Account title" "Root" "Asset" "Bank" "GBP Bank" "Wallet" + "Liabilities" "Income" "Income-GBP" "Expenses" "Equity") + (sxml->table-row-col sxml 1 #f 2)) + (test-equal "fsts col 3" + '("$0.00" "$0.00" "$0.00") + (sxml->table-row-col sxml 1 #f 3))) + (test-end "fsts"))) From 594822f04321e9f21201d50336aec0ed208fc157 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 21 Sep 2019 11:53:23 +0800 Subject: [PATCH 3/6] [account-summary] merge in sx-summary.scm * remove sx-summary.scm and merge into account-summary.scm * modify test-account.scm --- .../report/standard-reports/CMakeLists.txt | 1 - .../standard-reports/account-summary.scm | 90 ++- .../report/standard-reports/sx-summary.scm | 516 ------------------ .../test/test-account-summary.scm | 1 - po/POTFILES.in | 1 - 5 files changed, 65 insertions(+), 544 deletions(-) delete mode 100644 gnucash/report/standard-reports/sx-summary.scm diff --git a/gnucash/report/standard-reports/CMakeLists.txt b/gnucash/report/standard-reports/CMakeLists.txt index df87daf306..df41fc4417 100644 --- a/gnucash/report/standard-reports/CMakeLists.txt +++ b/gnucash/report/standard-reports/CMakeLists.txt @@ -30,7 +30,6 @@ set (standard_reports_SCHEME_2 price-scatter.scm reconcile-report.scm register.scm - sx-summary.scm transaction.scm trial-balance.scm ) diff --git a/gnucash/report/standard-reports/account-summary.scm b/gnucash/report/standard-reports/account-summary.scm index 65416b0b7a..f517ddc83a 100644 --- a/gnucash/report/standard-reports/account-summary.scm +++ b/gnucash/report/standard-reports/account-summary.scm @@ -48,6 +48,11 @@ ;; Boston, MA 02110-1301, USA gnu@gnu.org ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 2019: This report has merged in sx-summary.scm originally copied +;; from account-summary.scm. The amounts for the accounts are drawn +;; from the future Scheduled Transactions which will get realized in +;; the respective time periods. + (define-module (gnucash report standard-reports account-summary)) (use-modules (srfi srfi-1)) @@ -61,7 +66,8 @@ ;; optionally with clickable links to open the corresponding register ;; window. -(define reportname (N_ "Account Summary")) +(define accsum-reportname (N_ "Account Summary")) +(define fsts-reportname (N_ "Future Scheduled Transactions Summary")) (define optname-report-title (N_ "Report Title")) (define opthelp-report-title (N_ "Title for this report.")) @@ -69,6 +75,11 @@ (define optname-party-name (N_ "Company name")) (define opthelp-party-name (N_ "Name of company/individual.")) +;; fsts: +(define optname-from-date (N_ "Start Date")) +(define optname-to-date (N_ "End Date")) + +;; account-summary: (define optname-date (N_ "Date")) ;; FIXME this needs an indent option @@ -125,7 +136,7 @@ ;; options generator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (accsum-options-generator) +(define (accsum-options-generator sx? reportname) (let* ((options (gnc:new-options)) (add-option (lambda (new-option) @@ -143,8 +154,12 @@ ;; does anyone know the function to get the company name?? ;; date at which to report balance - (gnc:options-add-report-date! - options gnc:pagename-general optname-date "c") + (if sx? + (gnc:options-add-date-interval! + options gnc:pagename-general + optname-from-date optname-to-date "c") + (gnc:options-add-report-date! + options gnc:pagename-general optname-date "c")) ;; accounts to work on (add-option @@ -258,7 +273,7 @@ ;; set up the table and put it in an html document ;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (accsum-renderer report-obj) +(define (accsum-renderer report-obj sx? reportname) (define (get-option pagename optname) (gnc:option-value (gnc:lookup-option @@ -269,10 +284,17 @@ (let* ( (report-title (get-option gnc:pagename-general optname-report-title)) (company-name (get-option gnc:pagename-general optname-party-name)) - (report-date (gnc:time64-end-day-time - (gnc:date-option-absolute-time - (get-option gnc:pagename-general - optname-date)))) + (from-date (and sx? + (gnc:time64-start-day-time + (gnc:date-option-absolute-time + (get-option gnc:pagename-general + optname-from-date))))) + (to-date (gnc:time64-end-day-time + (gnc:date-option-absolute-time + (get-option gnc:pagename-general + (if sx? + optname-to-date + optname-date))))) (accounts (get-option gnc:pagename-accounts optname-accounts)) (depth-limit (get-option gnc:pagename-accounts @@ -321,13 +343,17 @@ depth-limit)) ;; exchange rates calculation parameters (exchange-fn - (gnc:case-exchange-fn price-source report-commodity report-date)) + (gnc:case-exchange-fn price-source report-commodity to-date)) ) (gnc:html-document-set-title! - doc (string-append company-name " " report-title " " - (qof-print-date report-date)) - ) + doc (if sx? + (format #f (string-append "~a ~a " (_ "For Period Covering ~a to ~a")) + company-name report-title + (qof-print-date from-date) + (qof-print-date to-date)) + (string-append company-name " " report-title " " + (qof-print-date to-date)))) (if (null? accounts) @@ -340,18 +366,17 @@ reportname (gnc:report-id report-obj))) ;; otherwise, generate the report... - (let* ( + (let* ((sx-value-hash + (if sx? + (gnc-sx-all-instantiate-cashflow-all from-date to-date) + (make-hash-table))) (chart-table #f) ;; gnc:html-acct-table (hold-table (gnc:make-html-table)) ;; temporary gnc:html-table (build-table (gnc:make-html-table)) ;; gnc:html-table reported - (get-total-balance-fn - (lambda (account) - (gnc:account-get-comm-balance-at-date - account report-date #f))) (table-env ;; parameters for :make- (list - (list 'start-date #f) - (list 'end-date report-date) + (list 'start-date from-date) + (list 'end-date to-date) (list 'display-tree-depth tree-depth) (list 'depth-limit-behavior bottom-behavior) (list 'report-commodity report-commodity) @@ -363,8 +388,16 @@ (list 'account-label-mode (if use-links? 'anchor 'name)) - ) - ) + (list 'get-balance-fn + (and sx? + (lambda (account start-date end-date) + (let* ((guid (gncAccountGetGUID account)) + (num (hash-ref sx-value-hash guid))) + (if num + (gnc:monetaries-add + (gnc:make-gnc-monetary + (xaccAccountGetCommodity account) num)) + (gnc:make-commodity-collector)))))))) (params ;; and -add-account- (list (list 'parent-account-balance-mode parent-balance-mode) @@ -506,10 +539,17 @@ (gnc:define-report 'version 1 - 'name reportname + 'name accsum-reportname 'report-guid "3298541c236b494998b236dfad6ad752" - 'options-generator accsum-options-generator - 'renderer accsum-renderer) + 'options-generator (lambda () (accsum-options-generator #f accsum-reportname)) + 'renderer (lambda (obj) (accsum-renderer obj #f accsum-reportname))) + +(gnc:define-report + 'version 1 + 'name fsts-reportname + 'report-guid "47f45d7d6d57b68518481c1fc8d4e4ba" + 'options-generator (lambda () (accsum-options-generator #t fsts-reportname)) + 'renderer (lambda (obj) (accsum-renderer obj #t fsts-reportname))) ;; END diff --git a/gnucash/report/standard-reports/sx-summary.scm b/gnucash/report/standard-reports/sx-summary.scm deleted file mode 100644 index 967df6a25c..0000000000 --- a/gnucash/report/standard-reports/sx-summary.scm +++ /dev/null @@ -1,516 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; sx-summary.scm : Scheduled Transaction future summary -;; -;; Copyright (C) 2010 Christian Stimming -;; Copyright 2004 David Montenegro -;; Copyright 2001 Christian Stimming -;; Copyright 2000-2001 Bill Gribble -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, contact: -;; -;; Free Software Foundation Voice: +1-617-542-5942 -;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 -;; Boston, MA 02110-1301, USA gnu@gnu.org -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; This report is based on account-summary.scm. Contrary to its -;; original version, the numbers for the accounts are not drawn from -;; their actual transactions, but instead from the future Scheduled -;; Transactions which will get realized in the respective time -;; periods. Apart from this, all display options are taken from -;; account-summary unchangedly. - -(define-module (gnucash report standard-reports sx-summary)) - -(use-modules (srfi srfi-1)) -(use-modules (gnucash utilities)) -(use-modules (gnucash gnc-module)) -(use-modules (gnucash gettext)) - -(gnc:module-load "gnucash/report/report-system" 0) - -(define reportname (N_ "Future Scheduled Transactions Summary")) - -(define optname-report-title (N_ "Report Title")) -(define opthelp-report-title (N_ "Title for this report.")) - -(define optname-party-name (N_ "Company name")) -(define opthelp-party-name (N_ "Name of company/individual.")) - -(define optname-from-date (N_ "Start Date")) -(define optname-to-date (N_ "End Date")) - -(define optname-accounts (N_ "Accounts")) -(define opthelp-accounts - (N_ "Report on these accounts, if display depth allows.")) -(define optname-depth-limit (N_ "Levels of Subaccounts")) -(define opthelp-depth-limit - (N_ "Maximum number of levels in the account tree displayed.")) -(define optname-bottom-behavior (N_ "Depth limit behavior")) -(define opthelp-bottom-behavior - (N_ "How to treat accounts which exceed the specified depth limit (if any).")) - -(define optname-parent-balance-mode (N_ "Parent account balances")) -(define optname-parent-total-mode (N_ "Parent account subtotals")) - -(define optname-show-zb-accts (N_ "Include accounts with zero total balances")) -(define opthelp-show-zb-accts - (N_ "Include accounts with zero total (recursive) balances in this report.")) -(define optname-omit-zb-bals (N_ "Omit zero balance figures")) -(define opthelp-omit-zb-bals - (N_ "Show blank space in place of any zero balances which would be shown.")) - -(define optname-use-rules (N_ "Show accounting-style rules")) -(define opthelp-use-rules - (N_ "Use rules beneath columns of added numbers like accountants do.")) - -(define optname-account-links (N_ "Display accounts as hyperlinks")) -(define opthelp-account-links (N_ "Shows each account in the table as a hyperlink to its register window.")) - -(define optname-show-account-bals (N_ "Account Balance")) -(define opthelp-show-account-bals (N_ "Show an account's balance.")) -(define optname-show-account-code (N_ "Account Code")) -(define opthelp-show-account-code (N_ "Show an account's account code.")) -(define optname-show-account-type (N_ "Account Type")) -(define opthelp-show-account-type (N_ "Show an account's account type.")) -(define optname-show-account-desc (N_ "Account Description")) -(define opthelp-show-account-desc (N_ "Show an account's description.")) -(define optname-show-account-notes (N_ "Account Notes")) -(define opthelp-show-account-notes (N_ "Show an account's notes.")) - -(define pagename-commodities (N_ "Commodities")) -(define optname-report-commodity (N_ "Report's currency")) -(define optname-price-source (N_ "Price Source")) -(define optname-show-foreign (N_ "Show Foreign Currencies")) -(define opthelp-show-foreign - (N_ "Display any foreign currency amount in an account.")) -(define optname-show-rates (N_ "Show Exchange Rates")) -(define opthelp-show-rates (N_ "Show the exchange rates used.")) - -;; FIXME: add more account metadata options! - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; options generator - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define (accsum-options-generator) - (let* ((options (gnc:new-options)) - (add-option - (lambda (new-option) - (gnc:register-option options new-option)))) - - (add-option - (gnc:make-string-option - gnc:pagename-general optname-report-title - "a" opthelp-report-title (_ reportname))) - (add-option - (gnc:make-string-option - gnc:pagename-general optname-party-name - "b" opthelp-party-name "")) - ;; this should default to company name in (gnc-get-current-book) - ;; does anyone know the function to get the company name?? - - ;; date interval - (gnc:options-add-date-interval! - options gnc:pagename-general - optname-from-date optname-to-date "c") - - ;; accounts to work on - (add-option - (gnc:make-account-list-option - gnc:pagename-accounts optname-accounts - "a" - opthelp-accounts - (lambda () - (gnc:filter-accountlist-type - (list ACCT-TYPE-BANK ACCT-TYPE-CASH ACCT-TYPE-CREDIT - ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY - ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL ACCT-TYPE-CURRENCY - ACCT-TYPE-PAYABLE ACCT-TYPE-RECEIVABLE - ACCT-TYPE-EQUITY ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE) - (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))) - #f #t)) - (gnc:options-add-account-levels! - options gnc:pagename-accounts optname-depth-limit - "b" opthelp-depth-limit 3) - (add-option - (gnc:make-multichoice-option - gnc:pagename-accounts optname-bottom-behavior - "c" opthelp-bottom-behavior - 'summarize - (list (vector 'summarize - (N_ "Recursive Balance") - (N_ "Show the total balance, including balances in subaccounts, of any account at the depth limit.")) - (vector 'flatten - (N_ "Raise Accounts") - (N_ "Shows accounts deeper than the depth limit at the depth limit.")) - (vector 'truncate - (N_ "Omit Accounts") - (N_ "Disregard completely any accounts deeper than the depth limit.")) - ) - ) - ) - - ;; all about currencies - (gnc:options-add-currency! - options pagename-commodities - optname-report-commodity "a") - - (gnc:options-add-price-source! - options pagename-commodities - optname-price-source "b" 'pricedb-nearest) - - (add-option - (gnc:make-simple-boolean-option - pagename-commodities optname-show-foreign - "c" opthelp-show-foreign #t)) - - (add-option - (gnc:make-simple-boolean-option - pagename-commodities optname-show-rates - "d" opthelp-show-rates #f)) - - ;; what to show for zero-balance accounts - (add-option - (gnc:make-simple-boolean-option - gnc:pagename-display optname-show-zb-accts - "a" opthelp-show-zb-accts #t)) - (add-option - (gnc:make-simple-boolean-option - gnc:pagename-display optname-omit-zb-bals - "b" opthelp-omit-zb-bals #f)) - ;; what to show for non-leaf accounts - (gnc:options-add-subtotal-view! - options gnc:pagename-display - optname-parent-balance-mode optname-parent-total-mode - "c") - - ;; some detailed formatting options - (add-option - (gnc:make-simple-boolean-option - gnc:pagename-display optname-account-links - "e" opthelp-account-links #t)) - (add-option - (gnc:make-simple-boolean-option - gnc:pagename-display optname-use-rules - "f" opthelp-use-rules #f)) - - (add-option - (gnc:make-simple-boolean-option - gnc:pagename-display optname-show-account-bals - "g" opthelp-show-account-bals #t)) - (add-option - (gnc:make-simple-boolean-option - gnc:pagename-display optname-show-account-code - "h" opthelp-show-account-code #t)) - (add-option - (gnc:make-simple-boolean-option - gnc:pagename-display optname-show-account-desc - "i" opthelp-show-account-desc #f)) - (add-option - (gnc:make-simple-boolean-option - gnc:pagename-display optname-show-account-type - "j" opthelp-show-account-type #f)) - (add-option - (gnc:make-simple-boolean-option - gnc:pagename-display optname-show-account-notes - "k" opthelp-show-account-notes #f)) - - ;; Set the general page as default option tab - (gnc:options-set-default-section options gnc:pagename-display) - options)) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; accsum-renderer -;; set up the table and put it in an html document - ;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define (accsum-renderer report-obj) - (define (get-option pagename optname) - (gnc:option-value - (gnc:lookup-option - (gnc:report-options report-obj) pagename optname))) - - (gnc:report-starting reportname) - - (let* ( - (report-title (get-option gnc:pagename-general optname-report-title)) - (company-name (get-option gnc:pagename-general optname-party-name)) - (from-date (gnc:time64-start-day-time - (gnc:date-option-absolute-time - (get-option gnc:pagename-general - optname-from-date)))) - (to-date (gnc:time64-end-day-time - (gnc:date-option-absolute-time - (get-option gnc:pagename-general - optname-to-date)))) - (accounts (get-option gnc:pagename-accounts - optname-accounts)) - (depth-limit (get-option gnc:pagename-accounts - optname-depth-limit)) - (bottom-behavior (get-option gnc:pagename-accounts - optname-bottom-behavior)) - (report-commodity (get-option pagename-commodities - optname-report-commodity)) - (price-source (get-option pagename-commodities - optname-price-source)) - (show-fcur? (get-option pagename-commodities - optname-show-foreign)) - (show-rates? (get-option pagename-commodities - optname-show-rates)) - (parent-balance-mode (get-option gnc:pagename-display - optname-parent-balance-mode)) - (parent-total-mode - (assq-ref '((t . #t) (f . #f) (canonically-tabbed . canonically-tabbed)) - (get-option gnc:pagename-display - optname-parent-total-mode))) - (show-zb-accts? (get-option gnc:pagename-display - optname-show-zb-accts)) - (omit-zb-bals? (get-option gnc:pagename-display - optname-omit-zb-bals)) - (use-links? (get-option gnc:pagename-display - optname-account-links)) - (use-rules? (get-option gnc:pagename-display - optname-use-rules)) - (show-account-code? (get-option gnc:pagename-display - optname-show-account-code)) - (show-account-type? (get-option gnc:pagename-display - optname-show-account-type)) - (show-account-desc? (get-option gnc:pagename-display - optname-show-account-desc)) - (show-account-notes? (get-option gnc:pagename-display - optname-show-account-notes)) - (show-account-bals? (get-option gnc:pagename-display - optname-show-account-bals)) - (indent 0) - (tabbing #f) - - (doc (gnc:make-html-document)) - ;; just in case we need this information... - (tree-depth (if (equal? depth-limit 'all) - (gnc:get-current-account-tree-depth) - depth-limit)) - ;; exchange rates calculation parameters - (exchange-fn - (gnc:case-exchange-fn price-source report-commodity to-date)) - ) - - (gnc:html-document-set-title! - doc (format #f - (string-append "~a ~a " - (_ "For Period Covering ~a to ~a")) - company-name report-title - (qof-print-date from-date) - (qof-print-date to-date)) - ) - - (if (null? accounts) - - ;; error condition: no accounts specified - ;; is this *really* necessary?? i'd be fine with an all-zero - ;; account summary that would, technically, be correct.... - (gnc:html-document-add-object! - doc - (gnc:html-make-no-account-warning - reportname (gnc:report-id report-obj))) - - ;; otherwise, generate the report... - (let* ( - (sx-value-hash (gnc-sx-all-instantiate-cashflow-all from-date to-date)) - (chart-table #f) ;; gnc:html-acct-table - (hold-table (gnc:make-html-table)) ;; temporary gnc:html-table - (build-table (gnc:make-html-table)) ;; gnc:html-table reported - (table-env ;; parameters for :make- - (list - (list 'start-date from-date) - (list 'end-date to-date) - (list 'display-tree-depth tree-depth) - (list 'depth-limit-behavior bottom-behavior) - (list 'report-commodity report-commodity) - (list 'exchange-fn exchange-fn) - (list 'parent-account-subtotal-mode parent-total-mode) - (list 'zero-balance-mode (if show-zb-accts? - 'show-leaf-acct - 'omit-leaf-acct)) - (list 'account-label-mode (if use-links? - 'anchor - 'name)) - (list 'get-balance-fn - (lambda (account start-date end-date) - (let* ((balance-collector (gnc:make-commodity-collector)) - (guid (gncAccountGetGUID account)) - (num-bal (hash-ref sx-value-hash guid))) - (if num-bal - (if (eq? 0 (denominator num-bal)) - (gnc:warn "Oops, invalid gnc_numeric when looking up SX balance for account GUID " guid ": " num-bal) - (begin - (balance-collector - 'add - (xaccAccountGetCommodity account) - num-bal) - ;;(gnc:warn "Yay, we found SX balance for account GUID " guid) - )) - ;;(gnc:warn "No SX balance for account GUID " guid) - ) - balance-collector))) - ) - ) - (params ;; and -add-account- - (list - (list 'parent-account-balance-mode parent-balance-mode) - (list 'zero-balance-display-mode (if omit-zb-bals? - 'omit-balance - 'show-balance)) - (list 'multicommodity-mode (if show-fcur? 'table #f)) - (list 'rule-mode use-rules?) - ) - ) - - ;; FIXME: this filtering is trivial and could probably be - ;; greatly simplified (it just collects all selected - ;; accounts)... - (split-up-accounts (gnc:decompose-accountlist accounts)) - (all-accounts - (append (assoc-ref split-up-accounts ACCT-TYPE-INCOME) - (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE) - (assoc-ref split-up-accounts ACCT-TYPE-ASSET) - (assoc-ref split-up-accounts ACCT-TYPE-LIABILITY) - (assoc-ref split-up-accounts ACCT-TYPE-EQUITY) - )) - ;; (all-accounts (map (lambda (X) (cadr X)) split-up-accounts)) - ;; ^ will not do what we want - - (account-cols 0) - (table-rows 0) - (cur-col 0) - (foo #f) ;; a dummy variable for when i'm too lazy to type much - (add-col #f) ;; thunk to add a column to build-table - (hold-table-width 0) - ) - - (set! chart-table - (gnc:make-html-acct-table/env/accts - table-env all-accounts)) - (gnc:html-table-add-account-balances - hold-table chart-table params) - (set! table-rows (or (gnc:html-acct-table-num-rows chart-table) 0)) - (set! account-cols - (if (zero? table-rows) - 0 - (or (car (assoc-ref - (gnc:html-acct-table-get-row-env chart-table 0) - 'account-cols)) - 0) - ) - ) - - (set! add-col - (lambda(key) - (let ((row 0) - (row-env #f) - ) - (while (< row table-rows) - (set! row-env - (gnc:html-acct-table-get-row-env - chart-table row)) - (gnc:html-table-set-cell! - build-table (+ row 1) cur-col ;; +1 for headers - (car (assoc-ref row-env key)) - ) - (set! row (+ row 1)) - ) - ) - (set! cur-col (+ cur-col 1)) - ) - ) - - ;; place the column headers - (gnc:html-table-append-row! - build-table - (append - (if show-account-code? (list (_ "Code")) '()) - (if show-account-type? (list (_ "Type")) '()) - (if show-account-desc? (list (_ "Description")) '()) - (list (_ "Account title")) - ) - ) - ;; add any fields to be displayed before the account name - (if show-account-code? (add-col 'account-code)) - (if show-account-type? (add-col 'account-type-string)) - (if show-account-desc? (add-col 'account-description)) - - (set! hold-table-width - (if show-account-bals? - (gnc:html-table-num-columns hold-table) - account-cols - ) - ) - (if show-account-bals? - (gnc:html-table-set-cell/tag! - build-table 0 (+ cur-col account-cols) "number-header" - (_ "Balance")) - ) - (let ((row 0)) - (while (< row table-rows) - (gnc:html-table-set-row-markup! build-table (+ row 1) - (gnc:html-table-row-markup hold-table row)) - (let ((col 0)) - (while (< col hold-table-width) - (gnc:html-table-set-cell! - build-table (+ row 1) (+ cur-col col) - (gnc:html-table-get-cell hold-table row col) - ) - (set! col (+ col 1)) - ) - ) - (set! row (+ row 1)) - ) - ) - (set! cur-col (+ cur-col hold-table-width)) - (if show-account-notes? - (begin - (gnc:html-table-set-cell/tag! - build-table 0 cur-col "text-cell" - (_ "Notes")) - (add-col 'account-notes) - ) - ) - - (gnc:html-document-add-object! doc build-table) - - ;; add currency information - (if show-rates? - (gnc:html-document-add-object! - doc ;;(gnc:html-markup-p - (gnc:html-make-exchangerates - report-commodity exchange-fn - (append-map - (lambda (a) - (gnc-account-get-descendants-sorted a)) - accounts)))) - ) - ) - - (gnc:report-finished) - doc)) - -(gnc:define-report - 'version 1 - 'name reportname - 'report-guid "47f45d7d6d57b68518481c1fc8d4e4ba" - 'options-generator accsum-options-generator - 'renderer accsum-renderer) - -;; END - diff --git a/gnucash/report/standard-reports/test/test-account-summary.scm b/gnucash/report/standard-reports/test/test-account-summary.scm index e09e79e609..0144ef9e92 100644 --- a/gnucash/report/standard-reports/test/test-account-summary.scm +++ b/gnucash/report/standard-reports/test/test-account-summary.scm @@ -2,7 +2,6 @@ (gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0)) (use-modules (gnucash engine test test-extras)) (use-modules (gnucash report standard-reports account-summary)) -(use-modules (gnucash report standard-reports sx-summary)) (use-modules (gnucash report stylesheets)) (use-modules (gnucash report report-system)) (use-modules (gnucash report report-system test test-extras)) diff --git a/po/POTFILES.in b/po/POTFILES.in index 61f879b4f0..709bb76bca 100644 --- a/po/POTFILES.in +++ b/po/POTFILES.in @@ -490,7 +490,6 @@ gnucash/report/standard-reports/price-scatter.scm gnucash/report/standard-reports/reconcile-report.scm gnucash/report/standard-reports/register.scm gnucash/report/standard-reports/standard-reports.scm -gnucash/report/standard-reports/sx-summary.scm gnucash/report/standard-reports/transaction.scm gnucash/report/standard-reports/trial-balance.scm gnucash/report/stylesheets/gncmod-stylesheets.c From 67fa04adbda91f75bdea78cf5bd17246a1e2957b Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 21 Sep 2019 12:56:22 +0800 Subject: [PATCH 4/6] [account-summary] *reindent/untabify/delete-trailing-whitespace* --- .../standard-reports/account-summary.scm | 460 ++++++++---------- 1 file changed, 216 insertions(+), 244 deletions(-) diff --git a/gnucash/report/standard-reports/account-summary.scm b/gnucash/report/standard-reports/account-summary.scm index f517ddc83a..bc6bb254dc 100644 --- a/gnucash/report/standard-reports/account-summary.scm +++ b/gnucash/report/standard-reports/account-summary.scm @@ -56,7 +56,7 @@ (define-module (gnucash report standard-reports account-summary)) (use-modules (srfi srfi-1)) -(use-modules (gnucash utilities)) +(use-modules (gnucash utilities)) (use-modules (gnucash gnc-module)) (use-modules (gnucash gettext)) @@ -108,7 +108,8 @@ (N_ "Use rules beneath columns of added numbers like accountants do.")) (define optname-account-links (N_ "Display accounts as hyperlinks")) -(define opthelp-account-links (N_ "Shows each account in the table as a hyperlink to its register window.")) +(define opthelp-account-links + (N_ "Shows each account in the table as a hyperlink to its register window.")) (define optname-show-account-bals (N_ "Account Balance")) (define opthelp-show-account-bals (N_ "Show an account's balance.")) @@ -138,16 +139,16 @@ (define (accsum-options-generator sx? reportname) (let* ((options (gnc:new-options)) - (add-option + (add-option (lambda (new-option) (gnc:register-option options new-option)))) - + (add-option - (gnc:make-string-option + (gnc:make-string-option gnc:pagename-general optname-report-title "a" opthelp-report-title (_ reportname))) (add-option - (gnc:make-string-option + (gnc:make-string-option gnc:pagename-general optname-party-name "b" opthelp-party-name "")) ;; this should default to company name in (gnc-get-current-book) @@ -168,62 +169,59 @@ "a" opthelp-accounts (lambda () - (gnc:filter-accountlist-type + (gnc:filter-accountlist-type (list ACCT-TYPE-BANK ACCT-TYPE-CASH ACCT-TYPE-CREDIT ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL ACCT-TYPE-CURRENCY ACCT-TYPE-PAYABLE ACCT-TYPE-RECEIVABLE ACCT-TYPE-EQUITY ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE) - (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))) + (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))) #f #t)) - + (gnc:options-add-account-levels! options gnc:pagename-accounts optname-depth-limit "b" opthelp-depth-limit 3) - + (add-option (gnc:make-multichoice-option gnc:pagename-accounts optname-bottom-behavior - "c" opthelp-bottom-behavior - 'summarize - (list (vector 'summarize - (N_ "Recursive Balance") - (N_ "Show the total balance, including balances in subaccounts, of any account at the depth limit.")) - (vector 'flatten - (N_ "Raise Accounts") - (N_ "Shows accounts deeper than the depth limit at the depth limit.")) - (vector 'truncate - (N_ "Omit Accounts") - (N_ "Disregard completely any accounts deeper than the depth limit.")) - ) - ) - ) - + "c" opthelp-bottom-behavior 'summarize + (list + (vector 'summarize + (N_ "Recursive Balance") + (N_ "Show the total balance, including balances in subaccounts, of any account at the depth limit.")) + (vector 'flatten + (N_ "Raise Accounts") + (N_ "Shows accounts deeper than the depth limit at the depth limit.")) + (vector 'truncate + (N_ "Omit Accounts") + (N_ "Disregard completely any accounts deeper than the depth limit."))))) + ;; all about currencies (gnc:options-add-currency! options pagename-commodities optname-report-commodity "a") - - (gnc:options-add-price-source! + + (gnc:options-add-price-source! options pagename-commodities optname-price-source "b" 'pricedb-nearest) - - (add-option + + (add-option (gnc:make-simple-boolean-option - pagename-commodities optname-show-foreign + pagename-commodities optname-show-foreign "c" opthelp-show-foreign #t)) - - (add-option + + (add-option (gnc:make-simple-boolean-option pagename-commodities optname-show-rates "d" opthelp-show-rates #f)) - + ;; what to show for zero-balance accounts - (add-option + (add-option (gnc:make-simple-boolean-option gnc:pagename-display optname-show-zb-accts "a" opthelp-show-zb-accts #t)) - (add-option + (add-option (gnc:make-simple-boolean-option gnc:pagename-display optname-omit-zb-bals "b" opthelp-omit-zb-bals #f)) @@ -234,36 +232,36 @@ "c") ;; some detailed formatting options - (add-option + (add-option (gnc:make-simple-boolean-option gnc:pagename-display optname-account-links "e" opthelp-account-links #t)) - (add-option + (add-option (gnc:make-simple-boolean-option gnc:pagename-display optname-use-rules "f" opthelp-use-rules #f)) - - (add-option + + (add-option (gnc:make-simple-boolean-option gnc:pagename-display optname-show-account-bals "g" opthelp-show-account-bals #t)) - (add-option + (add-option (gnc:make-simple-boolean-option gnc:pagename-display optname-show-account-code "h" opthelp-show-account-code #t)) - (add-option + (add-option (gnc:make-simple-boolean-option gnc:pagename-display optname-show-account-desc "i" opthelp-show-account-desc #f)) - (add-option + (add-option (gnc:make-simple-boolean-option gnc:pagename-display optname-show-account-type "j" opthelp-show-account-type #f)) - (add-option + (add-option (gnc:make-simple-boolean-option gnc:pagename-display optname-show-account-notes "k" opthelp-show-account-notes #f)) - + ;; Set the general page as default option tab (gnc:options-set-default-section options gnc:pagename-display) options)) @@ -276,14 +274,14 @@ (define (accsum-renderer report-obj sx? reportname) (define (get-option pagename optname) (gnc:option-value - (gnc:lookup-option + (gnc:lookup-option (gnc:report-options report-obj) pagename optname))) - + (gnc:report-starting reportname) - + (let* ( - (report-title (get-option gnc:pagename-general optname-report-title)) - (company-name (get-option gnc:pagename-general optname-party-name)) + (report-title (get-option gnc:pagename-general optname-report-title)) + (company-name (get-option gnc:pagename-general optname-party-name)) (from-date (and sx? (gnc:time64-start-day-time (gnc:date-option-absolute-time @@ -297,12 +295,12 @@ optname-date))))) (accounts (get-option gnc:pagename-accounts optname-accounts)) - (depth-limit (get-option gnc:pagename-accounts - optname-depth-limit)) - (bottom-behavior (get-option gnc:pagename-accounts - optname-bottom-behavior)) + (depth-limit (get-option gnc:pagename-accounts + optname-depth-limit)) + (bottom-behavior (get-option gnc:pagename-accounts + optname-bottom-behavior)) (report-commodity (get-option pagename-commodities - optname-report-commodity)) + optname-report-commodity)) (price-source (get-option pagename-commodities optname-price-source)) (show-fcur? (get-option pagename-commodities @@ -310,85 +308,84 @@ (show-rates? (get-option pagename-commodities optname-show-rates)) (parent-balance-mode (get-option gnc:pagename-display - optname-parent-balance-mode)) + optname-parent-balance-mode)) (parent-total-mode - (assq-ref '((t . #t) (f . #f) (canonically-tabbed . canonically-tabbed)) - (get-option gnc:pagename-display - optname-parent-total-mode))) + (assq-ref '((t . #t) (f . #f) (canonically-tabbed . canonically-tabbed)) + (get-option gnc:pagename-display + optname-parent-total-mode))) (show-zb-accts? (get-option gnc:pagename-display - optname-show-zb-accts)) + optname-show-zb-accts)) (omit-zb-bals? (get-option gnc:pagename-display - optname-omit-zb-bals)) + optname-omit-zb-bals)) (use-links? (get-option gnc:pagename-display - optname-account-links)) + optname-account-links)) (use-rules? (get-option gnc:pagename-display - optname-use-rules)) + optname-use-rules)) (show-account-code? (get-option gnc:pagename-display - optname-show-account-code)) + optname-show-account-code)) (show-account-type? (get-option gnc:pagename-display - optname-show-account-type)) + optname-show-account-type)) (show-account-desc? (get-option gnc:pagename-display - optname-show-account-desc)) + optname-show-account-desc)) (show-account-notes? (get-option gnc:pagename-display - optname-show-account-notes)) + optname-show-account-notes)) (show-account-bals? (get-option gnc:pagename-display - optname-show-account-bals)) - (indent 0) - (tabbing #f) - + optname-show-account-bals)) + (indent 0) + (tabbing #f) + (doc (gnc:make-html-document)) - ;; just in case we need this information... + ;; just in case we need this information... (tree-depth (if (equal? depth-limit 'all) - (gnc:get-current-account-tree-depth) - depth-limit)) + (gnc:get-current-account-tree-depth) + depth-limit)) ;; exchange rates calculation parameters - (exchange-fn - (gnc:case-exchange-fn price-source report-commodity to-date)) - ) - - (gnc:html-document-set-title! - doc (if sx? - (format #f (string-append "~a ~a " (_ "For Period Covering ~a to ~a")) - company-name report-title - (qof-print-date from-date) - (qof-print-date to-date)) - (string-append company-name " " report-title " " - (qof-print-date to-date)))) - + (exchange-fn + (gnc:case-exchange-fn price-source report-commodity to-date))) + + (gnc:html-document-set-title! + doc (string-append + company-name " " report-title " " + (if sx? + (format #f (_ "For Period Covering ~a to ~a") + (qof-print-date from-date) + (qof-print-date to-date)) + (qof-print-date to-date)))) + (if (null? accounts) - - ;; error condition: no accounts specified - ;; is this *really* necessary?? i'd be fine with an all-zero - ;; account summary that would, technically, be correct.... - (gnc:html-document-add-object! - doc - (gnc:html-make-no-account-warning - reportname (gnc:report-id report-obj))) - - ;; otherwise, generate the report... - (let* ((sx-value-hash + + ;; error condition: no accounts specified + ;; is this *really* necessary?? i'd be fine with an all-zero + ;; account summary that would, technically, be correct.... + (gnc:html-document-add-object! + doc + (gnc:html-make-no-account-warning + reportname (gnc:report-id report-obj))) + + ;; otherwise, generate the report... + (let* ((sx-value-hash (if sx? (gnc-sx-all-instantiate-cashflow-all from-date to-date) (make-hash-table))) - (chart-table #f) ;; gnc:html-acct-table - (hold-table (gnc:make-html-table)) ;; temporary gnc:html-table - (build-table (gnc:make-html-table)) ;; gnc:html-table reported - (table-env ;; parameters for :make- - (list - (list 'start-date from-date) - (list 'end-date to-date) - (list 'display-tree-depth tree-depth) - (list 'depth-limit-behavior bottom-behavior) - (list 'report-commodity report-commodity) - (list 'exchange-fn exchange-fn) - (list 'parent-account-subtotal-mode parent-total-mode) - (list 'zero-balance-mode (if show-zb-accts? - 'show-leaf-acct - 'omit-leaf-acct)) - (list 'account-label-mode (if use-links? - 'anchor - 'name)) - (list 'get-balance-fn + (chart-table #f) ;; gnc:html-acct-table + (hold-table (gnc:make-html-table)) ;; temporary gnc:html-table + (build-table (gnc:make-html-table)) ;; gnc:html-table reported + (table-env ;; parameters for :make- + (list + (list 'start-date from-date) + (list 'end-date to-date) + (list 'display-tree-depth tree-depth) + (list 'depth-limit-behavior bottom-behavior) + (list 'report-commodity report-commodity) + (list 'exchange-fn exchange-fn) + (list 'parent-account-subtotal-mode parent-total-mode) + (list 'zero-balance-mode (if show-zb-accts? + 'show-leaf-acct + 'omit-leaf-acct)) + (list 'account-label-mode (if use-links? + 'anchor + 'name)) + (list 'get-balance-fn (and sx? (lambda (account start-date end-date) (let* ((guid (gncAccountGetGUID account)) @@ -398,146 +395,121 @@ (gnc:make-gnc-monetary (xaccAccountGetCommodity account) num)) (gnc:make-commodity-collector)))))))) - (params ;; and -add-account- - (list - (list 'parent-account-balance-mode parent-balance-mode) - (list 'zero-balance-display-mode (if omit-zb-bals? - 'omit-balance - 'show-balance)) - (list 'multicommodity-mode (if show-fcur? 'table #f)) - (list 'rule-mode use-rules?) - ) - ) - - ;; FIXME: this filtering is trivial and could probably be - ;; greatly simplified (it just collects all selected - ;; accounts)... - (split-up-accounts (gnc:decompose-accountlist accounts)) - (all-accounts - (append (assoc-ref split-up-accounts ACCT-TYPE-INCOME) - (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE) - (assoc-ref split-up-accounts ACCT-TYPE-ASSET) - (assoc-ref split-up-accounts ACCT-TYPE-LIABILITY) - (assoc-ref split-up-accounts ACCT-TYPE-EQUITY) - )) - ;; (all-accounts (map (lambda (X) (cadr X)) split-up-accounts)) - ;; ^ will not do what we want - - (account-cols 0) - (table-rows 0) - (cur-col 0) - (foo #f) ;; a dummy variable for when i'm too lazy to type much - (add-col #f) ;; thunk to add a column to build-table - (hold-table-width 0) - ) - - (set! chart-table - (gnc:make-html-acct-table/env/accts - table-env all-accounts)) - (gnc:html-table-add-account-balances - hold-table chart-table params) - (set! table-rows (or (gnc:html-acct-table-num-rows chart-table) 0)) - (set! account-cols - (if (zero? table-rows) - 0 - (or (car (assoc-ref - (gnc:html-acct-table-get-row-env chart-table 0) - 'account-cols)) - 0) - ) - ) - - (set! add-col - (lambda(key) - (let ((row 0) - (row-env #f) - ) - (while (< row table-rows) - (set! row-env - (gnc:html-acct-table-get-row-env - chart-table row)) - (gnc:html-table-set-cell! - build-table (+ row 1) cur-col ;; +1 for headers - (car (assoc-ref row-env key)) - ) - (set! row (+ row 1)) - ) - ) - (set! cur-col (+ cur-col 1)) - ) - ) + (params ;; and -add-account- + (list + (list 'parent-account-balance-mode parent-balance-mode) + (list 'zero-balance-display-mode (if omit-zb-bals? + 'omit-balance + 'show-balance)) + (list 'multicommodity-mode (if show-fcur? 'table #f)) + (list 'rule-mode use-rules?))) - ;; place the column headers - (gnc:html-table-append-row! - build-table - (append - (if show-account-code? (list (_ "Code")) '()) - (if show-account-type? (list (_ "Type")) '()) - (if show-account-desc? (list (_ "Description")) '()) - (list (_ "Account title")) - ) - ) - ;; add any fields to be displayed before the account name - (if show-account-code? (add-col 'account-code)) - (if show-account-type? (add-col 'account-type-string)) - (if show-account-desc? (add-col 'account-description)) - - (set! hold-table-width - (if show-account-bals? - (gnc:html-table-num-columns hold-table) - account-cols - ) - ) + ;; FIXME: this filtering is trivial and could probably be + ;; greatly simplified (it just collects all selected + ;; accounts)... + (split-up-accounts (gnc:decompose-accountlist accounts)) + (all-accounts + (append (assoc-ref split-up-accounts ACCT-TYPE-INCOME) + (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE) + (assoc-ref split-up-accounts ACCT-TYPE-ASSET) + (assoc-ref split-up-accounts ACCT-TYPE-LIABILITY) + (assoc-ref split-up-accounts ACCT-TYPE-EQUITY))) + ;; (all-accounts (map (lambda (X) (cadr X)) split-up-accounts)) + ;; ^ will not do what we want + + (account-cols 0) + (table-rows 0) + (cur-col 0) + (foo #f) ;; a dummy variable for when i'm too lazy to type much + (add-col #f) ;; thunk to add a column to build-table + (hold-table-width 0)) + + (set! chart-table + (gnc:make-html-acct-table/env/accts + table-env all-accounts)) + (gnc:html-table-add-account-balances + hold-table chart-table params) + (set! table-rows (or (gnc:html-acct-table-num-rows chart-table) 0)) + (set! account-cols + (if (zero? table-rows) + 0 + (or (car (assoc-ref + (gnc:html-acct-table-get-row-env chart-table 0) + 'account-cols)) + 0))) + + (set! add-col + (lambda(key) + (let ((row 0) + (row-env #f)) + (while (< row table-rows) + (set! row-env + (gnc:html-acct-table-get-row-env + chart-table row)) + (gnc:html-table-set-cell! + build-table (+ row 1) cur-col ;; +1 for headers + (car (assoc-ref row-env key))) + (set! row (+ row 1)))) + (set! cur-col (+ cur-col 1)))) + + ;; place the column headers + (gnc:html-table-append-row! + build-table + (append + (if show-account-code? (list (_ "Code")) '()) + (if show-account-type? (list (_ "Type")) '()) + (if show-account-desc? (list (_ "Description")) '()) + (list (_ "Account title")))) + ;; add any fields to be displayed before the account name + (if show-account-code? (add-col 'account-code)) + (if show-account-type? (add-col 'account-type-string)) + (if show-account-desc? (add-col 'account-description)) + + (set! hold-table-width + (if show-account-bals? + (gnc:html-table-num-columns hold-table) + account-cols)) (if show-account-bals? (gnc:html-table-set-cell/tag! build-table 0 (+ cur-col account-cols) "number-header" - (_ "Balance")) - ) - (let ((row 0)) - (while (< row table-rows) - (gnc:html-table-set-row-markup! build-table (+ row 1) - (gnc:html-table-row-markup hold-table row)) - (let ((col 0)) - (while (< col hold-table-width) - (gnc:html-table-set-cell! - build-table (+ row 1) (+ cur-col col) - (gnc:html-table-get-cell hold-table row col) - ) - (set! col (+ col 1)) - ) - ) - (set! row (+ row 1)) - ) - ) - (set! cur-col (+ cur-col hold-table-width)) - (if show-account-notes? - (begin - (gnc:html-table-set-cell/tag! - build-table 0 cur-col "text-cell" - (_ "Notes")) - (add-col 'account-notes) - ) - ) - - (gnc:html-document-add-object! doc build-table) - + (_ "Balance"))) + (let ((row 0)) + (while (< row table-rows) + (gnc:html-table-set-row-markup! + build-table (+ row 1) + (gnc:html-table-row-markup hold-table row)) + (let ((col 0)) + (while (< col hold-table-width) + (gnc:html-table-set-cell! + build-table (+ row 1) (+ cur-col col) + (gnc:html-table-get-cell hold-table row col)) + (set! col (+ col 1)))) + (set! row (+ row 1)))) + (set! cur-col (+ cur-col hold-table-width)) + (if show-account-notes? + (begin + (gnc:html-table-set-cell/tag! + build-table 0 cur-col "text-cell" + (_ "Notes")) + (add-col 'account-notes))) + + (gnc:html-document-add-object! doc build-table) + ;; add currency information (if show-rates? - (gnc:html-document-add-object! + (gnc:html-document-add-object! doc ;;(gnc:html-markup-p - (gnc:html-make-exchangerates - report-commodity exchange-fn + (gnc:html-make-exchangerates + report-commodity exchange-fn (append-map (lambda (a) - (gnc-account-get-descendants-sorted a)) - accounts)))) - ) - ) - + (gnc-account-get-descendants-sorted a)) + accounts)))))) + (gnc:report-finished) doc)) -(gnc:define-report +(gnc:define-report 'version 1 'name accsum-reportname 'report-guid "3298541c236b494998b236dfad6ad752" From 3a24468155b51b718cc34ed036194357f7c838c0 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 21 Sep 2019 13:23:30 +0800 Subject: [PATCH 5/6] [account-summary] cleanup * shorten identifier names * compact functions * use eq? as appropriate instead of equal? when comparing symbols * omit splitting up and recombining accounts * minimise use of set! and define vars in let* formals * instead of (if pred? (begin ...)) use (when pred? ...) * use efficient gnc:accounts-and-all-descendants --- .../standard-reports/account-summary.scm | 254 +++++++----------- 1 file changed, 94 insertions(+), 160 deletions(-) diff --git a/gnucash/report/standard-reports/account-summary.scm b/gnucash/report/standard-reports/account-summary.scm index bc6bb254dc..dbc701bedc 100644 --- a/gnucash/report/standard-reports/account-summary.scm +++ b/gnucash/report/standard-reports/account-summary.scm @@ -81,7 +81,6 @@ ;; account-summary: (define optname-date (N_ "Date")) -;; FIXME this needs an indent option (define optname-accounts (N_ "Accounts")) (define opthelp-accounts @@ -111,16 +110,16 @@ (define opthelp-account-links (N_ "Shows each account in the table as a hyperlink to its register window.")) -(define optname-show-account-bals (N_ "Account Balance")) -(define opthelp-show-account-bals (N_ "Show an account's balance.")) -(define optname-show-account-code (N_ "Account Code")) -(define opthelp-show-account-code (N_ "Show an account's account code.")) -(define optname-show-account-type (N_ "Account Type")) -(define opthelp-show-account-type (N_ "Show an account's account type.")) -(define optname-show-account-desc (N_ "Account Description")) -(define opthelp-show-account-desc (N_ "Show an account's description.")) -(define optname-show-account-notes (N_ "Account Notes")) -(define opthelp-show-account-notes (N_ "Show an account's notes.")) +(define optname-show-bals (N_ "Account Balance")) +(define opthelp-show-bals (N_ "Show an account's balance.")) +(define optname-show-code (N_ "Account Code")) +(define opthelp-show-code (N_ "Show an account's account code.")) +(define optname-show-type (N_ "Account Type")) +(define opthelp-show-type (N_ "Show an account's account type.")) +(define optname-show-desc (N_ "Account Description")) +(define opthelp-show-desc (N_ "Show an account's description.")) +(define optname-show-notes (N_ "Account Notes")) +(define opthelp-show-notes (N_ "Show an account's notes.")) (define pagename-commodities (N_ "Commodities")) (define optname-report-commodity (N_ "Report's currency")) @@ -243,24 +242,24 @@ (add-option (gnc:make-simple-boolean-option - gnc:pagename-display optname-show-account-bals - "g" opthelp-show-account-bals #t)) + gnc:pagename-display optname-show-bals + "g" opthelp-show-bals #t)) (add-option (gnc:make-simple-boolean-option - gnc:pagename-display optname-show-account-code - "h" opthelp-show-account-code #t)) + gnc:pagename-display optname-show-code + "h" opthelp-show-code #t)) (add-option (gnc:make-simple-boolean-option - gnc:pagename-display optname-show-account-desc - "i" opthelp-show-account-desc #f)) + gnc:pagename-display optname-show-desc + "i" opthelp-show-desc #f)) (add-option (gnc:make-simple-boolean-option - gnc:pagename-display optname-show-account-type - "j" opthelp-show-account-type #f)) + gnc:pagename-display optname-show-type + "j" opthelp-show-type #f)) (add-option (gnc:make-simple-boolean-option - gnc:pagename-display optname-show-account-notes - "k" opthelp-show-account-notes #f)) + gnc:pagename-display optname-show-notes + "k" opthelp-show-notes #f)) ;; Set the general page as default option tab (gnc:options-set-default-section options gnc:pagename-display) @@ -285,63 +284,39 @@ (from-date (and sx? (gnc:time64-start-day-time (gnc:date-option-absolute-time - (get-option gnc:pagename-general - optname-from-date))))) + (get-option gnc:pagename-general optname-from-date))))) (to-date (gnc:time64-end-day-time (gnc:date-option-absolute-time (get-option gnc:pagename-general - (if sx? - optname-to-date - optname-date))))) - (accounts (get-option gnc:pagename-accounts - optname-accounts)) - (depth-limit (get-option gnc:pagename-accounts - optname-depth-limit)) - (bottom-behavior (get-option gnc:pagename-accounts - optname-bottom-behavior)) - (report-commodity (get-option pagename-commodities - optname-report-commodity)) - (price-source (get-option pagename-commodities - optname-price-source)) - (show-fcur? (get-option pagename-commodities - optname-show-foreign)) - (show-rates? (get-option pagename-commodities - optname-show-rates)) - (parent-balance-mode (get-option gnc:pagename-display - optname-parent-balance-mode)) + (if sx? optname-to-date optname-date))))) + (accounts (get-option gnc:pagename-accounts optname-accounts)) + (depth-limit (get-option gnc:pagename-accounts optname-depth-limit)) + (bottom-behavior (get-option gnc:pagename-accounts optname-bottom-behavior)) + (report-commodity (get-option pagename-commodities optname-report-commodity)) + (price-source (get-option pagename-commodities optname-price-source)) + (show-fcur? (get-option pagename-commodities optname-show-foreign)) + (show-rates? (get-option pagename-commodities optname-show-rates)) + (parent-mode (get-option gnc:pagename-display optname-parent-balance-mode)) (parent-total-mode (assq-ref '((t . #t) (f . #f) (canonically-tabbed . canonically-tabbed)) - (get-option gnc:pagename-display - optname-parent-total-mode))) - (show-zb-accts? (get-option gnc:pagename-display - optname-show-zb-accts)) - (omit-zb-bals? (get-option gnc:pagename-display - optname-omit-zb-bals)) - (use-links? (get-option gnc:pagename-display - optname-account-links)) - (use-rules? (get-option gnc:pagename-display - optname-use-rules)) - (show-account-code? (get-option gnc:pagename-display - optname-show-account-code)) - (show-account-type? (get-option gnc:pagename-display - optname-show-account-type)) - (show-account-desc? (get-option gnc:pagename-display - optname-show-account-desc)) - (show-account-notes? (get-option gnc:pagename-display - optname-show-account-notes)) - (show-account-bals? (get-option gnc:pagename-display - optname-show-account-bals)) - (indent 0) - (tabbing #f) + (get-option gnc:pagename-display optname-parent-total-mode))) + (show-zb-accts? (get-option gnc:pagename-display optname-show-zb-accts)) + (omit-zb-bals? (get-option gnc:pagename-display optname-omit-zb-bals)) + (use-links? (get-option gnc:pagename-display optname-account-links)) + (use-rules? (get-option gnc:pagename-display optname-use-rules)) + (show-code? (get-option gnc:pagename-display optname-show-code)) + (show-type? (get-option gnc:pagename-display optname-show-type)) + (show-desc? (get-option gnc:pagename-display optname-show-desc)) + (show-notes? (get-option gnc:pagename-display optname-show-notes)) + (show-bals? (get-option gnc:pagename-display optname-show-bals)) (doc (gnc:make-html-document)) ;; just in case we need this information... - (tree-depth (if (equal? depth-limit 'all) + (tree-depth (if (eq? depth-limit 'all) (gnc:get-current-account-tree-depth) depth-limit)) ;; exchange rates calculation parameters - (exchange-fn - (gnc:case-exchange-fn price-source report-commodity to-date))) + (exchange-fn (gnc:case-exchange-fn price-source report-commodity to-date))) (gnc:html-document-set-title! doc (string-append @@ -358,19 +333,14 @@ ;; is this *really* necessary?? i'd be fine with an all-zero ;; account summary that would, technically, be correct.... (gnc:html-document-add-object! - doc - (gnc:html-make-no-account-warning - reportname (gnc:report-id report-obj))) + doc (gnc:html-make-no-account-warning reportname (gnc:report-id report-obj))) ;; otherwise, generate the report... (let* ((sx-value-hash - (if sx? - (gnc-sx-all-instantiate-cashflow-all from-date to-date) - (make-hash-table))) - (chart-table #f) ;; gnc:html-acct-table + (and sx? (gnc-sx-all-instantiate-cashflow-all from-date to-date))) (hold-table (gnc:make-html-table)) ;; temporary gnc:html-table (build-table (gnc:make-html-table)) ;; gnc:html-table reported - (table-env ;; parameters for :make- + (table-env (list (list 'start-date from-date) (list 'end-date to-date) @@ -382,9 +352,7 @@ (list 'zero-balance-mode (if show-zb-accts? 'show-leaf-acct 'omit-leaf-acct)) - (list 'account-label-mode (if use-links? - 'anchor - 'name)) + (list 'account-label-mode (if use-links? 'anchor 'name)) (list 'get-balance-fn (and sx? (lambda (account start-date end-date) @@ -395,116 +363,83 @@ (gnc:make-gnc-monetary (xaccAccountGetCommodity account) num)) (gnc:make-commodity-collector)))))))) - (params ;; and -add-account- + (params (list - (list 'parent-account-balance-mode parent-balance-mode) + (list 'parent-account-balance-mode parent-mode) (list 'zero-balance-display-mode (if omit-zb-bals? 'omit-balance 'show-balance)) - (list 'multicommodity-mode (if show-fcur? 'table #f)) + (list 'multicommodity-mode (and show-fcur? 'table)) (list 'rule-mode use-rules?))) - ;; FIXME: this filtering is trivial and could probably be - ;; greatly simplified (it just collects all selected - ;; accounts)... - (split-up-accounts (gnc:decompose-accountlist accounts)) - (all-accounts - (append (assoc-ref split-up-accounts ACCT-TYPE-INCOME) - (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE) - (assoc-ref split-up-accounts ACCT-TYPE-ASSET) - (assoc-ref split-up-accounts ACCT-TYPE-LIABILITY) - (assoc-ref split-up-accounts ACCT-TYPE-EQUITY))) - ;; (all-accounts (map (lambda (X) (cadr X)) split-up-accounts)) - ;; ^ will not do what we want - - (account-cols 0) - (table-rows 0) (cur-col 0) - (foo #f) ;; a dummy variable for when i'm too lazy to type much - (add-col #f) ;; thunk to add a column to build-table + (chart-table (gnc:make-html-acct-table/env/accts table-env accounts)) + (table-rows (or (gnc:html-acct-table-num-rows chart-table) 0)) + (account-cols + (cond + ((zero? table-rows) 0) + ((assq-ref (gnc:html-acct-table-get-row-env chart-table 0) + 'account-cols) => car) + (else 0))) (hold-table-width 0)) - (set! chart-table - (gnc:make-html-acct-table/env/accts - table-env all-accounts)) - (gnc:html-table-add-account-balances - hold-table chart-table params) - (set! table-rows (or (gnc:html-acct-table-num-rows chart-table) 0)) - (set! account-cols - (if (zero? table-rows) - 0 - (or (car (assoc-ref - (gnc:html-acct-table-get-row-env chart-table 0) - 'account-cols)) - 0))) + (define (add-col key) + (let rowloop ((row 0)) + (when (< row table-rows) + (gnc:html-table-set-cell! + build-table (1+ row) cur-col + (car + (assq-ref (gnc:html-acct-table-get-row-env chart-table row) key))) + (rowloop (1+ row)))) + (set! cur-col (1+ cur-col))) - (set! add-col - (lambda(key) - (let ((row 0) - (row-env #f)) - (while (< row table-rows) - (set! row-env - (gnc:html-acct-table-get-row-env - chart-table row)) - (gnc:html-table-set-cell! - build-table (+ row 1) cur-col ;; +1 for headers - (car (assoc-ref row-env key))) - (set! row (+ row 1)))) - (set! cur-col (+ cur-col 1)))) + (gnc:html-table-add-account-balances hold-table chart-table params) ;; place the column headers (gnc:html-table-append-row! build-table (append - (if show-account-code? (list (_ "Code")) '()) - (if show-account-type? (list (_ "Type")) '()) - (if show-account-desc? (list (_ "Description")) '()) + (if show-code? (list (_ "Code")) '()) + (if show-type? (list (_ "Type")) '()) + (if show-desc? (list (_ "Description")) '()) (list (_ "Account title")))) ;; add any fields to be displayed before the account name - (if show-account-code? (add-col 'account-code)) - (if show-account-type? (add-col 'account-type-string)) - (if show-account-desc? (add-col 'account-description)) + (if show-code? (add-col 'account-code)) + (if show-type? (add-col 'account-type-string)) + (if show-desc? (add-col 'account-description)) (set! hold-table-width - (if show-account-bals? + (if show-bals? (gnc:html-table-num-columns hold-table) account-cols)) - (if show-account-bals? - (gnc:html-table-set-cell/tag! - build-table 0 (+ cur-col account-cols) "number-header" - (_ "Balance"))) - (let ((row 0)) - (while (< row table-rows) + (when show-bals? + (gnc:html-table-set-cell/tag! + build-table 0 (+ cur-col account-cols) "number-header" (_ "Balance"))) + (let rowloop ((row 0)) + (when (< row table-rows) (gnc:html-table-set-row-markup! - build-table (+ row 1) - (gnc:html-table-row-markup hold-table row)) - (let ((col 0)) - (while (< col hold-table-width) + build-table (1+ row) (gnc:html-table-row-markup hold-table row)) + (let colloop ((col 0)) + (when (< col hold-table-width) (gnc:html-table-set-cell! - build-table (+ row 1) (+ cur-col col) + build-table (1+ row) (+ cur-col col) (gnc:html-table-get-cell hold-table row col)) - (set! col (+ col 1)))) - (set! row (+ row 1)))) + (colloop (1+ col)))) + (rowloop (1+ row)))) (set! cur-col (+ cur-col hold-table-width)) - (if show-account-notes? - (begin - (gnc:html-table-set-cell/tag! - build-table 0 cur-col "text-cell" - (_ "Notes")) - (add-col 'account-notes))) + (when show-notes? + (gnc:html-table-set-cell/tag! + build-table 0 cur-col "text-cell" (_ "Notes")) + (add-col 'account-notes)) (gnc:html-document-add-object! doc build-table) ;; add currency information - (if show-rates? - (gnc:html-document-add-object! - doc ;;(gnc:html-markup-p - (gnc:html-make-exchangerates - report-commodity exchange-fn - (append-map - (lambda (a) - (gnc-account-get-descendants-sorted a)) - accounts)))))) + (when show-rates? + (gnc:html-document-add-object! + doc (gnc:html-make-exchangerates + report-commodity exchange-fn + (gnc:accounts-and-all-descendants accounts)))))) (gnc:report-finished) doc)) @@ -524,4 +459,3 @@ 'renderer (lambda (obj) (accsum-renderer obj #t fsts-reportname))) ;; END - From 1a6314e10867f9c42b617cee2ef3ed87e05a404b Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 21 Sep 2019 20:39:16 +0800 Subject: [PATCH 6/6] [account-summary] tag col headers properly to fix formatting With this commit the col headers are now properly formatted. Change tests because the tag is now th instead of td therefore sxml (looking for td) can't find them anymore. --- .../standard-reports/account-summary.scm | 19 +++++++++++-------- .../test/test-account-summary.scm | 8 ++++---- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/gnucash/report/standard-reports/account-summary.scm b/gnucash/report/standard-reports/account-summary.scm index dbc701bedc..83a08a50f8 100644 --- a/gnucash/report/standard-reports/account-summary.scm +++ b/gnucash/report/standard-reports/account-summary.scm @@ -278,8 +278,7 @@ (gnc:report-starting reportname) - (let* ( - (report-title (get-option gnc:pagename-general optname-report-title)) + (let* ((report-title (get-option gnc:pagename-general optname-report-title)) (company-name (get-option gnc:pagename-general optname-party-name)) (from-date (and sx? (gnc:time64-start-day-time @@ -393,16 +392,20 @@ (rowloop (1+ row)))) (set! cur-col (1+ cur-col))) + (define (make-header str) + (gnc:make-html-table-cell/markup "number-header" str)) + (gnc:html-table-add-account-balances hold-table chart-table params) ;; place the column headers (gnc:html-table-append-row! build-table - (append - (if show-code? (list (_ "Code")) '()) - (if show-type? (list (_ "Type")) '()) - (if show-desc? (list (_ "Description")) '()) - (list (_ "Account title")))) + (map make-header + (append + (if show-code? (list (_ "Code")) '()) + (if show-type? (list (_ "Type")) '()) + (if show-desc? (list (_ "Description")) '()) + (list (_ "Account title"))))) ;; add any fields to be displayed before the account name (if show-code? (add-col 'account-code)) (if show-type? (add-col 'account-type-string)) @@ -429,7 +432,7 @@ (set! cur-col (+ cur-col hold-table-width)) (when show-notes? (gnc:html-table-set-cell/tag! - build-table 0 cur-col "text-cell" (_ "Notes")) + build-table 0 cur-col "number-header" (_ "Notes")) (add-col 'account-notes)) (gnc:html-document-add-object! doc build-table) diff --git a/gnucash/report/standard-reports/test/test-account-summary.scm b/gnucash/report/standard-reports/test/test-account-summary.scm index 0144ef9e92..3d6b87ca10 100644 --- a/gnucash/report/standard-reports/test/test-account-summary.scm +++ b/gnucash/report/standard-reports/test/test-account-summary.scm @@ -53,10 +53,10 @@ (let* ((options (default-testing-options accsum-uuid)) (sxml (options->sxml accsum-uuid options "accsum"))) (test-equal "accsum col 1" - '("Code" "#608.00" "-#612.00" "#608.00" "-#612.00" "#608.00" "-#612.00") + '("#608.00" "-#612.00" "#608.00" "-#612.00" "#608.00" "-#612.00") (sxml->table-row-col sxml 1 #f 1)) (test-equal "accsum col 2" - '("Account title" "Root" "Asset" "Bank" "GBP Bank" "Wallet" + '("Root" "Asset" "Bank" "GBP Bank" "Wallet" "Liabilities" "Income" "Income-GBP" "Expenses" "Equity") (sxml->table-row-col sxml 1 #f 2)) (test-equal "accsum col 3" @@ -69,10 +69,10 @@ (let* ((options (default-testing-options fsts-uuid)) (sxml (options->sxml fsts-uuid options "fsts"))) (test-equal "fsts col 1" - '("Code") + '() (sxml->table-row-col sxml 1 #f 1)) (test-equal "fsts col 2" - '("Account title" "Root" "Asset" "Bank" "GBP Bank" "Wallet" + '("Root" "Asset" "Bank" "GBP Bank" "Wallet" "Liabilities" "Income" "Income-GBP" "Expenses" "Equity") (sxml->table-row-col sxml 1 #f 2)) (test-equal "fsts col 3"