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)) - ) - ) - - ;; 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 - ) - ) + (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) - + (_ "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"