Fwd: gnucash monthly report

merlin hughes gnucash at merlin.org
Sat Mar 5 11:58:26 EST 2005

r/c.shoemaker at cox.net/2005.03.04/16:14:42
>Hi Merlin,
>        I'd like to understand this report a bit better.  I ask some
>questions and make some comments inline:


>> 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.
>In the above example, I assume "checking" is an asset account (the
>only asset account in the transaction) and your cash-flow report is
>w.r.t only asset accounts (including "checking").  If that's the case,
>then I don't see the problem with the given output.  You have $12
>incoming and $3 outgoing for a net income of $9.

The sum of the result is numerically accurate; however, money
that flows directly from income to the government, without
ever entering an asset account of mine, does not strike me as
'cash flow'.

My problem with the algorithm is not the numerical accuracy of
its sum, just the fact that if any asset account participates
in a transaction, then all splits in the transaction are
considered cash flow associated with that asset account. If I
write a cheque for $1 to exercise some options worth $100,000
(the other $99,999 comes from capital gains) then the algorithm
will report a huge cash flow associated with the checking
account (assuming that I am monitoring cash flow from just
the checking account); $99,999 in and $100,000 out; when the
fact is that only $1 went out.

Nevertheless, I don't personally use this aspect of the
report and thus have no particular stake in how it operates,
so I have reverted to the old algorithm in the attached code.

>> 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.
>I'm not sure what is meant by S.corr-account.  Splits only have one
>Account, and Transactions can have Splits for more than only two
>Accounts, so... ?
>[I look at the code a bit...]

It is just a tweak of the built-in corr-account-name function.
I assume 'corr' means correlated, but I didn't pick the
original name.

>Ok, I think I see what S.corr-account means, but I don't think this
>algorithm is correct.  It's not right to ignore n:m transactions.

I don't really ignore n:m transactions, I just simplify the
presentation of the transaction so that the source/destination
of the funds is just identified as the single largest one of
the many accounts on the far side of the transaction.

In the general case this may not be right; however, for the
income vs expense reporting case it appears sufficient[*].

[*] There's still a tweak I need to make for some cases.

>> 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.
>"ignores transfers among account"?  Aren't all transactions transfers
>between accounts.  It seems that perhaps what you mean is that it
>ignores transfers between accounts, except when one of those accounts
>is an income or an expense account.  For example, if you run a
>cash-flow report on your savings account (asset) you will see your
>payroll deposit (income:salary) but not the check you wrote and
>deposited to yourself (from asset:checking).  IOW, you're not
>reporting cash-flow -- you're reporting income and expenses.  However,
>if you run a cash-flow report on all your asset accounts, doesn't that
>show what you want?

Let me preface this by saying that I've renamed the
alternate mode to 'Income vs Expenses' which is what it
really is. It shares a large amount of code with 'Cash Flow'
in implementation, but it is a different report. It was my
error to include cash flow in the name.

I specifically want to see on a month-by-month basis how much
I'm earning and spending; i.e., income vs expenses. I do not
want it to report when I move money among asset accounts;
specifically, when I write a cheque into a retirement
account/equivalent. I also don't want to see other investments
into my retirement accounts since it is not money that I live
on daily.

If I do a cash flow report on all my assets, both current and
retirement, then if I write a cheque into a retirement account
it will not be reported, which is what I want. However, monthly
contributions to my retirement accounts plus automatic dividend
reinvestments will be reported as income, which I don't want.
So I need the income vs expense mode.

But, as you say, it's not cash flow. It just happens to share
a bunch of code. So I've renamed it, which may clear up a lot
of the issues with it.

>> 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.
>Your escrow accounts are asset accounts, right?  If so, then a
>cash-flow report including escrow accounts will show payments to escrow
>accounts as "incoming" (regular) and payments from the escrow accounts as
>"outgoing" (sporadic).
>If you want to only consider the regular transactions (like monthly
>property tax escrow deposit), then exclude those escrow accounts from
>the cash-flow report.  Then, regular deposits to escrow accounts will
>reported as "outgoing" (This is correct, even though they are
>"income".)  And payments from escrow accounts won't show up at all,
>since they won't touch the accounts on which the report is run.

