r22972 - gnucash/trunk/src/report/standard-reports - Bug #682800 Generated balances on Report different than calculated balances on Ledger when using "open subaccounts"

Geert Janssens gjanssens at code.gnucash.org
Fri May 10 15:06:51 EDT 2013


Author: gjanssens
Date: 2013-05-10 15:06:50 -0400 (Fri, 10 May 2013)
New Revision: 22972
Trac: http://svn.gnucash.org/trac/changeset/22972

Modified:
   gnucash/trunk/src/report/standard-reports/register.scm
Log:
Bug #682800 Generated balances on Report different than calculated balances on Ledger when using "open subaccounts"

Changes:

Part I
- bring in some more comments to ornament the code in
function (make-split-table)

Part II
In function (make-split-table), while going through the splits
- change the order of adding splits to the result table and
and updating the total collectors
Old oder:
1. add the splits to the result table
2. update the total collectors (for display at the end of the report)
New order:
1. update the total collectors with the values of the current splits
2. add the splits to the result table
Luckily this was implemented as two separate steps anyway, so this
part of the change can be done with copy/paste.

Part III
In function (make-split-table)
- change the call to (add-split-row) to also include the total-collector
- change the call to (add-other-split-rows) to also include the total-collector
In function (add-other-split-rows)
- change the definition of (add-split-row) to also include the total-collector
- change the call to (add-split-row) to also include the total-collector
In function (add-split-row)
- add the parameter "total-collector" to the function definition
- use this new parameter to display the current balance instead
of using the balance value from the split account.

Author:    Carsten Rinke <carsten.rinke at gmx.de>

