Fwd: gnucash monthly report
merlin hughes
gnucash at merlin.org
Wed Mar 2 18:59:03 EST 2005
[subscribed+reposted...]
r/warlord at MIT.EDU/2005.02.26/15:30:20
>Hi, Merlin,
>
>Thank you very much for your submission.. I have a request,
>instead of a completely new report, could you modify the existing
>cash-flow report to add the 'summary-by-month' that you want?
>In fact, if you can make it "summary-by-<blank>" and let the
>time-period be filled in that would be even better.
I was hesitant to work on cash-flow because the changes
would be quite invasive. However, I've done as requested;
changes noted below..
>I'm making this request in order to keep the report code consolidated.
>You're welcome to make the two reports separate menu items, but the
>core code for the standard cash-flow report and your modified
>cash-flow report are close enough in behavior that I suspect you could
>reuse a great deal of the existing code.
There is a lot of crossover; cash-flow did some things
better than I.
>Another thing to keep inmind is internationalization... Granted, it
>would be relatively easy to change the "Salary" and "Escrow" strings
>into internationalized strings, but it would be even better to make
>them report options (with the internationalized default).
I've internationalized them, although I can't say that I
understand the distinction between (N_ "X") and (_ "X").
Changes:
. I had to rearrange a lot of the code to do what I wanted,
so there are a bunch of utility defines at the start
and then everything is much more broken out. My style
may stink; I don't know scheme. It strikes me that the
reports could do with another common utility file that
contains the code that a lot of them duplicate.
. I changed the definition of incoming and outgoing money
(see below). I can undo this if necessary.
. The layout has had to change slightly to cope with
multi-period reports.
. New option 'Report Period' which lets you generate
weekly/monthly/quarterly/yearly reports, in addition to
the standard single report over the entire period.
. New option 'Sort Accounts By' which lets you sort
accounts by the monetary amount in addition to their name.
. New option 'List Accounts Selected' which allows you
to suppress the listing of accounts at the top.
. New option 'Report Only Income and Expenses' which
toggles between strict cash flow and income vs expenses
(explained later).
. New tab 'Escrow Accounts', used only in income vs
expense mode (explained later).
. New tab 'Summary Accounts' which is a set of accounts
to summarize at the end of each period. Before and after
balance is listed, along with the % change and, for accounts
containing stocks and mutual funds, the % change discounting
contributions (e.g., so you can see how an underlying 401-K
is doing, ignoring contributions).
. New report titled 'Monthly Cash Flow' which is a monthly
instance of the report.
In the old code, incoming and outgoing splits were (if I
read the code right) identified as (excuse the pseudocode):
foreach split S
if S.account in accounts
foreach split S' in S.transaction.splits
if not S'.account in accounts
if S'.value < 0
incoming-split-p S'
else
outgoing-split-p S'
The problem with this is that I have:
Transaction[payroll]
Split[gross salary]: income: $12.00
Split[checking]: charge: $9.00
Split[fed tax]: charge: $2.00
Split[state tax]: charge: $1.00
Under the old logic this gets reported as incoming: 12,
outgoing: 1+2. The tax splits (which never touch a selected
account) get listed as cash flow, which doesn't seem right
to me.. Although I admit I have no idea of any formal meaning
of cash flow.
To fit this into my logic, I changed the algorithm to:
foreach split S
if S.account in accounts and not S.corr-account in accounts
if S.value > 0
incoming-split-p S
else if S.value < 0
outgoing-split-p S
My transaction above is now just reported as incoming: 9.
If this is horribly broken, I can try and resurrect the
original algorithm.
The alternative income vs expense mode uses the following
algorithm:
foreach split S
if S.account in accounts and S.corr-account.type = 'income
incoming-split-p S
if S.account.type = 'expense and S.corr-account in accounts
outgoing-split-p S
This algorithm ignores balance transfers among accounts,
and if you include your credit cards among the accounts, it
correctly categorizes how you spend your money, whether from
cash, checking account or credit cards, so you can accurately
see how much you spend on wine, women, song, how much goes on
credit card interest, etc. The distinction is somewhat subtle,
I just find that i vs e gives a better representation of what
an individual is spending day to day.
The escrow account handling is then added on top of the
income vs expense mode; this is useful for TransitChecks,
Flex Spending Accounts, Property Tax Escrow, etc: The report
considers income payments into escrow accounts as expenses, and
it ignores payments from these accounts. Thus, escrow payments
that are paid in regularly and withdrawn from sporadically look
like regular expenses which is easier to mentally reconcile.
For example, every month part of my mortgage payment is placed
in a property tax escrow account. Every quarter property tax
is paid out of this account. I'm kinda pedantic so I have
this account split out as an asset of mine, with monthly
transfers into it and quarterly expenses out of it. Ditto,
my FSA gets fed into monthly but I only get doctor bills
occasionally. Similarly, TransitCheck payments are made
monthly, but I only get and spend the cheques in bulk every
few months. In this report, I see regular monthly expenses
rather than sporadic large expenses.
I attach the revised cash-flow.scm. Changes are so invasive,
a diff is of no use.
merlin
>Great work so far,
>
>Thanks!
>
>-derek
-------------- next part --------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cash-flow.scm: cash flow report
;;
;; By Herbert Thoma <herbie at hthoma.de>
;;
;; Mutilated by Merlin Hughes <merlin AT merlin DOT org> Feb/Mar '05
;;
;; based on balance-sheet.scm by:
;; Robert Merkel <rgmerk at mira.net>
;; and pnl.scm by:
;; Christian Stimming <stimming at tu-harburg.de>
;;
;; 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
;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
;; Boston, MA 02111-1307, USA gnu at gnu.org
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash report cash-flow))
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
(use-modules (ice-9 slib))
(use-modules (gnucash gnc-module))
(load-from-path "substring-search.scm")
(require 'printf)
(require 'sort)
(gnc:module-load "gnucash/report/report-system" 0)
(gnc:module-load "gnucash/gnome-utils" 0) ;for gnc:html-build-url
(define reportname (N_ "Cash Flow"))
(define monthly-reportname (N_ "Monthly Cash Flow"))
;; define all option's names so that they are properly defined
;; in *one* place.
(define optname-from-date (N_ "From"))
(define optname-to-date (N_ "To"))
(define optname-display-depth (N_ "Account Display Depth"))
(define optname-show-subaccounts (N_ "Always show sub-accounts"))
(define optname-accounts (N_ "Account"))
(define optname-report-currency (N_ "Report's currency"))
(define optname-price-source (N_ "Price Source"))
(define optname-show-rates (N_ "Show Exchange Rates"))
(define optname-show-full-names (N_ "Show Full Account Names"))
(define optname-sort-accounts-by (N_ "Sort Accounts By"))
(define optname-list-accounts-selected (N_ "List Accounts Selected"))
(define optname-income-vs-expenses (N_ "Report Only Income and Expenses"))
(define optname-report-period (N_ "Report Period"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; utilities... need to be split out as they are replicated
;; in many places
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; percentage done accumulator/reporter
(define (percentage-reporter)
(define (reporter min max)
(let ((min-% min) (max-% max) (index 0) (count 100))
(define (pct val)
(+ min-% (/ (* (- max-% min-%) val) count)))
(define (do-inc amount)
(gnc:report-percent-done (pct index))
(set! index (+ index amount))
(if (> index count) (set! index count)))
(define (do-get amount) ; returns a reporter over [index:index+amount)
(let ((old index))
(do-inc amount)
(reporter (pct old) (pct index))))
(define (do-for-each proc items)
(set! count (length items))
(for-each (if (= 1 (car (procedure-property proc 'arity)))
(lambda (item) (do-inc 1) (proc item))
(lambda (item) (proc item (do-get 1)))) items))
(lambda (op . args)
(case op
('odd (odd? index)) ; ugly hack!
('set-count (set! count (car args)))
('for-each (do-for-each (car args) (cadr args)))
('inc (do-inc (if (null? args) 1 (car args))))
('get (do-get (if (null? args) 1 (car args))))))))
(reporter 0 100))
;; language macros
(define-macro when
(lambda (t . ee)
`(if ,t (begin , at ee))))
(define-macro unless
(lambda (t . ee)
`(if (not ,t) (begin , at ee))))
;; filtering utilities
(define (filter proc l)
(let ((head (list #t)))
(let loop ((cur l) (tail head))
(cond ((null? cur) (cdr head))
((proc (car cur)) (set-cdr! tail (list (car cur)))
(loop (cdr cur) (cdr tail)))
(else (loop (cdr cur) tail))))))
;(cond ((null? l) '())
; ((proc (car l)) (cons (car l) (filter proc (cdr l))))
; (else (filter proc (cdr l)))))
(define (filter-out proc l)
(filter (lambda (elt) (not (proc elt))) l))
;; split utilities
;; This only works properly for 1:1 transfers or a lookup from the n side of a 1:n
;; transfer (e.g., checking account salary deposit, finding the salary source
;; where the salary is split amoung taxes, insurance and the checking account).
;; In the case of a m:n transfer, it returns the largest source; this is useful
;; e.g., in the rare case where a salary payment includes a small transfer back
;; from a FSA account, which occurred to me on 01/21/2005, so there are two
;; fund sources in the transaction
(define (split-get-corr-account split)
(let* ((transaction (gnc:split-get-parent split))
(sign (numeric-sign (gnc:split-get-amount split))))
(let loop ((index 0)
(match (gnc:split-get-other-split split)) ; hack for $0.00 case
(match-amount (gnc:numeric-zero)))
(if (= index (gnc:transaction-get-split-count transaction))
(gnc:split-get-account match)
(let* ((other (gnc:transaction-get-split transaction index))
(other-amount (gnc:split-get-amount other))
(other-sign (numeric-sign other-amount)))
(if (or (= sign other-sign) (numeric-abs-<? other-amount match-amount))
(loop (1+ index) match match-amount)
(loop (1+ index) other other-amount)))))))
(define (get-interval-splits from to)
(let ((query (gnc:malloc-query)))
(gnc:query-set-book query (gnc:get-current-book))
(gnc:query-add-date-match-timepair query #t from #t to 'query-and)
(let ((splits (gnc:query-get-splits query)))
(gnc:free-query query)
splits)))
;; numeric utilities
(define (numeric-abs-<? a b)
(< (gnc:numeric-compare (gnc:numeric-abs a) (gnc:numeric-abs b)) 0))
(define (numeric-sign a)
(gnc:numeric-compare a (gnc:numeric-zero)))
(define (numeric>? a b)
(> (gnc:numeric-compare a b) 0))
(define (limit-digits x num)
(let ((chars (string->list (number->string x))))
(let loop ((c chars) (n -1))
(cond ((null? c) '())
((< n 0) (loop (cdr c) (if (eq? (car c) #\.) (1- num) n)))
((> n 0) (loop (cdr c) (1- n)))
(#t (set-cdr! c '()))))
(list->string chars)))
(define (percent-change from to)
(let* ((diff (gnc:numeric-sub-fixed to from))
(fraction (/ (gnc:numeric-to-double diff) (gnc:numeric-to-double from))))
(string-append (limit-digits (* fraction 100) 2) "%")))
;; account utilities
(define (same-account? a1 a2) ; (not? (does? (work? equal?)))
(string=? (gnc:account-get-guid a1) (gnc:account-get-guid a2)))
(define account-in-list?
(lambda (account accounts)
(cond
((null? accounts) #f)
((same-account? (car accounts) account) #t)
(else (account-in-list? account (cdr accounts))))))
(define account-in-alist
(lambda (account alist)
(cond
((null? alist) #f)
((same-account? (caar alist) account) (car alist))
(else (account-in-alist account (cdr alist))))))
;; helper for sorting of account list
(define (account-full-name<? a b)
(string<? (gnc:account-get-full-name a) (gnc:account-get-full-name b)))
;; helper for account depth
(define (account-get-depth account)
(let loop ((depth 0) (cur account))
(if cur
(loop (1+ depth) (gnc:account-get-parent-account cur))
depth)))
;(do ((depth 0 (1+ depth))
; (account account (gnc:account-get-parent-account account)))
; ((null? account) depth)))
;(define (account-get-depth-internal account-internal depth)
; (let ((parent (gnc:account-get-parent-account account-internal)))
; (if parent
; (account-get-depth-internal parent (+ depth 1))
; depth)))
;(account-get-depth-internal account 1))
(define (accounts-get-children-depth accounts)
(apply max
(map (lambda (acct)
(let ((children
(gnc:account-get-immediate-subaccounts acct)))
(if (null? children)
1
(+ 1 (accounts-get-children-depth children)))))
accounts)))
;; tree iteration and collection... certainly overkill, but wtf?
(define (apply-to-account-group* proc group)
(do ((index 0 (1+ index)))
((>= index (gnc:group-get-num-accounts group)))
(apply-to-account* proc (gnc:group-get-account group index))))
;(let loop ((index 0))
; (if (< index (gnc:group-get-num-accounts group))
; (begin (apply-to-account* proc (gnc:group-get-account group index))
; (loop (1+ index)))))))
(define (apply-to-account* proc account)
(if (proc account)
(apply-to-account-group* proc (gnc:account-get-children account))))
(define (apply-to-all-accounts proc)
(apply-to-account-group* proc (gnc:get-current-group)))
(define (account-get-type-sym account)
(gw:enum-<gnc:AccountType>-val->sym (gnc:account-get-type account) #f))
(define (tree-collect tree-iterator tester)
(let* ((head (list #t)) (tail head))
(define (collector item)
(let ((result (tester item)))
(when (memv result '(add add-and-descend))
(set-cdr! tail (list item))
(set! tail (cdr tail)))
(memv result '(descend add-and-descend))))
(tree-iterator collector)
(cdr head)))
(define (applicator root)
(lambda (proc)
(if root (apply-to-account* proc root) (apply-to-all-accounts proc))))
(define (collect-accounts-by-type type-or-types . root)
(let ((type-test (if (symbol? type-or-types) eqv? memv)))
(define (tester account)
(if (type-test (account-get-type-sym account) type-or-types) 'add-and-descend 'descend))
(tree-collect (applicator (and (not (null? root)) (car root))) tester)))
(define (collect-accounts root) ; all accounts descendant-or-self
(tree-collect (applicator root) (lambda (account) 'add-and-descend)))
;; options utils
(define pagename-escrow-accounts (N_ "Escrow Accounts"))
(define optname-escrow-accounts (N_ "Escrow Accounts"))
(define pagename-summary-accounts (N_ "Summary Accounts"))
(define optname-summary-accounts (N_ "Summary Accounts"))
(define optname-salary-accounts (N_ "Salary Accounts"))
(define search-for-Escrow (substring-search-maker (N_ "Escrow"))) ; TODO: FIXME: N_ vs _??
;; TODO: FIXME: salary is only used to identify contributions to investment
;; accounts => it's not really important => does it need to be promoted to
;; a full option??
(define search-for-Salary (substring-search-maker (N_ "Salary")))
;; All apex asset accounts with "Escrow" in name
(define (escrow-apex-test account)
(if (and (memv (account-get-type-sym account) '(bank cash asset))
(search-for-Escrow (gnc:account-get-name account)))
'add 'descend))
;; All apex income accounts with "Salary" in name
(define (salary-apex-test account)
(if (and (eqv? (account-get-type-sym account) 'income)
(search-for-Salary (gnc:account-get-name account)))
'add 'descend))
;; All apex bank/credit/liability/stock/mutual fund accounts
(define (summary-apex-test account)
(if (memv (account-get-type-sym account) '(bank credit liability stock mutual-fund))
'add 'descend))
;; options generator
(define (cash-flow-options-generator-impl monthly?)
(let ((options (gnc:new-options)))
;; date interval
(gnc:options-add-date-interval!
options gnc:pagename-general
optname-from-date optname-to-date "a")
(gnc:register-option
options
(gnc:make-multichoice-option
gnc:pagename-general optname-report-period
"b" (N_ "Report period") (if monthly? 'MonthDelta 'Whole)
(list (vector 'Whole (N_ "Whole")
(N_ "Generate one report over the whole period"))
(vector 'YearDelta (N_ "Yearly")
(N_ "Generate yearly reports"))
(vector 'QuarterDelta (N_ "Quarterly")
(N_ "Generate quarterly reports"))
(vector 'MonthDelta (N_ "Monthly")
(N_ "Generate monthly reports"))
(vector 'WeekDelta (N_ "Weekly")
(N_ "Generate weekly reports"))))) ; TwoWeekDelta HalfYearDelta ...
;; all about currencies
(gnc:options-add-currency!
options gnc:pagename-general
optname-report-currency "c")
(gnc:options-add-price-source!
options gnc:pagename-general
optname-price-source "d" (if monthly? 'pricedb-nearest 'weighted-average))
(gnc:register-option
options
(gnc:make-simple-boolean-option
gnc:pagename-general optname-show-rates
"e" (N_ "Show the exchange rates used") #f))
(gnc:register-option
options
(gnc:make-simple-boolean-option
gnc:pagename-general optname-show-full-names
"f" (N_ "Show full account names (including parent accounts)") (not monthly?)))
(gnc:register-option
options
(gnc:make-multichoice-option
gnc:pagename-general optname-sort-accounts-by
"g" (N_ "Sort accounts by") (if monthly? 'money 'name)
(list (vector 'name (N_ "Name")
(N_ "Sort accounts by name"))
(vector 'money (N_ "Amount")
(N_ "Sort accounts by monetary amount")))))
(gnc:register-option
options
(gnc:make-simple-boolean-option
gnc:pagename-general optname-list-accounts-selected
"h" (N_ "List selected accounts at head of report") (not monthly?)))
(gnc:register-option
options
(gnc:make-simple-boolean-option
gnc:pagename-general optname-income-vs-expenses
"i" (N_ "Only list income and expenses (i.e., ignore investments)") monthly?))
;; accounts to work on
(gnc:options-add-account-selection!
options gnc:pagename-accounts
optname-display-depth optname-show-subaccounts
optname-accounts "a" 2
(lambda ()
(collect-accounts-by-type
(if monthly?
'(bank cash credit liability)
'(bank cash asset stock mutual-fund))))
#f)
;; asset accounts to consider as expenses (only if income-vs-expenses)
(gnc:register-option
options
(gnc:make-account-list-option
pagename-escrow-accounts optname-escrow-accounts
"a"
(N_ "Escrow accounts to consider as expenses.")
(lambda ()
(let ((escrow-apices (tree-collect apply-to-all-accounts escrow-apex-test)))
(apply append (map collect-accounts escrow-apices))))
#f #t))
;; accounts to summarize
(gnc:register-option
options
(gnc:make-account-list-option
pagename-summary-accounts optname-summary-accounts
"a"
(N_ "Accounts to summarize.")
(lambda ()
(if monthly? (tree-collect apply-to-all-accounts summary-apex-test) '()))
#f #t))
;; salary accounts for ignoring investment contributions
(gnc:register-option
options
(gnc:make-account-list-option
pagename-summary-accounts optname-salary-accounts
"b"
(N_ "Salary accounts for identifying investment contributions.")
(lambda ()
(let ((salary-apices (tree-collect apply-to-all-accounts salary-apex-test)))
(apply append (map collect-accounts salary-apices))))
#f #t))
;; Set the general page as default option tab
(gnc:options-set-default-section options gnc:pagename-general)
options))
(define (cash-flow-options-generator)
(cash-flow-options-generator-impl #f))
(define (monthly-cash-flow-options-generator)
(cash-flow-options-generator-impl #t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cash-flow-renderer
;; set up the document and add the table
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (cash-flow-renderer-impl report-obj reportname)
(define (get-option pagename optname)
(gnc:option-value
(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 optname-display-depth))
(show-subaccts? (get-option gnc:pagename-accounts optname-show-subaccounts))
(accounts (get-option gnc:pagename-accounts optname-accounts))
(escrow-accounts (get-option pagename-escrow-accounts optname-escrow-accounts))
(summary-accounts (get-option pagename-summary-accounts optname-summary-accounts))
(salary-accounts (get-option pagename-summary-accounts optname-salary-accounts))
(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 optname-show-rates))
(show-full-names? (get-option gnc:pagename-general optname-show-full-names))
(report-delta (gnc:deltasym-to-delta (get-option gnc:pagename-general optname-report-period)))
(sort-accounts-by (get-option gnc:pagename-general optname-sort-accounts-by))
(list-accounts-selected? (get-option gnc:pagename-general optname-list-accounts-selected))
(income-vs-expenses? (get-option gnc:pagename-general optname-income-vs-expenses))
(from-date (gnc:date-option-absolute-time (get-option gnc:pagename-general optname-from-date)))
(to-date (gnc:date-option-absolute-time (get-option gnc:pagename-general optname-to-date)))
(doc (gnc:make-html-document))
(pct (percentage-reporter)))
(define (markup-account account)
(gnc:html-markup-anchor
(gnc:account-anchor-text account)
(if show-full-names?
(gnc:account-get-full-name account)
(gnc:account-get-name account))))
(define (report-accounts pct)
(if list-accounts-selected?
(let ((tree-depth (if (equal? display-depth 'all)
(accounts-get-children-depth accounts)
display-depth))
(account-disp-list '()))
(define (add-account account)
(if (<= (account-get-depth account) tree-depth)
(let* ((anchor (gnc:html-markup/format
(if (and (= (account-get-depth account) tree-depth)
(not (eq? (gnc:account-get-immediate-subaccounts account) '())))
(if show-subaccts?
(_ "%s and subaccounts")
(_ "%s and selected subaccounts"))
"%s")
(markup-account account))))
(set! account-disp-list (cons anchor account-disp-list)))))
(pct 'for-each add-account (sort accounts account-full-name<?))
(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)))))))
(define (report-periods pct)
(define (report-period interval pct)
(let* ((from (gnc:timepair-start-day-time (car interval)))
(to (gnc:timepair-end-day-time (cadr interval)))
(exchange-fn (gnc:case-exchange-fn price-source report-currency to))
(splits (get-interval-splits from to)))
(define (collector-sum collector)
(gnc:sum-collector-commodity collector report-currency exchange-fn))
(define (collector-amount collector)
(gnc:gnc-monetary-amount (collector-sum collector)))
(define (report-in-out pct)
(let ((incoming-money (list (gnc:make-commodity-collector)))
(outgoing-money (list (gnc:make-commodity-collector)))
(table (gnc:make-html-table)))
(define (accumulate-splits pct)
(define (accumulate-split split)
(let* ((transaction (gnc:split-get-parent split))
(currency (gnc:transaction-get-currency transaction))
(account (gnc:split-get-account split))
(tnuocca (split-get-corr-account split))
(value (gnc:split-get-value split))
;; TODO: this does not support the case of a transfer
;; from an account being split among a selection of
;; tnuoccas, some accounts, some not
(income?
(if income-vs-expenses?
(and (eqv? 'income (account-get-type-sym tnuocca))
(or (account-in-list? account accounts)
(account-in-list? account escrow-accounts)))
(and (account-in-list? account accounts)
(not (account-in-list? tnuocca accounts))
(= 1 (numeric-sign value)))))
(expense?
(if income-vs-expenses?
(or (and (account-in-list? account escrow-accounts) ; transfer to escrow account
(not (eqv? 'expense (account-get-type-sym tnuocca)))) ; not tax payment.. could be eqv? 'income
(and (eqv? 'expense (account-get-type-sym account)) ; expense
(account-in-list? tnuocca accounts) ; from current account
(not (account-in-list? tnuocca escrow-accounts)))) ; not from escrow
(and (account-in-list? account accounts)
(not (account-in-list? tnuocca accounts))
(= -1 (numeric-sign value))))))
(define (add-split split money in?)
(let* ((ac (if (and income-vs-expenses? (not in?)) account tnuocca))
(pair (account-in-alist ac (cdr money)))
(add (if (or in? income-vs-expenses?) value (gnc:numeric-neg value))))
(when (not pair)
(set! pair (cons ac (gnc:make-commodity-collector)))
(set-cdr! money (cons pair (cdr money))))
((car money) 'add currency add)
((cdr pair) 'add currency add)))
(when (and account tnuocca) ;; n.b. escrowed income is both in + out
(when income? (add-split split incoming-money #t))
(when expense? (add-split split outgoing-money #f)))))
(pct 'for-each accumulate-split splits))
(define (report-money money pct)
(define (report-pair pair)
(let ((account (car pair))
(collector (cdr pair)))
(gnc:html-table-append-row/markup!
table (if (pct 'odd) "normal-row" "alternate-row")
(list (gnc:make-html-text
(markup-account account))
(gnc:make-html-table-header-cell/markup
"number-cell" (collector-sum collector))))))
(define (pair-name<? a b)
(account-full-name<? (car a) (car b)))
(define (pair-money>? a b)
(numeric>? (collector-amount (cdr a)) (collector-amount (cdr b))))
(gnc:html-table-append-row/markup!
table "primary-subheading"
(list (_ (if (eq? money incoming-money)
(if income-vs-expenses? "Income" "Money into selected accounts comes from")
(if income-vs-expenses? "Expenses" "Money out of selected accounts goes to")))
""))
(pct 'for-each report-pair (sort (cdr money) (if (eqv? sort-accounts-by 'name) pair-name<? pair-money>?)))
(gnc:html-table-append-row/markup!
table "grand-total"
(list (_ (if (eq? money incoming-money) "Money In" "Money Out"))
(gnc:make-html-table-header-cell/markup
"total-number-cell" (collector-sum (car money))))))
(define (report-difference)
(let ((money-diff-collector (gnc:make-commodity-collector)))
(money-diff-collector 'merge (car incoming-money) #f)
(money-diff-collector 'minusmerge (car outgoing-money) #f)
(gnc:html-table-append-row/markup!
table
"grand-total"
(list
(_ "Difference")
(gnc:make-html-table-header-cell/markup
"total-number-cell" (collector-sum money-diff-collector))))))
(accumulate-splits (pct 'get 34))
(report-money incoming-money (pct 'get 33))
(gnc:html-table-append-ruler! table 2)
(report-money outgoing-money (pct 'get 33))
(gnc:html-table-append-ruler! table 2)
(report-difference)
(gnc:html-table-append-ruler! table 2)
(gnc:html-document-add-object! doc table)))
(define (report-summary pct)
(if (not (null? summary-accounts))
(let ((old-exchange-fn (gnc:case-exchange-fn price-source report-currency from))
(table (gnc:make-html-table)))
;; TODO: FIXME: Compute the balance once, then sort; this recomputes
;; for each comparison...
(define (account-balance>? a b)
(let ((a-bal (gnc:account-get-comm-balance-at-date a to #t))
(b-bal (gnc:account-get-comm-balance-at-date b to #t)))
(numeric>? (collector-amount a-bal) (collector-amount b-bal))))
(define (add-account account)
(let* ((investment-subaccounts (collect-accounts-by-type '(stock mutual-fund) account))
(before (gnc:account-get-comm-balance-at-date account from #t))
(after (gnc:account-get-comm-balance-at-date account to #t))
(after-prime (gnc:make-commodity-collector)))
;; Subtract contributions from a current account or from salary.
;; Dividend/capital gains reinvestments are not subtracted.
(define (contribution-p split)
(let ((from (split-get-corr-account split))
(to (gnc:split-get-account split)))
(and to (account-in-list? to investment-subaccounts)
from (or (account-in-list? from salary-accounts)
(account-in-list? from accounts)))))
(define (subtract-contribution split)
(let* ((transaction (gnc:split-get-parent split))
(currency (gnc:transaction-get-currency transaction))
(value (gnc:split-get-value split)))
(after-prime 'add currency (gnc:numeric-neg value))))
(after-prime 'merge after #f)
(for-each subtract-contribution (filter contribution-p splits))
;; Should really subtract an additional
;; (/ (* contribution monthly-fractional-change) 2)
;; to remove approximate growth of contribution..
;; Could do it even more precisely but wtf?
(let* ((before-sum (gnc:sum-collector-commodity before report-currency old-exchange-fn))
(before-amt (gnc:gnc-monetary-amount before-sum))
(after-sum (collector-sum after))
(after-amt (gnc:gnc-monetary-amount after-sum))
(after-prime-amt (collector-amount after-prime))
(percent (percent-change before-amt after-amt))
(percent-prime (percent-change before-amt after-prime-amt)))
(gnc:html-table-append-row/markup!
table
(if (pct 'odd) "normal-row" "alternate-row")
(list (gnc:make-html-text (markup-account account))
(gnc:make-html-table-cell/markup "number-cell" before-sum)
(gnc:make-html-table-cell/markup "number-cell" after-sum)
(gnc:make-html-table-cell/markup "number-cell" percent)
(gnc:make-html-table-cell/markup "number-cell" (if (equal? percent percent-prime) "" (sprintf #f (_ " (%s without contributions)") percent-prime))))))))
(gnc:html-table-set-col-headers!
table (list (_ "Account") (_ "Start") (_ "End") (_ "Change") ""))
(gnc:html-table-append-ruler! table 4)
(pct 'for-each add-account (sort summary-accounts (if (eqv? sort-accounts-by 'name) account-full-name<? account-balance>?)))
(gnc:html-table-append-ruler! table 4)
(gnc:html-document-add-object! doc table))))
(gnc:html-document-add-object!
doc
(gnc:make-html-text
(gnc:html-markup-h2 (sprintf #f (_ "Cash flow from %s to %s") (gnc:print-date from) (gnc:print-date to)))))
(report-in-out (pct 'get 70))
(report-summary (pct 'get 30))
(if show-rates?
(gnc:html-document-add-object!
doc ;;(gnc:html-markup-p
(gnc:html-make-exchangerates
report-currency exchange-fn accounts)))))
(pct 'for-each report-period (if report-delta (reverse (gnc:make-date-interval-list from-date to-date report-delta)) (list (list from-date to-date)))))
;; 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)))) ; wtf?
sub-accounts)))
(gnc:html-document-set-title!
doc (get-option gnc:pagename-general gnc:optname-reportname))
;; error condition: no accounts specified
(if (null? accounts)
(gnc:html-document-add-object!
doc
(gnc:html-make-no-account-warning
reportname (gnc:report-id report-obj)))
(begin
(report-accounts (pct 'get 5))
(report-periods (pct 'get 95))))
(gnc:report-finished)
doc))
(define (cash-flow-renderer report-obj)
(cash-flow-renderer-impl report-obj reportname))
(define (monthly-cash-flow-renderer report-obj)
(cash-flow-renderer-impl report-obj monthly-reportname))
(gnc:define-report
'version 1
'name reportname
'menu-path (list gnc:menuname-income-expense)
'options-generator cash-flow-options-generator
'renderer cash-flow-renderer)
(gnc:define-report
'version 1
'name monthly-reportname
'menu-path (list gnc:menuname-income-expense)
'options-generator monthly-cash-flow-options-generator
'renderer monthly-cash-flow-renderer)
More information about the gnucash-devel
mailing list