2002-11-09 Herbert Thoma <herbie@hthoma.de>

* /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
This commit is contained in:
Derek Atkins
2002-11-11 00:24:18 +00:00
parent f20f01857b
commit 7097d664c5
2 changed files with 63 additions and 52 deletions
+5
View File
@@ -1,3 +1,8 @@
2002-11-09 Herbert Thoma <herbie@hthoma.de>
* /src/report/standard-reports/cash-flow.scm: bug fix for cash flow
reports on stock accounts
2002-11-09 Derek Atkins <derek@ihtfp.com>
* gnome/dialog-new-user: don't call the qif-import-druid directly.
Add a callback API for the qif-import druid. Use that callback
+58 -52
View File
@@ -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))