Modified: gnucash/trunk/src/report/standard-reports/register.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/register.scm	2013-05-10 19:06:37 UTC (rev 22971)
+++ gnucash/trunk/src/report/standard-reports/register.scm	2013-05-10 19:06:50 UTC (rev 22972)
@@ -167,7 +167,7 @@
 
 (define (add-split-row table split column-vector row-style transaction-info?
                        split-info? action-for-num? ledger-type? double? memo?
-                       description?)
+                       description? total-collector)
   (let* ((row-contents '())
          (parent (xaccSplitGetParent split))
          (account (xaccSplitGetAccount split))
@@ -311,7 +311,7 @@
                      (gnc:html-split-anchor
                       split
                       (gnc:make-gnc-monetary
-                       currency (gnc:split-get-balance-display split-info? split))))
+                        currency (cadr (total-collector 'getpair currency #f)))))
                     " ")))
 
     (gnc:html-table-append-row/markup! table row-style
@@ -453,8 +453,15 @@
 
   gnc:*report-options*)
 
+;; -----------------------------------------------------------------
+;; create the report result
+;; -----------------------------------------------------------------
+
 (define (make-split-table splits options
                           debit-string credit-string amount-string)
+  ;; ----------------------------------
+  ;; local helper
+  ;; ----------------------------------
   (define (opt-val section name)
     (gnc:option-value (gnc:lookup-option options section name)))
   (define (reg-report-journal?)
@@ -542,7 +549,7 @@
       (total-value 'add trans-currency split-value)))
 
   (define (add-other-split-rows split table used-columns row-style
-                                action-for-num? ledger-type?)
+                                action-for-num? ledger-type? total-collector)
     (define (other-rows-driver split parent table used-columns i)
       (let ((current (xaccTransGetSplit parent i)))
         (if (not (null? current))
@@ -550,13 +557,17 @@
               (add-split-row table current used-columns row-style #f #t
                                 action-for-num? ledger-type? #f
                                 (opt-val "Display" "Memo")
-                                (opt-val "Display" "Description"))
+                                (opt-val "Display" "Description")
+                                total-collector)
               (other-rows-driver split parent table
                                  used-columns (+ i 1))))))
 
     (other-rows-driver split (xaccSplitGetParent split)
                        table used-columns 0))
 
+  ;; ----------------------------------
+  ;; main loop
+  ;; ----------------------------------
   (define (do-rows-with-subtotals leader
                                   splits
                                   table
@@ -574,8 +585,13 @@
                                   debit-value
                                   credit-value)
     (if (null? splits)
+      ;; ----------------------------------
+      ;; exit condition reached
+      ;; ----------------------------------
 	(begin
-	  ;; add debit/credit totals
+          ;; ------------------------------------
+	  ;; add debit/credit totals to the table
+          ;; ------------------------------------
 	  (if (reg-report-show-totals?)
 	      (begin
 		(add-subtotal-row (_ "Total Debits") leader table used-columns
@@ -593,6 +609,9 @@
           (add-subtotal-row (_ "Value Change") leader table used-columns
                             total-value "grand-total" #t))
 
+      ;; ----------------------------------
+      ;; process the splits list
+      ;; ----------------------------------
         (let* ((current (car splits))
                (current-row-style (if multi-rows? "normal-row"
                                       (if odd-row? "normal-row"
@@ -600,29 +619,11 @@
                (rest (cdr splits))
                (next (if (null? rest) #f
                          (car rest)))
-               ;; The general ledger has a split that doesn't have an account
-               ;; set yet (the new entry transaction).
-               ;; This split should be skipped or the report errors out.
-               ;; See bug #639082
-               (valid-split? (not (null? (xaccSplitGetAccount current))))
-               (split-value (if valid-split?
-                            (add-split-row table 
-                                           current 
-                                           used-columns 
-                                           current-row-style
-                                           #t
-                                           (not multi-rows?)
-                                           action-for-num?
-                                           ledger-type?
-                                           double?
-                                           (opt-val "Display" "Memo")
-                                           (opt-val "Display" "Description")))))
-
+               (valid-split? (not (null? (xaccSplitGetAccount current)))))
+          ;; ----------------------------------------------
+          ;; update totals, but don't add them to the table
+          ;; ----------------------------------------------
           (if (and multi-rows? valid-split?)
-              (add-other-split-rows 
-               current table used-columns "alternate-row" action-for-num? ledger-type?))
-
-          (if (and multi-rows? valid-split?)
               (for-each (lambda (split)
                           (if (string=? (gncAccountGetGUID
                                          (xaccSplitGetAccount current))
@@ -637,6 +638,39 @@
                                  total-collector total-value
                                  debit-collector debit-value
                                  credit-collector credit-value))
+          ;; ----------------------------------
+          ;; add the splits to the table
+          ;; ----------------------------------
+          ;; The general ledger has a split that doesn't have an account
+          ;; set yet (the new entry transaction).
+          ;; This split should be skipped or the report errors out.
+          ;; See bug #639082
+          (if valid-split?
+            (add-split-row
+              table
+              current
+              used-columns
+              current-row-style
+              #t
+              (not multi-rows?)
+              action-for-num?
+              ledger-type?
+              double?
+              (opt-val "Display" "Memo")
+              (opt-val "Display" "Description")
+              total-collector
+            )
+          )
+          (if (and multi-rows? valid-split?)
+            (add-other-split-rows
+              current
+              table used-columns
+              "alternate-row"
+              action-for-num?
+              ledger-type?
+              total-collector
+            )
+          )
 
           (do-rows-with-subtotals leader
                                   rest
@@ -654,7 +688,9 @@
                                   total-value
                                   debit-value
                                   credit-value))))
-
+  ;; -----------------------------------------------
+  ;; needed for the call to (do-rows-with-subtotals)
+  ;; -----------------------------------------------
   (define (splits-leader splits)
     (let ((accounts (map xaccSplitGetAccount splits)))
       (if (null? accounts) '()
@@ -663,7 +699,9 @@
                                  (delete (car accounts) (cdr accounts))))
             (if (not (null? (cdr accounts))) '()
                 (car accounts))))))
-
+  ;; ----------------------------------
+  ;; make the split table
+  ;; ----------------------------------
   (let* ((table (gnc:make-html-table))
          (used-columns (build-column-used options))
          (width (num-columns-required used-columns))
@@ -696,7 +734,9 @@
                             (gnc:make-commodity-collector)
                             (gnc:make-commodity-collector))
     table))
-
+;; -----------------------------------------------------------------
+;; misc
+;; -----------------------------------------------------------------
 (define (string-expand string character replace-string)
   (define (car-line chars)
     (take-while (lambda (c) (not (eqv? c character))) chars))



More information about the gnucash-changes mailing list