gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Sat Sep 21 08:35:54 EDT 2019
Updated via https://github.com/Gnucash/gnucash/commit/3a244681 (commit)
via https://github.com/Gnucash/gnucash/commit/67fa04ad (commit)
via https://github.com/Gnucash/gnucash/commit/594822f0 (commit)
from https://github.com/Gnucash/gnucash/commit/cda11dbd (commit)
commit 3a24468155b51b718cc34ed036194357f7c838c0
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Sep 21 13:23:30 2019 +0800
[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
diff --git a/gnucash/report/standard-reports/account-summary.scm b/gnucash/report/standard-reports/account-summary.scm
index bc6bb254d..dbc701bed 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)))
-
- (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))))
+ (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)))
+
+ (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
-
commit 67fa04adbda91f75bdea78cf5bd17246a1e2957b
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Sep 21 12:56:22 2019 +0800
[account-summary] *reindent/untabify/delete-trailing-whitespace*
diff --git a/gnucash/report/standard-reports/account-summary.scm b/gnucash/report/standard-reports/account-summary.scm
index f517ddc83..bc6bb254d 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"
commit 594822f04321e9f21201d50336aec0ed208fc157
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Sep 21 11:53:23 2019 +0800
[account-summary] merge in sx-summary.scm
* remove sx-summary.scm and merge into account-summary.scm
* modify test-account.scm
diff --git a/gnucash/report/standard-reports/CMakeLists.txt b/gnucash/report/standard-reports/CMakeLists.txt
index df87daf30..df41fc441 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 65416b0b7..f517ddc83 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 at 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 967df6a25..000000000
--- 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 <christian at cstimming.de>
-;; Copyright 2004 David Montenegro <sunrise2000 at comcast.net>
-;; Copyright 2001 Christian Stimming <stimming at tu-harburg.de>
-;; Copyright 2000-2001 Bill Gribble <grib at gnumatic.com>
-;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, contact:
-;;
-;; Free Software Foundation Voice: +1-617-542-5942
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; 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 e09e79e60..0144ef9e9 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 61f879b4f..709bb76bc 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
Summary of changes:
gnucash/report/standard-reports/CMakeLists.txt | 1 -
.../report/standard-reports/account-summary.scm | 562 ++++++++++-----------
gnucash/report/standard-reports/sx-summary.scm | 516 -------------------
.../standard-reports/test/test-account-summary.scm | 1 -
po/POTFILES.in | 1 -
5 files changed, 254 insertions(+), 827 deletions(-)
delete mode 100644 gnucash/report/standard-reports/sx-summary.scm
More information about the gnucash-changes
mailing list