mirror of
https://github.com/Gnucash/gnucash.git
synced 2024-11-30 20:54:08 -06:00
[cash-flow] *untabify/delete-trailing-whitespace/reindent*
This commit is contained in:
Christopher Lam
parent
d97d4930ba
commit
c6f5e6736b
@ -28,7 +28,7 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-module (gnucash report standard-reports cash-flow))
|
||||
(use-modules (gnucash utilities))
|
||||
(use-modules (gnucash utilities))
|
||||
(use-modules (gnucash gnc-module))
|
||||
(use-modules (gnucash gettext))
|
||||
(use-modules (gnucash engine))
|
||||
@ -61,7 +61,7 @@
|
||||
|
||||
;; date interval
|
||||
(gnc:options-add-date-interval!
|
||||
options gnc:pagename-general
|
||||
options gnc:pagename-general
|
||||
optname-from-date optname-to-date "a")
|
||||
|
||||
;; all about currencies
|
||||
@ -69,43 +69,43 @@
|
||||
options gnc:pagename-general
|
||||
optname-report-currency "b")
|
||||
|
||||
(gnc:options-add-price-source!
|
||||
(gnc:options-add-price-source!
|
||||
options gnc:pagename-general
|
||||
optname-price-source "c" 'pricedb-nearest)
|
||||
|
||||
(gnc:register-option
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-general optname-show-rates
|
||||
"d" (N_ "Show the exchange rates used.") #f))
|
||||
|
||||
(gnc:register-option
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-general optname-show-full-names
|
||||
"e" (N_ "Show full account names (including parent accounts).") #t))
|
||||
|
||||
;; accounts to work on
|
||||
(gnc:options-add-account-selection!
|
||||
(gnc:options-add-account-selection!
|
||||
options gnc:pagename-accounts
|
||||
optname-display-depth optname-show-subaccounts
|
||||
optname-accounts "a" 2
|
||||
(lambda ()
|
||||
(gnc:filter-accountlist-type
|
||||
(gnc:filter-accountlist-type
|
||||
(list ACCT-TYPE-BANK ACCT-TYPE-CASH ACCT-TYPE-ASSET
|
||||
ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL)
|
||||
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
|
||||
#f)
|
||||
|
||||
;; Trading accounts?
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-accounts optname-include-trading-accounts
|
||||
"b" (N_ "Include transfers to and from Trading Accounts in the report.") #f))
|
||||
|
||||
|
||||
;; Trading accounts?
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-accounts optname-include-trading-accounts
|
||||
"b" (N_ "Include transfers to and from Trading Accounts in the report.") #f))
|
||||
|
||||
;; Set the general page as default option tab
|
||||
(gnc:options-set-default-section options gnc:pagename-general)
|
||||
(gnc:options-set-default-section options gnc:pagename-general)
|
||||
|
||||
options))
|
||||
|
||||
@ -117,39 +117,39 @@
|
||||
(define (cash-flow-renderer report-obj)
|
||||
(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)
|
||||
|
||||
;; get all option's values
|
||||
(let* ((display-depth (get-option gnc:pagename-accounts
|
||||
(let* ((display-depth (get-option gnc:pagename-accounts
|
||||
optname-display-depth))
|
||||
(show-subaccts? (get-option gnc:pagename-accounts
|
||||
optname-show-subaccounts))
|
||||
(accounts (get-option gnc:pagename-accounts
|
||||
optname-accounts))
|
||||
(include-trading-accounts (get-option gnc:pagename-accounts
|
||||
optname-include-trading-accounts))
|
||||
optname-include-trading-accounts))
|
||||
(row-num 0)
|
||||
(work-done 0)
|
||||
(work-to-do 0)
|
||||
(work-done 0)
|
||||
(work-to-do 0)
|
||||
(report-currency (get-option gnc:pagename-general
|
||||
optname-report-currency))
|
||||
(price-source (get-option gnc:pagename-general
|
||||
optname-price-source))
|
||||
(show-rates? (get-option gnc:pagename-general
|
||||
(show-rates? (get-option gnc:pagename-general
|
||||
optname-show-rates))
|
||||
(show-full-names? (get-option gnc:pagename-general
|
||||
(show-full-names? (get-option gnc:pagename-general
|
||||
optname-show-full-names))
|
||||
(from-date-t64 (gnc:time64-start-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general
|
||||
optname-from-date))))
|
||||
(to-date-t64 (gnc:time64-end-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general
|
||||
optname-to-date))))
|
||||
(from-date-t64 (gnc:time64-start-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general
|
||||
optname-from-date))))
|
||||
(to-date-t64 (gnc:time64-end-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general
|
||||
optname-to-date))))
|
||||
|
||||
;; calculate the exchange rates
|
||||
(exchange-fn (gnc:case-exchange-fn
|
||||
@ -159,229 +159,217 @@
|
||||
(table (gnc:make-html-table))
|
||||
(txt (gnc:make-html-text)))
|
||||
|
||||
(gnc:html-document-set-title!
|
||||
(gnc:html-document-set-title!
|
||||
doc (string-append
|
||||
(get-option gnc:pagename-general gnc:optname-reportname)
|
||||
" - "
|
||||
(format #f (_ "~a to ~a")
|
||||
(qof-print-date from-date-t64) (qof-print-date to-date-t64))))
|
||||
(qof-print-date from-date-t64) (qof-print-date to-date-t64))))
|
||||
|
||||
|
||||
;; add subaccounts if requested
|
||||
(if show-subaccts?
|
||||
(let ((sub-accounts (gnc:acccounts-get-all-subaccounts accounts)))
|
||||
(for-each
|
||||
(lambda (sub-account)
|
||||
(if (not (account-in-list? sub-account accounts))
|
||||
(set! accounts (append accounts sub-accounts))))
|
||||
sub-accounts)))
|
||||
(lambda (sub-account)
|
||||
(if (not (account-in-list? sub-account accounts))
|
||||
(set! accounts (append accounts sub-accounts))))
|
||||
sub-accounts)))
|
||||
|
||||
|
||||
(if (not (null? accounts))
|
||||
|
||||
(let* ((tree-depth (if (equal? display-depth 'all)
|
||||
(accounts-get-children-depth accounts)
|
||||
(accounts-get-children-depth accounts)
|
||||
display-depth))
|
||||
|
||||
(money-diff-collector (gnc:make-commodity-collector))
|
||||
(account-disp-list '())
|
||||
(account-disp-list '())
|
||||
|
||||
(time-exchange-fn #f)
|
||||
(commodity-list (gnc:accounts-get-commodities
|
||||
accounts
|
||||
report-currency))
|
||||
;; Get an exchange function that will convert each transaction using the
|
||||
;; nearest available exchange rate if that is what is specified
|
||||
(time-exchange-fn (gnc:case-exchange-time-fn
|
||||
price-source report-currency
|
||||
commodity-list to-date-t64
|
||||
0 0)))
|
||||
(time-exchange-fn #f)
|
||||
(commodity-list (gnc:accounts-get-commodities
|
||||
accounts
|
||||
report-currency))
|
||||
;; Get an exchange function that will convert each transaction using the
|
||||
;; nearest available exchange rate if that is what is specified
|
||||
(time-exchange-fn (gnc:case-exchange-time-fn
|
||||
price-source report-currency
|
||||
commodity-list to-date-t64
|
||||
0 0)))
|
||||
|
||||
;; Helper function to convert currencies
|
||||
(define (to-report-currency currency amount date)
|
||||
(gnc:gnc-monetary-amount
|
||||
(time-exchange-fn (gnc:make-gnc-monetary currency amount)
|
||||
report-currency
|
||||
date)))
|
||||
;; Helper function to convert currencies
|
||||
(define (to-report-currency currency amount date)
|
||||
(gnc:gnc-monetary-amount
|
||||
(time-exchange-fn (gnc:make-gnc-monetary currency amount)
|
||||
report-currency
|
||||
date)))
|
||||
|
||||
|
||||
(let ((result (cash-flow-calc-money-in-out
|
||||
(list (cons 'accounts accounts)
|
||||
(cons 'to-date-t64 to-date-t64)
|
||||
(cons 'from-date-t64 from-date-t64)
|
||||
(cons 'report-currency report-currency)
|
||||
(cons 'include-trading-accounts include-trading-accounts)
|
||||
(cons 'to-report-currency to-report-currency)))))
|
||||
(let ((money-in-accounts (cdr (assq 'money-in-accounts result)))
|
||||
(money-in-alist (cdr (assq 'money-in-alist result)))
|
||||
(money-in-collector (cdr (assq 'money-in-collector result)))
|
||||
(money-out-accounts (cdr (assq 'money-out-accounts result)))
|
||||
(money-out-alist (cdr (assq 'money-out-alist result)))
|
||||
(money-out-collector (cdr (assq 'money-out-collector result))))
|
||||
(money-diff-collector 'merge money-in-collector #f)
|
||||
(money-diff-collector 'minusmerge money-out-collector #f)
|
||||
(list (cons 'accounts accounts)
|
||||
(cons 'to-date-t64 to-date-t64)
|
||||
(cons 'from-date-t64 from-date-t64)
|
||||
(cons 'report-currency report-currency)
|
||||
(cons 'include-trading-accounts include-trading-accounts)
|
||||
(cons 'to-report-currency to-report-currency)))))
|
||||
(let ((money-in-accounts (cdr (assq 'money-in-accounts result)))
|
||||
(money-in-alist (cdr (assq 'money-in-alist result)))
|
||||
(money-in-collector (cdr (assq 'money-in-collector result)))
|
||||
(money-out-accounts (cdr (assq 'money-out-accounts result)))
|
||||
(money-out-alist (cdr (assq 'money-out-alist result)))
|
||||
(money-out-collector (cdr (assq 'money-out-collector result))))
|
||||
(money-diff-collector 'merge money-in-collector #f)
|
||||
(money-diff-collector 'minusmerge money-out-collector #f)
|
||||
|
||||
(set! accounts (sort accounts account-full-name<?))
|
||||
(set! money-in-accounts (sort money-in-accounts account-full-name<?))
|
||||
(set! money-out-accounts (sort money-out-accounts account-full-name<?))
|
||||
(set! accounts (sort accounts account-full-name<?))
|
||||
(set! money-in-accounts (sort money-in-accounts account-full-name<?))
|
||||
(set! money-out-accounts (sort money-out-accounts account-full-name<?))
|
||||
|
||||
|
||||
(set! work-done 0)
|
||||
(set! work-to-do (length accounts))
|
||||
(for-each
|
||||
(lambda (account)
|
||||
(set! work-done (+ 1 work-done))
|
||||
(gnc:report-percent-done (+ 85 (* 5 (/ work-done work-to-do))))
|
||||
(if (<= (gnc-account-get-current-depth account) tree-depth)
|
||||
(let* ((anchor (gnc:html-markup/format
|
||||
(if (and (= (gnc-account-get-current-depth account) tree-depth)
|
||||
(not (eq? (gnc-account-get-children account) '())))
|
||||
(if show-subaccts?
|
||||
(_ "~a and subaccounts")
|
||||
(_ "~a and selected subaccounts"))
|
||||
"~a")
|
||||
(gnc:html-markup-anchor
|
||||
(gnc:account-anchor-text account)
|
||||
(if show-full-names?
|
||||
(gnc-account-get-full-name account)
|
||||
(xaccAccountGetName account))))))
|
||||
(set! work-done 0)
|
||||
(set! work-to-do (length accounts))
|
||||
(for-each
|
||||
(lambda (account)
|
||||
(set! work-done (+ 1 work-done))
|
||||
(gnc:report-percent-done (+ 85 (* 5 (/ work-done work-to-do))))
|
||||
(if (<= (gnc-account-get-current-depth account) tree-depth)
|
||||
(let* ((anchor (gnc:html-markup/format
|
||||
(if (and (= (gnc-account-get-current-depth account) tree-depth)
|
||||
(not (eq? (gnc-account-get-children account) '())))
|
||||
(if show-subaccts?
|
||||
(_ "~a and subaccounts")
|
||||
(_ "~a and selected subaccounts"))
|
||||
"~a")
|
||||
(gnc:html-markup-anchor
|
||||
(gnc:account-anchor-text account)
|
||||
(if show-full-names?
|
||||
(gnc-account-get-full-name account)
|
||||
(xaccAccountGetName account))))))
|
||||
|
||||
(set! account-disp-list (cons anchor account-disp-list))
|
||||
)
|
||||
)
|
||||
)
|
||||
accounts
|
||||
)
|
||||
(set! account-disp-list (cons anchor account-disp-list)))))
|
||||
accounts)
|
||||
|
||||
|
||||
(gnc:html-document-add-object!
|
||||
doc
|
||||
(gnc:make-html-text (_ "Selected Accounts")))
|
||||
(gnc:html-document-add-object!
|
||||
doc
|
||||
(gnc:make-html-text (_ "Selected Accounts")))
|
||||
|
||||
(gnc:html-document-add-object!
|
||||
doc
|
||||
(gnc:make-html-text
|
||||
(gnc:html-markup-ul
|
||||
(reverse account-disp-list))))
|
||||
(gnc:html-document-add-object!
|
||||
doc
|
||||
(gnc:make-html-text
|
||||
(gnc:html-markup-ul
|
||||
(reverse account-disp-list))))
|
||||
|
||||
(gnc:html-table-append-ruler! table 2)
|
||||
(gnc:html-table-append-ruler! table 2)
|
||||
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
"primary-subheading"
|
||||
(list
|
||||
(_ "Money into selected accounts comes from")
|
||||
""))
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
"primary-subheading"
|
||||
(list
|
||||
(_ "Money into selected accounts comes from")
|
||||
""))
|
||||
|
||||
(set! row-num 0)
|
||||
(set! work-done 0)
|
||||
(set! work-to-do (length money-in-alist))
|
||||
(for-each
|
||||
(lambda (account)
|
||||
(set! row-num (+ 1 row-num))
|
||||
(set! work-done (+ 1 work-done))
|
||||
(gnc:report-percent-done (+ 90 (* 5 (/ work-done work-to-do))))
|
||||
(let* ((pair (assoc account money-in-alist))
|
||||
(acct (car pair)))
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
(if (odd? row-num) "normal-row" "alternate-row")
|
||||
(list
|
||||
;(gnc:html-account-anchor acct)
|
||||
(gnc:make-html-text
|
||||
(gnc:html-markup-anchor
|
||||
(gnc:account-anchor-text acct)
|
||||
(if show-full-names?
|
||||
(gnc-account-get-full-name acct)
|
||||
(xaccAccountGetName acct))))
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"number-cell" (gnc:sum-collector-commodity (cadr pair) report-currency exchange-fn))))
|
||||
)
|
||||
)
|
||||
money-in-accounts
|
||||
)
|
||||
(set! row-num 0)
|
||||
(set! work-done 0)
|
||||
(set! work-to-do (length money-in-alist))
|
||||
(for-each
|
||||
(lambda (account)
|
||||
(set! row-num (+ 1 row-num))
|
||||
(set! work-done (+ 1 work-done))
|
||||
(gnc:report-percent-done (+ 90 (* 5 (/ work-done work-to-do))))
|
||||
(let* ((pair (assoc account money-in-alist))
|
||||
(acct (car pair)))
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
(if (odd? row-num) "normal-row" "alternate-row")
|
||||
(list
|
||||
;(gnc:html-account-anchor acct)
|
||||
(gnc:make-html-text
|
||||
(gnc:html-markup-anchor
|
||||
(gnc:account-anchor-text acct)
|
||||
(if show-full-names?
|
||||
(gnc-account-get-full-name acct)
|
||||
(xaccAccountGetName acct))))
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"number-cell" (gnc:sum-collector-commodity (cadr pair) report-currency exchange-fn))))))
|
||||
money-in-accounts)
|
||||
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
"grand-total"
|
||||
(list
|
||||
(gnc:make-html-table-header-cell/markup "text-cell" (_ "Money In"))
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"total-number-cell" (gnc:sum-collector-commodity money-in-collector report-currency exchange-fn))))
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
"grand-total"
|
||||
(list
|
||||
(gnc:make-html-table-header-cell/markup "text-cell" (_ "Money In"))
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"total-number-cell" (gnc:sum-collector-commodity money-in-collector report-currency exchange-fn))))
|
||||
|
||||
(gnc:html-table-append-ruler! table 2)
|
||||
(gnc:html-table-append-ruler! table 2)
|
||||
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
"primary-subheading"
|
||||
(list
|
||||
(_ "Money out of selected accounts goes to")
|
||||
""))
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
"primary-subheading"
|
||||
(list
|
||||
(_ "Money out of selected accounts goes to")
|
||||
""))
|
||||
|
||||
(set! row-num 0)
|
||||
(set! work-done 0)
|
||||
(set! work-to-do (length money-out-alist))
|
||||
(for-each
|
||||
(lambda (account)
|
||||
(set! row-num (+ 1 row-num))
|
||||
(set! work-done (+ 1 work-done))
|
||||
(gnc:report-percent-done (+ 95 (* 5 (/ work-done work-to-do))))
|
||||
(let* ((pair (assoc account money-out-alist))
|
||||
(acct (car pair)))
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
(if (odd? row-num) "normal-row" "alternate-row")
|
||||
(list
|
||||
;(gnc:html-account-anchor acct)
|
||||
(gnc:make-html-text
|
||||
(gnc:html-markup-anchor
|
||||
(gnc:account-anchor-text acct)
|
||||
(if show-full-names?
|
||||
(gnc-account-get-full-name acct)
|
||||
(xaccAccountGetName acct))))
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"number-cell" (gnc:sum-collector-commodity (cadr pair) report-currency exchange-fn))))
|
||||
)
|
||||
)
|
||||
money-out-accounts
|
||||
)
|
||||
(set! row-num 0)
|
||||
(set! work-done 0)
|
||||
(set! work-to-do (length money-out-alist))
|
||||
(for-each
|
||||
(lambda (account)
|
||||
(set! row-num (+ 1 row-num))
|
||||
(set! work-done (+ 1 work-done))
|
||||
(gnc:report-percent-done (+ 95 (* 5 (/ work-done work-to-do))))
|
||||
(let* ((pair (assoc account money-out-alist))
|
||||
(acct (car pair)))
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
(if (odd? row-num) "normal-row" "alternate-row")
|
||||
(list
|
||||
;(gnc:html-account-anchor acct)
|
||||
(gnc:make-html-text
|
||||
(gnc:html-markup-anchor
|
||||
(gnc:account-anchor-text acct)
|
||||
(if show-full-names?
|
||||
(gnc-account-get-full-name acct)
|
||||
(xaccAccountGetName acct))))
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"number-cell" (gnc:sum-collector-commodity (cadr pair) report-currency exchange-fn))))))
|
||||
money-out-accounts)
|
||||
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
"grand-total"
|
||||
(list
|
||||
(gnc:make-html-table-header-cell/markup "text-cell" (_ "Money Out"))
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"total-number-cell" (gnc:sum-collector-commodity money-out-collector report-currency exchange-fn))))
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
"grand-total"
|
||||
(list
|
||||
(gnc:make-html-table-header-cell/markup "text-cell" (_ "Money Out"))
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"total-number-cell" (gnc:sum-collector-commodity money-out-collector report-currency exchange-fn))))
|
||||
|
||||
(gnc:html-table-append-ruler! table 2)
|
||||
(gnc:html-table-append-ruler! table 2)
|
||||
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
"grand-total"
|
||||
(list
|
||||
(gnc:make-html-table-header-cell/markup "text-cell" (_ "Difference"))
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"total-number-cell" (gnc:sum-collector-commodity money-diff-collector report-currency exchange-fn))))
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
"grand-total"
|
||||
(list
|
||||
(gnc:make-html-table-header-cell/markup "text-cell" (_ "Difference"))
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"total-number-cell" (gnc:sum-collector-commodity money-diff-collector report-currency exchange-fn))))
|
||||
|
||||
(gnc:html-document-add-object! doc table)
|
||||
(gnc:html-document-add-object! doc table)
|
||||
|
||||
|
||||
;; add currency information
|
||||
(if show-rates?
|
||||
(gnc:html-document-add-object!
|
||||
doc ;;(gnc:html-markup-p
|
||||
(gnc:html-make-exchangerates
|
||||
report-currency exchange-fn accounts))))
|
||||
;; add currency information
|
||||
(if show-rates?
|
||||
(gnc:html-document-add-object!
|
||||
doc ;;(gnc:html-markup-p
|
||||
(gnc:html-make-exchangerates
|
||||
report-currency exchange-fn accounts))))))
|
||||
|
||||
))
|
||||
;; error condition: no accounts specified
|
||||
|
||||
;; error condition: no accounts specified
|
||||
|
||||
(gnc:html-document-add-object!
|
||||
doc
|
||||
(gnc:html-make-no-account-warning
|
||||
reportname (gnc:report-id report-obj))))
|
||||
(gnc:html-document-add-object!
|
||||
doc
|
||||
(gnc:html-make-no-account-warning
|
||||
reportname (gnc:report-id report-obj))))
|
||||
|
||||
(gnc:report-finished)
|
||||
doc))
|
||||
@ -390,134 +378,119 @@
|
||||
;; function to add inflow and outflow of money
|
||||
(define (cash-flow-calc-money-in-out settings)
|
||||
(let* ((accounts (cdr (assq 'accounts settings)))
|
||||
(to-date-t64 (cdr (assq 'to-date-t64 settings)))
|
||||
(from-date-t64 (cdr (assq 'from-date-t64 settings)))
|
||||
(report-currency (cdr (assq 'report-currency settings)))
|
||||
(include-trading-accounts (cdr (assq 'include-trading-accounts settings)))
|
||||
(to-report-currency (cdr (assq 'to-report-currency settings)))
|
||||
(to-date-t64 (cdr (assq 'to-date-t64 settings)))
|
||||
(from-date-t64 (cdr (assq 'from-date-t64 settings)))
|
||||
(report-currency (cdr (assq 'report-currency settings)))
|
||||
(include-trading-accounts (cdr (assq 'include-trading-accounts settings)))
|
||||
(to-report-currency (cdr (assq 'to-report-currency settings)))
|
||||
|
||||
(is-report-account? (account-in-list-pred accounts))
|
||||
(is-report-account? (account-in-list-pred accounts))
|
||||
|
||||
(money-in-accounts '())
|
||||
(money-in-hash (make-hash-table))
|
||||
(money-in-collector (gnc:make-commodity-collector))
|
||||
(money-in-accounts '())
|
||||
(money-in-hash (make-hash-table))
|
||||
(money-in-collector (gnc:make-commodity-collector))
|
||||
|
||||
(money-out-accounts '())
|
||||
(money-out-hash (make-hash-table))
|
||||
(money-out-collector (gnc:make-commodity-collector))
|
||||
(money-out-accounts '())
|
||||
(money-out-hash (make-hash-table))
|
||||
(money-out-collector (gnc:make-commodity-collector))
|
||||
|
||||
(all-splits (gnc:account-get-trans-type-splits-interval accounts '() from-date-t64 to-date-t64))
|
||||
(splits-to-do (length all-splits))
|
||||
(splits-seen-table (make-hash-table))
|
||||
(work-done 0))
|
||||
(all-splits (gnc:account-get-trans-type-splits-interval accounts '() from-date-t64 to-date-t64))
|
||||
(splits-to-do (length all-splits))
|
||||
(splits-seen-table (make-hash-table))
|
||||
(work-done 0))
|
||||
|
||||
(define (split-seen? split)
|
||||
(if (split-hashtable-ref splits-seen-table split) #t
|
||||
(begin
|
||||
(split-hashtable-set! splits-seen-table split #t)
|
||||
#f)))
|
||||
(begin
|
||||
(split-hashtable-set! splits-seen-table split #t)
|
||||
#f)))
|
||||
|
||||
(define (work-per-split split)
|
||||
(set! work-done (+ 1 work-done))
|
||||
(if (= (modulo work-done 100) 0)
|
||||
(gnc:report-percent-done (* 85 (/ work-done splits-to-do))))
|
||||
(gnc:report-percent-done (* 85 (/ work-done splits-to-do))))
|
||||
(let ((parent (xaccSplitGetParent split)))
|
||||
(if (and (<= (xaccTransGetDate parent) to-date-t64)
|
||||
(>= (xaccTransGetDate parent) from-date-t64))
|
||||
(let* ((parent-description (xaccTransGetDescription parent))
|
||||
(parent-currency (xaccTransGetCurrency parent)))
|
||||
(gnc:debug parent-description
|
||||
" - "
|
||||
(gnc-commodity-get-printname parent-currency))
|
||||
(for-each
|
||||
(lambda (s)
|
||||
(let* ((s-account (xaccSplitGetAccount s))
|
||||
(s-account-type (xaccAccountGetType s-account))
|
||||
(s-amount (xaccSplitGetAmount s))
|
||||
(s-value (xaccSplitGetValue s))
|
||||
(s-commodity (xaccAccountGetCommodity s-account)))
|
||||
;; Check if this is a dangling split
|
||||
;; and print a warning
|
||||
(if (null? s-account)
|
||||
(display
|
||||
(string-append
|
||||
"WARNING: s-account is NULL for split: "
|
||||
(gncSplitGetGUID s) "\n")))
|
||||
(gnc:debug (xaccAccountGetName s-account))
|
||||
(if (and ;; make sure we don't have
|
||||
(not (null? s-account)) ;; any dangling splits
|
||||
(or include-trading-accounts (not (eq? s-account-type ACCT-TYPE-TRADING)))
|
||||
(not (is-report-account? s-account)))
|
||||
(if (not (split-seen? s))
|
||||
(begin
|
||||
(if (gnc-numeric-negative-p s-value)
|
||||
(let ((s-account-in-collector (account-hashtable-ref money-in-hash s-account)))
|
||||
(if (and (<= (xaccTransGetDate parent) to-date-t64)
|
||||
(>= (xaccTransGetDate parent) from-date-t64))
|
||||
(let* ((parent-description (xaccTransGetDescription parent))
|
||||
(parent-currency (xaccTransGetCurrency parent)))
|
||||
(gnc:debug parent-description
|
||||
" - "
|
||||
(gnc-commodity-get-printname parent-currency))
|
||||
(for-each
|
||||
(lambda (s)
|
||||
(let* ((s-account (xaccSplitGetAccount s))
|
||||
(s-account-type (xaccAccountGetType s-account))
|
||||
(s-amount (xaccSplitGetAmount s))
|
||||
(s-value (xaccSplitGetValue s))
|
||||
(s-commodity (xaccAccountGetCommodity s-account)))
|
||||
;; Check if this is a dangling split
|
||||
;; and print a warning
|
||||
(if (null? s-account)
|
||||
(display
|
||||
(string-append
|
||||
"WARNING: s-account is NULL for split: "
|
||||
(gncSplitGetGUID s) "\n")))
|
||||
(gnc:debug (xaccAccountGetName s-account))
|
||||
(if (and ;; make sure we don't have
|
||||
(not (null? s-account)) ;; any dangling splits
|
||||
(or include-trading-accounts (not (eq? s-account-type ACCT-TYPE-TRADING)))
|
||||
(not (is-report-account? s-account)))
|
||||
(if (not (split-seen? s))
|
||||
(begin
|
||||
(if (gnc-numeric-negative-p s-value)
|
||||
(let ((s-account-in-collector (account-hashtable-ref money-in-hash s-account)))
|
||||
;(gnc:debug "in:" (gnc-commodity-get-printname s-commodity)
|
||||
; (gnc-numeric-to-double s-amount)
|
||||
; (gnc-commodity-get-printname parent-currency)
|
||||
; (gnc-numeric-to-double s-value))
|
||||
(if (not s-account-in-collector)
|
||||
(begin
|
||||
(set! s-account-in-collector (gnc:make-commodity-collector))
|
||||
(account-hashtable-set! money-in-hash s-account
|
||||
s-account-in-collector)
|
||||
(set! money-in-accounts (cons s-account money-in-accounts))
|
||||
)
|
||||
)
|
||||
(let ((s-report-value (to-report-currency parent-currency
|
||||
(gnc-numeric-neg s-value)
|
||||
(xaccTransGetDate
|
||||
parent))))
|
||||
(money-in-collector 'add report-currency s-report-value)
|
||||
(s-account-in-collector 'add report-currency s-report-value))
|
||||
)
|
||||
(let ((s-account-out-collector (account-hashtable-ref money-out-hash s-account)))
|
||||
;(gnc:debug "out:" (gnc-commodity-get-printname s-commodity)
|
||||
; (gnc-numeric-to-double s-amount)
|
||||
; (gnc-commodity-get-printname parent-currency)
|
||||
; (gnc-numeric-to-double s-value))
|
||||
(if (not s-account-out-collector)
|
||||
(begin
|
||||
(set! s-account-out-collector (gnc:make-commodity-collector))
|
||||
(account-hashtable-set! money-out-hash s-account
|
||||
s-account-out-collector)
|
||||
(set! money-out-accounts (cons s-account money-out-accounts))
|
||||
)
|
||||
)
|
||||
(let ((s-report-value (to-report-currency parent-currency
|
||||
s-value
|
||||
(xaccTransGetDate
|
||||
parent))))
|
||||
(money-out-collector 'add report-currency s-report-value)
|
||||
(s-account-out-collector 'add report-currency s-report-value))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(xaccTransGetSplitList parent)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
; (gnc-numeric-to-double s-amount)
|
||||
; (gnc-commodity-get-printname parent-currency)
|
||||
; (gnc-numeric-to-double s-value))
|
||||
(if (not s-account-in-collector)
|
||||
(begin
|
||||
(set! s-account-in-collector (gnc:make-commodity-collector))
|
||||
(account-hashtable-set! money-in-hash s-account
|
||||
s-account-in-collector)
|
||||
(set! money-in-accounts (cons s-account money-in-accounts))
|
||||
)
|
||||
)
|
||||
(let ((s-report-value (to-report-currency parent-currency
|
||||
(gnc-numeric-neg s-value)
|
||||
(xaccTransGetDate
|
||||
parent))))
|
||||
(money-in-collector 'add report-currency s-report-value)
|
||||
(s-account-in-collector 'add report-currency s-report-value))
|
||||
)
|
||||
(let ((s-account-out-collector (account-hashtable-ref money-out-hash s-account)))
|
||||
;(gnc:debug "out:" (gnc-commodity-get-printname s-commodity)
|
||||
; (gnc-numeric-to-double s-amount)
|
||||
; (gnc-commodity-get-printname parent-currency)
|
||||
; (gnc-numeric-to-double s-value))
|
||||
(if (not s-account-out-collector)
|
||||
(begin
|
||||
(set! s-account-out-collector (gnc:make-commodity-collector))
|
||||
(account-hashtable-set! money-out-hash s-account
|
||||
s-account-out-collector)
|
||||
(set! money-out-accounts (cons s-account money-out-accounts))
|
||||
)
|
||||
)
|
||||
(let ((s-report-value (to-report-currency parent-currency
|
||||
s-value
|
||||
(xaccTransGetDate
|
||||
parent))))
|
||||
(money-out-collector 'add report-currency s-report-value)
|
||||
(s-account-out-collector 'add report-currency s-report-value)))))))))
|
||||
(xaccTransGetSplitList parent))))))
|
||||
|
||||
(define (calc-money-in-out-internal accounts)
|
||||
(for-each work-per-split all-splits))
|
||||
(for-each work-per-split all-splits)
|
||||
|
||||
;; And calculate
|
||||
(calc-money-in-out-internal accounts)
|
||||
;; Return an association list of results
|
||||
(list (cons 'money-in-accounts money-in-accounts)
|
||||
(cons 'money-in-alist (hash-map->list (lambda (k v) (list k v)) money-in-hash))
|
||||
(cons 'money-in-collector money-in-collector)
|
||||
(cons 'money-out-accounts money-out-accounts)
|
||||
(cons 'money-out-alist (hash-map->list (lambda (k v) (list k v)) money-out-hash))
|
||||
(cons 'money-out-collector money-out-collector))))
|
||||
(cons 'money-in-alist (hash-map->list (lambda (k v) (list k v)) money-in-hash))
|
||||
(cons 'money-in-collector money-in-collector)
|
||||
(cons 'money-out-accounts money-out-accounts)
|
||||
(cons 'money-out-alist (hash-map->list (lambda (k v) (list k v)) money-out-hash))
|
||||
(cons 'money-out-collector money-out-collector))))
|
||||
|
||||
(gnc:define-report
|
||||
(gnc:define-report
|
||||
'version 1
|
||||
'name reportname
|
||||
'report-guid "f8748b813fab4220ba26e743aedf38da"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user