Right, that works fine for the cash flow report. But as I
say above, I'm interested in income vs expenses, and this
solution doesn't work there. I have to treat escrow accounts
as a special type of expense, which requires the additional
code. The option was completely ignored in cash flow mode
anyway, and in the attached code the option is no longer
displayed for that report.

>I haven't followed your code completely, but I ran your report, and I
>haven't figured out what the benefit is to treating escrow accounts
>specially.  Can you elaborate?

I think I just wasn't clear in my original
explanation. Hopefully I've clarified above but, to
summarize, I want to report income vs expenses; however,
I also write monthly cheques into escrow accounts and I want
these to be counted as monthly expenses, so I need the extra
logic. Although it seems like something of a convoluted case,
it's fairly common.

>>From my initial look, it seems like you've made some real enhancements
>to the cash-flow report.  But I question the usefulness of the
>re-definition of cash-flow.  And I can't see the benefit of a special
>treatment for "escrow" and "salary" accounts.  It seems like
>particular account selections in the original formulation would report
>what you want.  But if not, then I don't think you want "cash-flow".
>In that case, perhaps this should become a new report by itself.

The salary account option is a separate issue, and is ugly,
but it is needed for the monthly account summary. I want to
report how retirement accounts are doing, both before and
after contributions (which come from salary and assets). A
simple solution would be to subtract all contributions from
'income or 'asset, but that would also subtract automatic
dividend/capital gains reinvestments ('income), which are
a proper part of the performance of the account. So I need
to identify which 'income is salary, and subtract that, to
come up with the account performance. If you can suggest a
better solution for identifying either salary income, or else
dividend/capital gains income, then I would happily eliminate
the option.

Anyway, I have renamed the income vs expense report to 'Income
vs Expenses', it just shares implementation code with 'Cash
Flow', and I have restored the original split accounting of
'Cash Flow', so hopefully it operates precisely as before
just with different underlying code.

-------------- next part --------------
;; cash-flow.scm: cash flow report 
;; By Herbert Thoma <herbie at hthoma.de>
;; Mutilated by Merlin Hughes <merlin AT merlin DOT org>
;; . 2005-03-02 v1.0 - first post
;; . 2005-03-05 v1.1 - restore old cash flow algorithm + rename i-v-e
;; 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   
;; 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 i-v-e-reportname (N_ "Income vs Expenses"))

;; 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)

;; 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)
     ((null? accounts) #f)
     ((same-account? (car accounts) account) #t)
     (else (account-in-list? account (cdr accounts))))))

(define account-in-alist
  (lambda (account alist)
     ((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))
  ;(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 (accounts-get-children-depth children)))))

