From 7097d664c51047c85d7d1a6ead5d60e3f56ffd2f Mon Sep 17 00:00:00 2001 From: Derek Atkins Date: Mon, 11 Nov 2002 00:24:18 +0000 Subject: [PATCH] 2002-11-09 Herbert Thoma * /src/report/standard-reports/cash-flow.scm: bug fix for cash flow reports on stock accounts git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@7457 57a11ea4-9604-0410-9ed3-97b8803252fd --- ChangeLog | 5 + src/report/standard-reports/cash-flow.scm | 110 ++++++++++++---------- 2 files changed, 63 insertions(+), 52 deletions(-) diff --git a/ChangeLog b/ChangeLog index 27e0940838..8c4eab634c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2002-11-09 Herbert Thoma + + * /src/report/standard-reports/cash-flow.scm: bug fix for cash flow + reports on stock accounts + 2002-11-09 Derek Atkins * gnome/dialog-new-user: don't call the qif-import-druid directly. Add a callback API for the qif-import druid. Use that callback diff --git a/src/report/standard-reports/cash-flow.scm b/src/report/standard-reports/cash-flow.scm index 3b9da76fd2..e32fde63b5 100644 --- a/src/report/standard-reports/cash-flow.scm +++ b/src/report/standard-reports/cash-flow.scm @@ -148,7 +148,7 @@ (gnc:html-document-set-title! - doc (sprintf #f "%s - %s to %s for" + doc (sprintf #f (_ "%s - %s to %s for") (get-option gnc:pagename-general gnc:optname-reportname) (gnc:print-date from-date-tp) (gnc:print-date to-date-tp))) @@ -175,69 +175,75 @@ (curr-commodity (gnc:account-get-commodity current)) ) - ;(gnc:debug "---" name "---") + ;(gnc:debug "---" name "---" (gnc:commodity-get-printname curr-commodity)) - (for-each - (lambda (split) - (let ((parent (gnc:split-get-parent split))) - (if (and (gnc:timepair-le (gnc:transaction-get-date-posted parent) to-date-tp) - (gnc:timepair-ge (gnc:transaction-get-date-posted parent) from-date-tp)) - (for-each - (lambda (s) - (let* ((s-account (gnc:split-get-account s)) - (s-amount (gnc:split-get-amount s)) - (s-value (gnc:split-get-value s)) - (s-commodity (gnc:account-get-commodity s-account))) - ;(gnc:debug (gnc:account-get-name s-account)) - (if (not (account-in-list? s-account accounts)) - (if (gnc:numeric-negative-p (gnc:split-get-value s)) - (let ((pair (account-in-alist s-account money-in-alist))) - ;(gnc:debug "in:" (gnc:commodity-get-printname s-commodity) - ; (gnc:numeric-to-double s-amount) - ; (gnc:commodity-get-printname curr-commodity) - ; (gnc:numeric-to-double s-value)) - (money-in-collector 'add curr-commodity (gnc:numeric-neg s-value)) - (if (not pair) - (begin - (set! pair (list s-account (gnc:make-commodity-collector))) - (set! money-in-alist (cons pair money-in-alist)) - (set! money-in-accounts (cons s-account money-in-accounts)) - ;(gnc:debug money-in-alist) - ) - ) - (let ((s-account-in-collector (cadr pair))) - (s-account-in-collector 'add curr-commodity (gnc:numeric-neg s-value))) + (for-each + (lambda (split) + (let ((parent (gnc:split-get-parent split))) + (if (and (gnc:timepair-le (gnc:transaction-get-date-posted parent) to-date-tp) + (gnc:timepair-ge (gnc:transaction-get-date-posted parent) from-date-tp)) + (let* ((parent-description (gnc:transaction-get-description parent)) + (parent-currency (gnc:transaction-get-currency parent))) + ;(gnc:debug parent-description + ; " - " + ; (gnc:commodity-get-printname parent-currency)) + (for-each + (lambda (s) + (let* ((s-account (gnc:split-get-account s)) + (s-amount (gnc:split-get-amount s)) + (s-value (gnc:split-get-value s)) + (s-commodity (gnc:account-get-commodity s-account))) + ;(gnc:debug (gnc:account-get-name s-account)) + (if (not (account-in-list? s-account accounts)) + (if (gnc:numeric-negative-p (gnc:split-get-value s)) + (let ((pair (account-in-alist s-account money-in-alist))) + ;(gnc:debug "in:" (gnc:commodity-get-printname s-commodity) + ; (gnc:numeric-to-double s-amount) + ; (gnc:commodity-get-printname curr-commodity) + ; (gnc:numeric-to-double s-value)) + (if (not pair) + (begin + (set! pair (list s-account (gnc:make-commodity-collector))) + (set! money-in-alist (cons pair money-in-alist)) + (set! money-in-accounts (cons s-account money-in-accounts)) + ;(gnc:debug money-in-alist) + ) ) - (let ((pair (account-in-alist s-account money-out-alist))) - ;(gnc:debug "out:" (gnc:commodity-get-printname s-commodity) - ; (gnc:numeric-to-double s-amount) - ; (gnc:commodity-get-printname curr-commodity) - ; (gnc:numeric-to-double s-value)) - (money-out-collector 'add curr-commodity s-value) - (if (not pair) - (begin - (set! pair (list s-account (gnc:make-commodity-collector))) - (set! money-out-alist (cons pair money-out-alist)) - (set! money-out-accounts (cons s-account money-out-accounts)) - ;(gnc:debug money-out-alist) - ) - ) - (let ((s-account-out-collector (cadr pair))) - (s-account-out-collector 'add curr-commodity s-value)) + (let ((s-account-in-collector (cadr pair))) + (money-in-collector 'add parent-currency (gnc:numeric-neg s-value)) + (s-account-in-collector 'add parent-currency (gnc:numeric-neg s-value))) + ) + (let ((pair (account-in-alist s-account money-out-alist))) + ;(gnc:debug "out:" (gnc:commodity-get-printname s-commodity) + ; (gnc:numeric-to-double s-amount) + ; (gnc:commodity-get-printname curr-commodity) + ; (gnc:numeric-to-double s-value)) + (if (not pair) + (begin + (set! pair (list s-account (gnc:make-commodity-collector))) + (set! money-out-alist (cons pair money-out-alist)) + (set! money-out-accounts (cons s-account money-out-accounts)) + ;(gnc:debug money-out-alist) + ) ) - ) + (let ((s-account-out-collector (cadr pair))) + (money-out-collector 'add parent-currency s-value) + (s-account-out-collector 'add parent-currency s-value)) + ) ) ) ) - (gnc:transaction-get-splits parent) ) + (gnc:transaction-get-splits parent) ) ) ) - (gnc:account-get-split-list current) ) + ) + (gnc:account-get-split-list current) + ) - (calc-money-in-out-internal rest)))) + (calc-money-in-out-internal rest)))) (calc-money-in-out-internal accounts))