gnucash maint: Multiple changes pushed
Geert Janssens
gjanssens at code.gnucash.org
Fri Aug 1 05:59:00 EDT 2014
Updated via https://github.com/Gnucash/gnucash/commit/11698f48 (commit)
via https://github.com/Gnucash/gnucash/commit/66dd0cc7 (commit)
via https://github.com/Gnucash/gnucash/commit/f086c187 (commit)
via https://github.com/Gnucash/gnucash/commit/f0abc2c0 (commit)
via https://github.com/Gnucash/gnucash/commit/f34c4e0f (commit)
from https://github.com/Gnucash/gnucash/commit/13ef7eec (commit)
commit 11698f4824bf01e22bb44974d8708c04da62e173
Author: Geert Janssens <janssens-geert at telenet.be>
Date: Fri Aug 1 11:59:12 2014 +0200
Revert "Bug #622778 Miscalculation in cashflow reports - Step 01"
This reverts commit 77340591a90f1eb16871e25f4c8bebad0092f7f2.
See bug 622778 and bug 722140 for more details.
diff --git a/src/report/standard-reports/cash-flow.scm b/src/report/standard-reports/cash-flow.scm
index fd0c746..2e7c500 100644
--- a/src/report/standard-reports/cash-flow.scm
+++ b/src/report/standard-reports/cash-flow.scm
@@ -100,217 +100,7 @@
options))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; global objects
-;; objects used by the cash-flow-calculator and the document-renderer
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(define money-in-alist '())
-(define money-in-accounts '())
-(define money-in-collector (gnc:make-commodity-collector))
-
-(define money-out-accounts '())
-(define money-out-alist '())
-(define money-out-collector (gnc:make-commodity-collector))
-
-(define time-exchange-fn #f)
-
-(define work-done 0)
-(define work-to-do 0)
-
-;; is account in list of accounts?
-(define (same-account? a1 a2)
- (string=? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))
-
-(define (same-split? s1 s2)
- (string=? (gncSplitGetGUID s1) (gncSplitGetGUID s2)))
-
-(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))))))
-
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; cash-flow-calculator
-;; do the cash flow calculations
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; function to add inflow and outflow of money
-(define (calc-money-in-out accounts to-date-tp from-date-tp report-currency)
-
- (let* (
- (splits-to-do (gnc:accounts-count-splits accounts))
- ;;(seen-split-list '())
- )
-
- (define split-in-list?
- (lambda (split splits)
- (cond
- ((null? splits) #f)
- ((same-split? (car splits) split) #t)
- (else (split-in-list? split (cdr splits))))))
-
- ;; 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
- )
- )
- )
-
- (define (calc-money-in-out-internal accounts-internal)
- (if (not (null? accounts-internal))
- (let* (
- (current (car accounts-internal))
- (rest (cdr accounts-internal))
- (name (xaccAccountGetName current))
- (curr-commodity (xaccAccountGetCommodity current))
- (seen-split-list '())
- )
-
- ;(gnc:debug "calc-money-in-out-internal---" name "---" (gnc-commodity-get-printname curr-commodity))
-
- (for-each
- (lambda (split)
- (set! work-done (+ 1 work-done))
- (gnc:report-percent-done (* 85 (/ work-done splits-to-do)))
- (let (
- (parent (xaccSplitGetParent 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 (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-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
- (not (account-in-list? s-account accounts))
- )
- (if (not (split-in-list? s seen-split-list))
- (begin
- (set! seen-split-list (cons s seen-split-list))
- (if (gnc-numeric-negative-p s-value)
- (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 parent-currency)
- ; (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 (
- (s-account-in-collector (cadr pair))
- (s-report-value
- (to-report-currency
- parent-currency
- (gnc-numeric-neg s-value)
- (gnc-transaction-get-date-posted parent)
- )
- )
- )
- (money-in-collector 'add report-currency s-report-value)
- (s-account-in-collector 'add report-currency s-report-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 parent-currency)
- ; (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))
- (s-report-value
- (to-report-currency
- parent-currency
- s-value
- (gnc-transaction-get-date-posted parent)
- )
- )
- )
- (money-out-collector 'add report-currency s-report-value)
- (s-account-out-collector 'add report-currency s-report-value)
- )
- )
- )
- )
- )
- )
- )
- )
- (xaccTransGetSplitList parent)
- )
- )
- )
- )
- )
- (xaccAccountGetSplitList current)
- )
- (calc-money-in-out-internal rest)
- )
- )
- )
-
- (calc-money-in-out-internal accounts)
- );;let
-)
-
-
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; document-renderer
+;; cash-flow-renderer
;; set up the document and add the table
;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -330,6 +120,8 @@
(accounts (get-option gnc:pagename-accounts
optname-accounts))
(row-num 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
@@ -355,6 +147,34 @@
(table (gnc:make-html-table))
(txt (gnc:make-html-text)))
+ ;; is account in list of accounts?
+ (define (same-account? a1 a2)
+ (string=? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))
+
+ (define (same-split? s1 s2)
+ (string=? (gncSplitGetGUID s1) (gncSplitGetGUID s2)))
+
+ (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 split-in-list?
+ (lambda (split splits)
+ (cond
+ ((null? splits) #f)
+ ((same-split? (car splits) split) #t)
+ (else (split-in-list? split (cdr splits))))))
+
+ (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)))
@@ -393,9 +213,133 @@
display-depth))
(account-disp-list '())
+ (money-in-accounts '())
+ (money-in-alist '())
+ (money-in-collector (gnc:make-commodity-collector))
+
+ (money-out-accounts '())
+ (money-out-alist '())
+ (money-out-collector (gnc:make-commodity-collector))
+
(money-diff-collector (gnc:make-commodity-collector))
+ (splits-to-do (gnc:accounts-count-splits accounts))
+ (seen-split-list '())
+ (time-exchange-fn #f)
(commodity-list #f))
+ ;; 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)))
+
+ ;; function to add inflow and outflow of money
+ (define (calc-money-in-out accounts)
+ (define (calc-money-in-out-internal accounts-internal)
+ (if (not (null? accounts-internal))
+ (let* ((current (car accounts-internal))
+ (rest (cdr accounts-internal))
+ (name (xaccAccountGetName current))
+ (curr-commodity (xaccAccountGetCommodity current))
+ )
+
+ ;(gnc:debug "calc-money-in-out-internal---" name "---" (gnc-commodity-get-printname curr-commodity))
+
+ (for-each
+ (lambda (split)
+ (set! work-done (+ 1 work-done))
+ (gnc:report-percent-done (* 85 (/ work-done splits-to-do)))
+ (let ((parent (xaccSplitGetParent 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 (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-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
+ (not (account-in-list? s-account accounts)))
+ (if (not (split-in-list? s seen-split-list))
+ (begin
+ (set! seen-split-list (cons s seen-split-list))
+ (if (gnc-numeric-negative-p s-value)
+ (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 parent-currency)
+ ; (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 ((s-account-in-collector (cadr pair))
+ (s-report-value (to-report-currency parent-currency
+ (gnc-numeric-neg s-value)
+ (gnc-transaction-get-date-posted
+ parent))))
+ (money-in-collector 'add report-currency s-report-value)
+ (s-account-in-collector 'add report-currency s-report-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 parent-currency)
+ ; (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))
+ (s-report-value (to-report-currency parent-currency
+ s-value
+ (gnc-transaction-get-date-posted
+ parent))))
+ (money-out-collector 'add report-currency s-report-value)
+ (s-account-out-collector 'add report-currency s-report-value))
+ )
+ )
+ )
+ )
+ )
+ )
+ )
+ (xaccTransGetSplitList parent)
+ )
+ )
+ )
+ )
+ )
+ (xaccAccountGetSplitList current)
+ )
+
+ (calc-money-in-out-internal rest))))
+
+ (calc-money-in-out-internal accounts))
;; Get an exchange function that will convert each transaction using the
;; nearest available exchange rate if that is what is specified
@@ -408,7 +352,7 @@
0 0))
- (calc-money-in-out accounts to-date-tp from-date-tp report-currency)
+ (calc-money-in-out accounts)
(money-diff-collector 'merge money-in-collector #f)
(money-diff-collector 'minusmerge money-out-collector #f)
commit 66dd0cc7c8af4f8e0218b33cf4dd0da49b3f5498
Author: Geert Janssens <janssens-geert at telenet.be>
Date: Fri Aug 1 11:58:51 2014 +0200
Revert "Bug #622778 Miscalculation in cashflow reports - Step 02"
This reverts commit 8a95c0f0b7ee737a5e00225acd4e639f3ce1d1c2.
See bug 622778 and bug 722140 for more details.
diff --git a/src/report/standard-reports/cash-flow.scm b/src/report/standard-reports/cash-flow.scm
index c40f620..fd0c746 100644
--- a/src/report/standard-reports/cash-flow.scm
+++ b/src/report/standard-reports/cash-flow.scm
@@ -140,190 +140,171 @@
(else (account-in-alist account (cdr alist))))))
-;; ------------------------------------------------------------------
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cash-flow-calculator
;; do the cash flow calculations
-;; ------------------------------------------------------------------
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; function to add inflow and outflow of money
(define (calc-money-in-out accounts to-date-tp from-date-tp report-currency)
(let* (
(splits-to-do (gnc:accounts-count-splits accounts))
+ ;;(seen-split-list '())
)
- (define split-in-list?
- (lambda (split splits)
- (cond
- ((null? splits) #f)
- ((same-split? (car splits) split) #t)
- (else (split-in-list? split (cdr splits))))))
-
- ;; 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
- )
+ (define split-in-list?
+ (lambda (split splits)
+ (cond
+ ((null? splits) #f)
+ ((same-split? (car splits) split) #t)
+ (else (split-in-list? split (cdr splits))))))
+
+ ;; 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
)
)
+ )
- ;; ------------------------------------------------------------------
- ;; process all selected accounts
- ;; ------------------------------------------------------------------
- (for-each
- (lambda (account)
- (let* (
- (name (xaccAccountGetName account))
- (curr-commodity (xaccAccountGetCommodity account))
- (seen-split-list '())
- )
- ;(gnc:debug "calc-money-in-out-internal---" name "---" (gnc-commodity-get-printname curr-commodity))
+ (define (calc-money-in-out-internal accounts-internal)
+ (if (not (null? accounts-internal))
+ (let* (
+ (current (car accounts-internal))
+ (rest (cdr accounts-internal))
+ (name (xaccAccountGetName current))
+ (curr-commodity (xaccAccountGetCommodity current))
+ (seen-split-list '())
+ )
- ;; -------------------------------------
- ;; process all splits of current account
- ;; -------------------------------------
- (for-each
- (lambda (split)
- ;; ----------------------------------------------------
- ;; update progress indicator
- ;; ----------------------------------------------------
- (set! work-done (+ 1 work-done))
- (gnc:report-percent-done (* 85 (/ work-done splits-to-do)))
- ;; ----------------------------------------------------
- ;; only splits that are within the specified time range
- ;; ----------------------------------------------------
- (let* (
- (parent (xaccSplitGetParent split))
- (parent-date-posted (gnc-transaction-get-date-posted parent))
- )
- (if (and
- (gnc:timepair-le parent-date-posted to-date-tp)
- (gnc:timepair-ge parent-date-posted from-date-tp)
- )
- (let* (
- (parent-currency (xaccTransGetCurrency parent))
- )
- ;(gnc:debug (xaccTransGetDescription parent)
- ; " - "
- ; (gnc-commodity-get-printname parent-currency))
- ;; -----------------------------------------
- ;; process all splits of current transaction
- ;; -----------------------------------------
- (for-each
- (lambda (s)
- (let* (
- (s-account (xaccSplitGetAccount s))
- (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 "calc-money-in-out-internal---" name "---" (gnc-commodity-get-printname curr-commodity))
+
+ (for-each
+ (lambda (split)
+ (set! work-done (+ 1 work-done))
+ (gnc:report-percent-done (* 85 (/ work-done splits-to-do)))
+ (let (
+ (parent (xaccSplitGetParent 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 (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-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))
- ;; ----------------------------------------------------------------------
- ;; only splits from or to accounts outside the user selected account list
- ;; ----------------------------------------------------------------------
- (if (and ;; make sure we don't have
- (not (null? s-account)) ;; any dangling splits
- (not (account-in-list? s-account accounts))
- )
- (if (not (split-in-list? s seen-split-list))
- (begin
- (set! seen-split-list (cons s seen-split-list))
- (if (gnc-numeric-negative-p s-value)
- ;; -----------------------------------------------
- ;; collect the incoming flow
- ;; -----------------------------------------------
- (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 parent-currency)
- ; (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 (
- (s-account-in-collector (cadr pair))
- (s-report-value
- (to-report-currency
- parent-currency
- (gnc-numeric-neg s-value)
- (gnc-transaction-get-date-posted parent)
- )
+ )
+
+ ;(gnc:debug (xaccAccountGetName s-account))
+ (if (and ;; make sure we don't have
+ (not (null? s-account)) ;; any dangling splits
+ (not (account-in-list? s-account accounts))
+ )
+ (if (not (split-in-list? s seen-split-list))
+ (begin
+ (set! seen-split-list (cons s seen-split-list))
+ (if (gnc-numeric-negative-p s-value)
+ (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 parent-currency)
+ ; (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 (
+ (s-account-in-collector (cadr pair))
+ (s-report-value
+ (to-report-currency
+ parent-currency
+ (gnc-numeric-neg s-value)
+ (gnc-transaction-get-date-posted parent)
)
)
- (money-in-collector 'add report-currency s-report-value)
- (s-account-in-collector 'add report-currency s-report-value)
- )
- )
- ;; else
- ;; -----------------------------------------------
- ;; collect the outgoing flow
- ;; -----------------------------------------------
- (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 parent-currency)
- ; (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)
- )
+ )
+ (money-in-collector 'add report-currency s-report-value)
+ (s-account-in-collector 'add report-currency s-report-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 parent-currency)
+ ; (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))
- (s-report-value
- (to-report-currency
- parent-currency
- s-value
- (gnc-transaction-get-date-posted parent)
- )
+ )
+ (let (
+ (s-account-out-collector (cadr pair))
+ (s-report-value
+ (to-report-currency
+ parent-currency
+ s-value
+ (gnc-transaction-get-date-posted parent)
)
)
- (money-out-collector 'add report-currency s-report-value)
- (s-account-out-collector 'add report-currency s-report-value)
- )
+ )
+ (money-out-collector 'add report-currency s-report-value)
+ (s-account-out-collector 'add report-currency s-report-value)
)
)
)
- )
- )
+ )
+ )
)
)
- (xaccTransGetSplitList parent)
- )
+ )
+ (xaccTransGetSplitList parent)
)
)
)
)
- (xaccAccountGetSplitList account)
)
+ (xaccAccountGetSplitList current)
)
+ (calc-money-in-out-internal rest)
)
- accounts
)
)
+
+ (calc-money-in-out-internal accounts)
+ );;let
)
@@ -426,20 +407,8 @@
commodity-list to-date-tp
0 0))
- ;; -----------------------------------------------------------------
- ;; run the cash flow calculation
- ;; -----------------------------------------------------------------
- (set! money-in-alist '())
- (set! money-in-accounts '())
- (set! money-in-collector (gnc:make-commodity-collector))
- (set! money-out-accounts '())
- (set! money-out-alist '())
- (set! money-out-collector (gnc:make-commodity-collector))
- (calc-money-in-out accounts to-date-tp from-date-tp report-currency)
- ;; -----------------------------------------------------------------
- ;; present the result
- ;; -----------------------------------------------------------------
+ (calc-money-in-out accounts to-date-tp from-date-tp report-currency)
(money-diff-collector 'merge money-in-collector #f)
(money-diff-collector 'minusmerge money-out-collector #f)
commit f086c1871465c7b7e20c0349760a3320ff284d69
Author: Geert Janssens <janssens-geert at telenet.be>
Date: Fri Aug 1 11:38:03 2014 +0200
Revert "Bug #622778 Miscalculation in cashflow reports - Step 03"
This reverts commit 77ff6036551905f15c6819c0b2225f069b5f4257.
See bug 622778 and bug 722140 for more details.
diff --git a/src/report/standard-reports/cash-flow.scm b/src/report/standard-reports/cash-flow.scm
index 45a4229..c40f620 100644
--- a/src/report/standard-reports/cash-flow.scm
+++ b/src/report/standard-reports/cash-flow.scm
@@ -204,30 +204,11 @@
(gnc:timepair-ge parent-date-posted from-date-tp)
)
(let* (
- (parent-currency (xaccTransGetCurrency parent))
- (transaction-value (gnc-numeric-zero))
- (split-value (xaccSplitGetValue split))
+ (parent-currency (xaccTransGetCurrency parent))
)
;(gnc:debug (xaccTransGetDescription parent)
; " - "
; (gnc-commodity-get-printname parent-currency))
- ;; -------------------------------------------------------------
- ;; get the transaction value - needed to fix bug 622778
- ;; -------------------------------------------------------------
- (for-each
- (lambda (parent-split)
- (let* (
- (psv (xaccSplitGetValue parent-split))
- )
- (if (gnc-numeric-positive-p psv) ;; meaning: if (psv>0)
- (set! transaction-value
- (gnc-numeric-add transaction-value psv GNC-DENOM-AUTO GNC-DENOM-LCD)
- )
- )
- )
- )
- (xaccTransGetSplitList parent)
- )
;; -----------------------------------------
;; process all splits of current transaction
;; -----------------------------------------
@@ -235,6 +216,7 @@
(lambda (s)
(let* (
(s-account (xaccSplitGetAccount s))
+ (s-amount (xaccSplitGetAmount s))
(s-value (xaccSplitGetValue s))
(s-commodity (xaccAccountGetCommodity s-account))
)
@@ -253,30 +235,9 @@
(if (and ;; make sure we don't have
(not (null? s-account)) ;; any dangling splits
(not (account-in-list? s-account accounts))
- ;; only consider splits of opposite sign
- (gnc-numeric-negative-p (gnc-numeric-mul s-value split-value 0 GNC-DENOM-REDUCE))
)
(if (not (split-in-list? s seen-split-list))
- (let (
- (split-transaction-ratio (gnc-numeric-zero))
- )
- ;; -------------------------------------------------------------
- ;; get the share of the current split from the total transaction- needed to fix bug 622778
- ;; -------------------------------------------------------------
- (set! split-transaction-ratio
- (if (gnc-numeric-zero-p transaction-value)
- ;; If the transaction-value remained zero, then the transaction is
- ;; either 0 or we have a negative one-split-transaction.
- ;; Either way, it means that we can set the transaction value equal to the split-value,
- ;; and, in turn, the transaction ratio is 1.
- (gnc:make-gnc-numeric 1 1)
- ;; else
- (gnc-numeric-abs
- (gnc-numeric-div split-value transaction-value 0 GNC-DENOM-REDUCE)
- )
- )
- )
- (set! s-value (gnc-numeric-mul split-transaction-ratio s-value GNC-DENOM-AUTO GNC-RND-ROUND))
+ (begin
(set! seen-split-list (cons s seen-split-list))
(if (gnc-numeric-negative-p s-value)
;; -----------------------------------------------
@@ -286,7 +247,7 @@
(pair (account-in-alist s-account money-in-alist))
)
;(gnc:debug "in:" (gnc-commodity-get-printname s-commodity)
- ; (gnc-numeric-to-double (xaccSplitGetAmount s))
+ ; (gnc-numeric-to-double s-amount)
; (gnc-commodity-get-printname parent-currency)
; (gnc-numeric-to-double s-value))
(if (not pair)
@@ -303,7 +264,7 @@
(to-report-currency
parent-currency
(gnc-numeric-neg s-value)
- parent-date-posted
+ (gnc-transaction-get-date-posted parent)
)
)
)
@@ -319,7 +280,7 @@
(pair (account-in-alist s-account money-out-alist))
)
;(gnc:debug "out:" (gnc-commodity-get-printname s-commodity)
- ; (gnc-numeric-to-double (xaccSplitGetAmount s))
+ ; (gnc-numeric-to-double s-amount)
; (gnc-commodity-get-printname parent-currency)
; (gnc-numeric-to-double s-value))
(if (not pair)
@@ -336,7 +297,7 @@
(to-report-currency
parent-currency
s-value
- parent-date-posted
+ (gnc-transaction-get-date-posted parent)
)
)
)
commit f0abc2c0144145da030f3da698251adef9074f13
Author: Geert Janssens <janssens-geert at telenet.be>
Date: Fri Aug 1 11:37:20 2014 +0200
Revert "Round properly when computing fraction of the transaction's value due to a given split."
This reverts commit d33914139411a49429ec485dbd715a8559010945.
See bug 622778 and bug 722140 for more details.
diff --git a/src/report/standard-reports/cash-flow.scm b/src/report/standard-reports/cash-flow.scm
index 45dad7e..45a4229 100644
--- a/src/report/standard-reports/cash-flow.scm
+++ b/src/report/standard-reports/cash-flow.scm
@@ -254,7 +254,7 @@
(not (null? s-account)) ;; any dangling splits
(not (account-in-list? s-account accounts))
;; only consider splits of opposite sign
- (gnc-numeric-negative-p (gnc-numeric-mul s-value split-value GNC-DENOM-AUTO GNC-DENOM-REDUCE))
+ (gnc-numeric-negative-p (gnc-numeric-mul s-value split-value 0 GNC-DENOM-REDUCE))
)
(if (not (split-in-list? s seen-split-list))
(let (
@@ -272,12 +272,11 @@
(gnc:make-gnc-numeric 1 1)
;; else
(gnc-numeric-abs
- (gnc-numeric-div split-value transaction-value GNC-DENOM-AUTO GNC-DENOM-REDUCE)
+ (gnc-numeric-div split-value transaction-value 0 GNC-DENOM-REDUCE)
)
)
)
- (set! s-value (gnc-numeric-mul split-transaction-ratio s-value
- (gnc-commodity-get-fraction parent-currency) GNC-RND-ROUND))
+ (set! s-value (gnc-numeric-mul split-transaction-ratio s-value GNC-DENOM-AUTO GNC-RND-ROUND))
(set! seen-split-list (cons s seen-split-list))
(if (gnc-numeric-negative-p s-value)
;; -----------------------------------------------
commit f34c4e0f2fb3c3f2622d1cce8df0a0aadf2da875
Author: Geert Janssens <janssens-geert at telenet.be>
Date: Fri Aug 1 11:35:47 2014 +0200
Revert "The cash flow report should ignore splits in trading accounts."
This reverts commit 15e9bde7c3c190cb5385982343c3c545ab513baf.
See bug 622778 and 722140 for more details.
diff --git a/src/report/standard-reports/cash-flow.scm b/src/report/standard-reports/cash-flow.scm
index 0c1e91e..45dad7e 100644
--- a/src/report/standard-reports/cash-flow.scm
+++ b/src/report/standard-reports/cash-flow.scm
@@ -218,10 +218,8 @@
(lambda (parent-split)
(let* (
(psv (xaccSplitGetValue parent-split))
- (acct-type (xaccAccountGetType(xaccSplitGetAccount parent-split)))
)
- (if (and (gnc-numeric-positive-p psv) ;; meaning: if (psv>0)
- (not (eq? acct-type ACCT-TYPE-TRADING))) ;; not trading account split
+ (if (gnc-numeric-positive-p psv) ;; meaning: if (psv>0)
(set! transaction-value
(gnc-numeric-add transaction-value psv GNC-DENOM-AUTO GNC-DENOM-LCD)
)
@@ -255,7 +253,6 @@
(if (and ;; make sure we don't have
(not (null? s-account)) ;; any dangling splits
(not (account-in-list? s-account accounts))
- (not (eq? (xaccAccountGetType s-account) ACCT-TYPE-TRADING)) ;; not trading account
;; only consider splits of opposite sign
(gnc-numeric-negative-p (gnc-numeric-mul s-value split-value GNC-DENOM-AUTO GNC-DENOM-REDUCE))
)
Summary of changes:
src/report/standard-reports/cash-flow.scm | 444 +++++++++++-------------------
1 file changed, 157 insertions(+), 287 deletions(-)
More information about the gnucash-changes
mailing list