;; 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 i-v-e?)
  (let ((options (gnc:new-options)))

    ;; date interval
     options gnc:pagename-general 
     optname-from-date optname-to-date "a")

      gnc:pagename-general optname-report-period
      "b" (N_ "Report period") (if i-v-e? '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
     options gnc:pagename-general
     optname-report-currency "c")

     options gnc:pagename-general
     optname-price-source "d" (if i-v-e? 'pricedb-nearest 'weighted-average))

      gnc:pagename-general optname-show-rates
      "e" (N_ "Show the exchange rates used") #f))

      gnc:pagename-general optname-show-full-names
      "f" (N_ "Show full account names (including parent accounts)") (not i-v-e?)))

      gnc:pagename-general optname-sort-accounts-by
      "g" (N_ "Sort accounts by") (if i-v-e? 'money 'name)
      (list (vector 'name (N_ "Name")
		    (N_ "Sort accounts by name"))
	    (vector 'money (N_ "Amount")
		    (N_ "Sort accounts by monetary amount")))))

      gnc:pagename-general optname-list-accounts-selected
      "h" (N_ "List selected accounts at head of report") (not i-v-e?)))

    ; options
    ; (gnc:make-simple-boolean-option
    ;  gnc:pagename-general optname-income-vs-expenses
    ;  "i" (N_ "Only list income and expenses (i.e., ignore investments)") i-v-e?))

    ;; accounts to work on
     options gnc:pagename-accounts
     optname-display-depth optname-show-subaccounts
     optname-accounts "a" 2
     (lambda ()
	(if i-v-e?
	    '(bank cash credit liability)
	    '(bank cash asset stock mutual-fund))))
    (when i-v-e?
      ;; asset accounts to consider as expenses (only if income-vs-expenses)
        pagename-escrow-accounts optname-escrow-accounts
        (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
      pagename-summary-accounts optname-summary-accounts
      (N_ "Accounts to summarize.")
      (lambda ()
	(if i-v-e? (tree-collect apply-to-all-accounts summary-apex-test) '()))
      #f #t))
    ;; salary accounts for ignoring investment contributions
      pagename-summary-accounts optname-salary-accounts
      (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)      


(define (cash-flow-options-generator)
  (cash-flow-options-generator-impl #f))

(define (i-v-e-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 i-v-e?)
  (define (get-option pagename optname)
      (gnc:report-options report-obj) pagename optname)))

  (gnc:report-starting (if i-v-e? i-v-e-reportname 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 (and i-v-e? (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))
         (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 (cash-flow-transaction-p transaction) ; any split on cash flow account
      (let loop ((index 0))
        (and (< index (gnc:transaction-get-split-count transaction))
             (or (account-in-list? (gnc:split-get-account (gnc:transaction-get-split transaction index)) accounts)
                 (loop (1+ index))))))

    (define (markup-account account)
       (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) 
		(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"))
				  (markup-account account))))
		    (set! account-disp-list (cons anchor account-disp-list)))))

	    (pct 'for-each add-account (sort accounts account-full-name<?))

	     (gnc:make-html-text (_ "Selected Accounts")))
	       (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 (and i-v-e? (split-get-corr-account split)))
                         (cash-flow-transaction? (and (not i-v-e?) (cash-flow-transaction-p transaction)))
			 (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
			  (if i-v-e? 
			      (and (eqv? 'income (account-get-type-sym tnuocca))
				   (or (account-in-list? account accounts)
				       (account-in-list? account escrow-accounts)))
			      (and (not (account-in-list? account accounts))
				   (cash-flow-transaction-p transaction)
				   (= -1 (numeric-sign value)))))
			  (if i-v-e?
			      (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 (not (account-in-list? account accounts))
                                   (cash-flow-transaction-p transaction)
				   (= 1 (numeric-sign value))))))
		    (define (add-split split money in?)
		      (let* ((ac (if (and i-v-e? in?) tnuocca account))
			     (pair (account-in-alist ac (cdr money)))
			     (add (if (or (not in?) i-v-e?) 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 (or (not i-v-e?) 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)))
		     table (if (pct 'odd) "normal-row" "alternate-row")
		     (list (gnc:make-html-text
			    (markup-account account))
			    "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))))

		 table "primary-subheading"
		 (list (_ (if (eq? money incoming-money)
			      (if i-v-e? "Income" "Money into selected accounts comes from")
			      (if i-v-e? "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>?)))

		 table "grand-total"
		 (list (_ (if (eq? money incoming-money) "Money In" "Money Out"))
			"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)
		    (_ "Difference")
		     "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)
	      (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)))
			 (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))))))))
		   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-markup-h2 (sprintf #f (_ (if i-v-e? "Income vs Expenses from %s to %s" "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?
	       doc ;;(gnc:html-markup-p
		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)))
	   (lambda (sub-account)
	     (if (not (account-in-list? sub-account accounts))
		 (set! accounts (append accounts sub-accounts)))) ; wtf?

     doc (get-option gnc:pagename-general gnc:optname-reportname))
    ;; error condition: no accounts specified
    (if (null? accounts)
	  (if i-v-e? i-v-e-reportname reportname) (gnc:report-id report-obj)))
	  (report-accounts (pct 'get 5))
	  (report-periods (pct 'get 95))))

(define (cash-flow-renderer report-obj)
  (cash-flow-renderer-impl report-obj #f))

(define (i-v-e-cash-flow-renderer report-obj)
  (cash-flow-renderer-impl report-obj #t))

 'version 1
 'name reportname
 'menu-path (list gnc:menuname-income-expense)
 'options-generator cash-flow-options-generator
 'renderer cash-flow-renderer)

 'version 1
 'name i-v-e-reportname
 'menu-path (list gnc:menuname-income-expense)
 'options-generator i-v-e-cash-flow-options-generator
 'renderer i-v-e-cash-flow-renderer)

More information about the gnucash-devel mailing list