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