[Gnucash-changes] David Montenegro's patch for trial-balance (bug #144265).

Derek Atkins warlord at cvs.gnucash.org
Tue Jul 13 12:07:59 EDT 2004


Log Message:
-----------
David Montenegro's patch for trial-balance (bug #144265).

        * src/report/standard-reports/trial-balance.scm:
        * src/report/standard-reports/standard-reports.scm:
        * src/report/standard-reports/Makefile.am
          added Trial Balance/Work Sheet report

        * src/report/standard-reports/balance-sheet.scm:
          added drop-down choices missing in previous version
          added support for adjusting/closing entries

        * src/report/standard-reports/equity-statement.scm:
          added support for adjusting/closing entries
          fixed "For Period Covering" label
          fixed handling of unrealized gains
          investment/draw discrimination based on shares sign
          omit unrealized gains when zero

        * src/report/report-system/html-acct-table.scm:
        * src/report/report-system/html-table.scm:
          null reference bug fixes

        * src/report/report-system/report-utilities.scm:
          added utility functions for accessing splits
          and creating double-column balance HTML
          gnc:double-col,
          gnc:account-get-trans-type-balance-interval,
          gnc:account-get-pos-trans-total-interval

        * src/report/report-system/commodity-utilities.scm:
        * src/report/report-system/html-acct-table.scm:
        * src/report/report-system/report-utilities.scm:
          moved gnc:commodity-collector-commodity-count and
          gnc:uniform-commodity? into commodity-utilities.scm

        * src/report/report-system/report-system.scm:
          added some additional exports

Modified Files:
--------------
    gnucash:
        ChangeLog
    gnucash/src/report/report-system:
        commodity-utilities.scm
        html-acct-table.scm
        html-table.scm
        report-system.scm
        report-utilities.scm
    gnucash/src/report/standard-reports:
        Makefile.am
        balance-sheet.scm
        equity-statement.scm
        pnl.scm
        standard-reports.scm

Revision Data
-------------
Index: ChangeLog
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/ChangeLog,v
retrieving revision 1.1824
retrieving revision 1.1825
diff -LChangeLog -LChangeLog -u -r1.1824 -r1.1825
--- ChangeLog
+++ ChangeLog
@@ -1,3 +1,43 @@
+2004-07-13  David Montenegro  <sunrise2000 at comcast.net>
+
+        * src/report/standard-reports/trial-balance.scm:
+        * src/report/standard-reports/standard-reports.scm:
+        * src/report/standard-reports/Makefile.am
+          added Trial Balance/Work Sheet report
+
+        * src/report/standard-reports/balance-sheet.scm:
+          added drop-down choices missing in previous version
+          added support for adjusting/closing entries
+
+        * src/report/standard-reports/equity-statement.scm:
+          added support for adjusting/closing entries
+          fixed "For Period Covering" label
+          fixed handling of unrealized gains
+          investment/draw discrimination based on shares sign
+          omit unrealized gains when zero
+
+        * src/report/report-system/html-acct-table.scm:
+        * src/report/report-system/html-table.scm:
+          null reference bug fixes
+
+        * src/report/report-system/report-utilities.scm:
+          added utility functions for accessing splits
+          and creating double-column balance HTML
+          gnc:double-col,
+          gnc:account-get-trans-type-balance-interval,
+          gnc:account-get-pos-trans-total-interval
+
+        * src/report/report-system/commodity-utilities.scm:
+        * src/report/report-system/html-acct-table.scm:
+        * src/report/report-system/report-utilities.scm:
+          moved gnc:commodity-collector-commodity-count and
+          gnc:uniform-commodity? into commodity-utilities.scm
+
+        * src/report/report-system/report-system.scm:
+          added some additional exports
+
+	Bug #144265
+
 2004-07-04  Derek Atkins  <derek at ihtfp.com>
 
 	* acinclude.m4: create a SCANF_QD_CHECK and make sure both
Index: report-system.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/report-system/report-system.scm,v
retrieving revision 1.24
retrieving revision 1.25
diff -Lsrc/report/report-system/report-system.scm -Lsrc/report/report-system/report-system.scm -u -r1.24 -r1.25
--- src/report/report-system/report-system.scm
+++ src/report/report-system/report-system.scm
@@ -68,6 +68,7 @@
 
 ;; html-utilities.scm 
 
+(export gnc:html-make-empty-cell)
 (export gnc:html-make-empty-cells)
 (export gnc:account-anchor-text)
 (export gnc:split-anchor-text)
@@ -593,6 +594,9 @@
 (export gnc:report-finished)
 (export gnc:accounts-count-splits)
 (export gnc:commodity-collector-allzero?)
+(export gnc:account-get-trans-type-balance-interval)
+(export gnc:account-get-pos-trans-total-interval)
+(export gnc:double-col)
 
 (load-from-path "commodity-utilities.scm")
 (load-from-path "html-barchart.scm")
Index: html-table.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/report-system/html-table.scm,v
retrieving revision 1.2
retrieving revision 1.3
diff -Lsrc/report/report-system/html-table.scm -Lsrc/report/report-system/html-table.scm -u -r1.2 -r1.3
--- src/report/report-system/html-table.scm
+++ src/report/report-system/html-table.scm
@@ -405,19 +405,25 @@
 ;;   (let ((a '(0 1 2))) (list-set! a 1 "x") a)
 ;;    => (0 "x" 2)
 (define (gnc:html-table-get-cell table row col)
-  (list-ref-safe (gnc:html-table-get-row table row) col))
+  (let* ((row (gnc:html-table-get-row table row)))
+    (and row (list-ref-safe row col)))
+  )
 
 (define (gnc:html-table-get-row table row)
   (let* ((dd (gnc:html-table-data table))
-	 (len (length dd))
+	 (len (and dd (length dd)))
+	 )
+    (and len
+	 (list-ref-safe dd (- (- len 1) row))
 	 )
-    (list-ref-safe dd (- (- len 1) row))
     ))
 
 (define (gnc:html-table-set-cell! table row col . objects)
   (let ((rowdata #f)
 	(row-loc #f)
-        (l (length (gnc:html-table-data table))))
+        (l (length (gnc:html-table-data table)))
+	(objs (length objects))
+	)
     ;; ensure the row-data is there 
     (if (>= row l)
 	(begin
@@ -433,8 +439,12 @@
 	  (set! rowdata (list-ref (gnc:html-table-data table) row-loc))))
     
     ;; make a table-cell and set the data 
-    (let ((tc (gnc:make-html-table-cell)))
-      (apply gnc:html-table-cell-append-objects! tc objects)
+    (let* ((tc (gnc:make-html-table-cell))
+	   (first (car objects)))
+      (if (and (equal? objs 1) (gnc:html-table-cell? first))
+	  (set! tc first)
+	  (apply gnc:html-table-cell-append-objects! tc objects)
+	  )
       (set! rowdata (list-set-safe! rowdata col tc))
       
       ;; add the row-data back to the table 
Index: commodity-utilities.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/report-system/commodity-utilities.scm,v
retrieving revision 1.13
retrieving revision 1.14
diff -Lsrc/report/report-system/commodity-utilities.scm -Lsrc/report/report-system/commodity-utilities.scm -u -r1.13 -r1.14
--- src/report/report-system/commodity-utilities.scm
+++ src/report/report-system/commodity-utilities.scm
@@ -906,3 +906,30 @@
 	 #f)
 	balance)
       #f))
+
+;; Returns the number of commodities in a commodity-collector.
+;; (If this were implemented as a record, I would be able to
+;; just (length ...) the alist, but....)
+(define (gnc:commodity-collector-commodity-count collector)
+    (let ((commodities 0))
+	(gnc:commodity-collector-map
+	    collector
+		(lambda (comm amt)
+		  (set! commodities (+ commodities 1))))
+	commodities
+    ))
+
+(define (gnc:uniform-commodity? amt report-commodity)
+  ;; function to see if the commodity-collector amt
+  ;; contains any foreign commodities
+  (let ((elts (gnc:commodity-collector-commodity-count amt))
+	)
+    (or (equal? elts 0)
+	(and (equal? elts 1)
+	     (gnc:commodity-collector-contains-commodity?
+	      amt report-commodity)
+	     )
+	)
+    )
+  )
+
Index: report-utilities.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/report-system/report-utilities.scm,v
retrieving revision 1.20
retrieving revision 1.21
diff -Lsrc/report/report-system/report-utilities.scm -Lsrc/report/report-system/report-utilities.scm -u -r1.20 -r1.21
--- src/report/report-system/report-utilities.scm
+++ src/report/report-system/report-utilities.scm
@@ -474,17 +474,6 @@
 (define (gnc:commodity-collector-list collector)
   (collector 'list #f #f))
 
-;; Returns the number of commodities in a commodity-collector.
-;; (If this were implemented as a record, I would be able to
-;; just (length ...) the alist, but....)
-(define (gnc:commodity-collector-commodity-count collector)
-    (let ((commodities 0))
-	(gnc:commodity-collector-map
-	    collector
-		(lambda (comm amt) (set! commodities (+ commodities 1))))
-	commodities
-    ))
-
 ;; Returns zero if all entries in this collector are zero.
 (define (gnc:commodity-collector-allzero? collector)
   (let ((result #t))
@@ -706,3 +695,142 @@
 	 (gnc:accounts-count-splits (cdr accounts)))
       0))
 
+;; Sums up any splits of a certain type affecting a group of accounts.
+;; the type is an alist '((str "match me") (cased #f) (regexp #f))
+(define (gnc:account-get-trans-type-balance-interval
+	 group type start-date-tp end-date-tp)
+  (let* ((query (gnc:malloc-query))
+	 (splits #f)
+	 (get-val (lambda (alist key)
+		    (let ((lst (assoc-ref alist key)))
+		      (if lst (car lst) lst))))
+	 (matchstr (get-val type 'str))
+	 (case-sens (if (get-val type 'cased) 1 0))
+	 (regexp (if (get-val type 'regexp) 1 0))
+	 (total (gnc:make-commodity-collector))
+	 )
+    (gnc:query-set-book query (gnc:get-current-book))
+    (gnc:query-set-match-non-voids-only! query (gnc:get-current-book))
+    (gnc:query-add-account-match query group 'guid-match-any 'query-and)
+    (gnc:query-add-date-match-timepair
+     query
+     (and start-date-tp #t) start-date-tp
+     (and end-date-tp #t) end-date-tp 'query-and)
+    (gnc:query-add-description-match
+     query matchstr case-sens regexp 'query-and)
+    
+    (set! splits (gnc:query-get-splits query))
+    (map (lambda (split)
+		(let* ((shares (gnc:split-get-amount split))
+		       (acct-comm (gnc:account-get-commodity
+				   (gnc:split-get-account split)))
+		       )
+		  (gnc:commodity-collector-add total acct-comm shares)
+		  )
+		)
+	 splits
+	 )
+    (gnc:free-query query)
+    total
+    )
+  )
+
+;; similar, but only counts transactions with non-negative shares and
+;; *ignores* any closing entries
+(define (gnc:account-get-pos-trans-total-interval
+	 group type start-date-tp end-date-tp)
+  (let* ((str-query (gnc:malloc-query))
+	 (sign-query (gnc:malloc-query))
+	 (total-query #f)
+         (splits #f)
+	 (get-val (lambda (alist key)
+		    (let ((lst (assoc-ref alist key)))
+		      (if lst (car lst) lst))))
+	 (matchstr (get-val type 'str))
+	 (case-sens (if (get-val type 'cased) 1 0))
+	 (regexp (if (get-val type 'regexp) 1 0))
+         (total (gnc:make-commodity-collector))
+         )
+    (gnc:query-set-book str-query (gnc:get-current-book))
+    (gnc:query-set-book sign-query (gnc:get-current-book))
+    (gnc:query-set-match-non-voids-only! str-query (gnc:get-current-book))
+    (gnc:query-set-match-non-voids-only! sign-query (gnc:get-current-book))
+    (gnc:query-add-account-match str-query group 'guid-match-any 'query-and)
+    (gnc:query-add-account-match sign-query group 'guid-match-any 'query-and)
+    (gnc:query-add-date-match-timepair
+     str-query
+     (and start-date-tp #t) start-date-tp
+     (and end-date-tp #t) end-date-tp 'query-and)
+    (gnc:query-add-date-match-timepair
+     sign-query
+     (and start-date-tp #t) start-date-tp
+     (and end-date-tp #t) end-date-tp 'query-and)
+    (gnc:query-add-description-match
+     str-query matchstr case-sens regexp 'query-and)
+    (set! total-query
+	  (gnc:query-merge sign-query (gnc:query-invert str-query) 'query-and))
+    
+    (set! splits (gnc:query-get-splits total-query))
+    (map (lambda (split)
+	   (let* ((shares (gnc:split-get-amount split))
+		  (acct-comm (gnc:account-get-commodity
+			      (gnc:split-get-account split)))
+		  )
+	     (or (gnc:numeric-negative-p shares)
+		 (gnc:commodity-collector-add total acct-comm shares)
+		 )
+	     )
+	   )
+         splits
+         )
+    (gnc:free-query total-query)
+    total
+    )
+  )
+
+;; utility to assist with double-column balance tables
+;; a request is made with the <req> argument
+;; <req> may currently be 'entry|'debit-q|'credit-q|'zero-q|'debit|'credit
+;; 'debit-q|'credit-q|'zero-q tests the sign of the balance
+;; 'side returns 'debit or 'credit, the column in which to display
+;; 'debt|'credit return the entry, if appropriate, or #f
+(define (gnc:double-col
+	 req signed-balance report-commodity exchange-fn show-comm?)
+  (let* ((sum (and signed-balance
+		   (gnc:sum-collector-commodity
+		    signed-balance
+		    report-commodity
+		    exchange-fn)))
+	 (amt (and sum (gnc:gnc-monetary-amount sum)))
+	 (neg? (and amt (gnc:numeric-negative-p amt)))
+	 (bal (if neg?
+		  (let ((bal (gnc:make-commodity-collector)))
+		    (bal 'minusmerge signed-balance #f)
+		    bal)
+		  signed-balance))
+	 (bal-sum (gnc:sum-collector-commodity
+		   bal
+		   report-commodity
+		   exchange-fn))
+	 (balance
+	  (if (gnc:uniform-commodity? bal report-commodity)
+	      (if (gnc:numeric-zero-p amt) #f bal-sum)
+	      (if show-comm?
+		  (gnc:commodity-table bal report-commodity exchange-fn)
+		  bal-sum)
+	      ))
+	 )
+    (car (assoc-ref
+	  (list
+	   (list 'entry balance)
+	   (list 'debit (if neg? #f balance))
+	   (list 'credit (if neg? balance #f))
+	   (list 'zero-q (if neg? #f (if balance #f #t)))
+	   (list 'debit-q (if neg? #f (if balance #t #f)))
+	   (list 'credit-q (if neg? #t #f))
+	   )
+	  req
+	  ))
+    )
+  )
+
Index: html-acct-table.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/report-system/html-acct-table.scm,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lsrc/report/report-system/html-acct-table.scm -Lsrc/report/report-system/html-acct-table.scm -u -r1.1 -r1.2
--- src/report/report-system/html-acct-table.scm
+++ src/report/report-system/html-acct-table.scm
@@ -62,7 +62,7 @@
 ;; 
 ;; The list of accounts which are to be placed in the
 ;; gnc:html-acct-table object can be controled with the
-;; gnc:make-html-acct-table/accts, gnc:make-html-acct-table/accts/env,
+;; gnc:make-html-acct-table/accts, gnc:make-html-acct-table/env/accts,
 ;; and gnc:html-table-add-accts!  functions.  
 ;; 
 ;; The gnc:html-acct-table parameters, set with
@@ -741,10 +741,12 @@
 (define (gnc:html-acct-table-get-cell acct-table row col)
   ;; we'll only ever store one object in an html-table-cell
   ;; returns the first object stored in that cell
-  (car (gnc:html-table-cell-data
-	(gnc:html-table-get-cell
-	 (gnc:_html-acct-table-matrix_ acct-table)
-	 row (+ col 1)))))
+  (let* ((cell (gnc:html-table-get-cell
+		(gnc:_html-acct-table-matrix_ acct-table)
+		row (+ col 1))))
+    (and cell (car (gnc:html-table-cell-data cell)))
+    )
+  )
 
 (define (gnc:html-acct-table-set-cell! acct-table row col obj)
   (gnc:html-table-set-cell!
@@ -753,7 +755,8 @@
    obj))
 
 (define (gnc:html-acct-table-get-row-env acct-table row)
-  (gnc:html-acct-table-get-cell acct-table row -1))
+  (gnc:html-acct-table-get-cell acct-table row -1)
+  )
 
 (define (gnc:html-acct-table-set-row-env! acct-table row env)
   (gnc:html-acct-table-set-cell! acct-table row -1 env))
@@ -888,21 +891,6 @@
     table)
   )
 
-(define (gnc:uniform-commodity? amt report-commodity)
-  ;; function to see if the commodity-collector amt
-  ;; contains any foreign commodities
-  (lambda (amt)
-    (let ((elts (gnc:commodity-collector-commodity-count amt))
-	  )
-      (or (equal? elts 0)
-	  (and (equal? elts 1)
-	       (gnc:commodity-collector-contains-commodity?
-		amt report-commodity)
-	       )
-	  )
-      )
-    ))
-
 ;; 
 ;; This function adds all the lines from a gnc:html-acct-table to a
 ;; gnc:html-table in "labeled amount" form.
Index: standard-reports.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/standard-reports/standard-reports.scm,v
retrieving revision 1.16
retrieving revision 1.17
diff -Lsrc/report/standard-reports/standard-reports.scm -Lsrc/report/standard-reports/standard-reports.scm -u -r1.16 -r1.17
--- src/report/standard-reports/standard-reports.scm
+++ src/report/standard-reports/standard-reports.scm
@@ -80,6 +80,7 @@
 (use-modules (gnucash report portfolio))
 (use-modules (gnucash report price-scatter))
 (use-modules (gnucash report register))
+(use-modules (gnucash report trial-balance))
 (use-modules (gnucash report transaction))
 
 (use-modules (gnucash gnc-module))
Index: pnl.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/standard-reports/pnl.scm,v
retrieving revision 1.13
retrieving revision 1.14
diff -Lsrc/report/standard-reports/pnl.scm -Lsrc/report/standard-reports/pnl.scm -u -r1.13 -r1.14
--- src/report/standard-reports/pnl.scm
+++ src/report/standard-reports/pnl.scm
@@ -22,6 +22,22 @@
 ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 
+;; FIXME
+;; 
+;; Note: the current P&L report must be done before closing, when
+;; there are still balances in your income/expense accounts. if run
+;; post-closing, this implementation will report zero profit.  in
+;; other words, users will generally want to run this report after
+;; adjustments but before closing. this code really should filter-out
+;; closing (but not adjusting) entries and report on what is left....
+;; 
+;;  (see equity-statement.scm for an example of how to do this)
+;; 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
 (define-module (gnucash report pnl))
 
 (use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
@@ -35,7 +51,7 @@
 
 ;; Profit and loss report. Actually, people in finances might want
 ;; something different under this name, but they are welcomed to
-;; contribute their changes :-)
+;; contribute their changes :-)  (perhaps income statement)
 
 (define reportname (N_ "Profit And Loss"))
 
Index: Makefile.am
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/standard-reports/Makefile.am,v
retrieving revision 1.15
retrieving revision 1.16
diff -Lsrc/report/standard-reports/Makefile.am -Lsrc/report/standard-reports/Makefile.am -u -r1.15 -r1.16
--- src/report/standard-reports/Makefile.am
+++ src/report/standard-reports/Makefile.am
@@ -37,6 +37,7 @@
    price-scatter.scm \
    register.scm \
    standard-reports.scm \
+   trial-balance.scm \
    transaction.scm 
 
 EXTRA_DIST = ${gncscmmod_DATA}
Index: balance-sheet.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/standard-reports/balance-sheet.scm,v
retrieving revision 1.16
retrieving revision 1.17
diff -Lsrc/report/standard-reports/balance-sheet.scm -Lsrc/report/standard-reports/balance-sheet.scm -u -r1.16 -r1.17
--- src/report/standard-reports/balance-sheet.scm
+++ src/report/standard-reports/balance-sheet.scm
@@ -30,6 +30,7 @@
 ;;    
 ;;    Line & column alignments still do not conform with
 ;;    textbook accounting practice (they're close though!).
+;;    The 'canonically-tabbed option is currently broken.
 ;;    
 ;;    Progress bar functionality is currently mostly broken.
 ;;    
@@ -101,13 +102,12 @@
 (define opthelp-bottom-behavior
   (N_ "Displays accounts which exceed the depth limit at the depth limit"))
 
-(define optname-show-parent-balance (N_ "Show any balance in parent accounts"))
-(define opthelp-show-parent-balance (N_ "Show any balance in parent accounts"))
-;; FIXME optname-show-parent-balance needs immediate/recursive/omit choices
-(define optname-show-parent-total (N_ "Show parent account subtotals"))
-(define opthelp-show-parent-total
-  (N_ "Show account subtotals for all selected accounts having children"))
-;; FIXME optname-show-parent-total needs a 'canonically-tabbed choice
+(define optname-parent-balance-mode (N_ "Parent account balances"))
+(define opthelp-parent-balance-mode
+  (N_ "How to show any balance in parent accounts"))
+(define optname-parent-total-mode (N_ "Parent account subtotals"))
+(define opthelp-parent-total-mode
+  (N_ "How to show account subtotals for selected accounts having children"))
 
 (define optname-show-zb-accts (N_ "Include accounts with zero total balances"))
 (define opthelp-show-zb-accts
@@ -272,14 +272,36 @@
       gnc:pagename-display optname-omit-zb-bals
       "b" opthelp-omit-zb-bals #f))
     ;; what to show for non-leaf accounts
-    (add-option 
-     (gnc:make-simple-boolean-option
-      gnc:pagename-display optname-show-parent-balance 
-      "c" opthelp-show-parent-balance #t))
-    (add-option 
-     (gnc:make-simple-boolean-option
-      gnc:pagename-display optname-show-parent-total
-      "d" opthelp-show-parent-total #f))
+    (add-option
+     (gnc:make-multichoice-option
+      gnc:pagename-display optname-parent-balance-mode
+      "c" opthelp-parent-balance-mode
+      'immediate-bal
+      (list (vector 'immediate-bal
+		    (N_ "Show Immediate Balance")
+		    (N_ "Show only the balance in the parent account, excluding any subaccounts"))
+	    (vector 'recursive-bal
+		    (N_ "Recursive Balance")
+		    (N_ "Include subaccounts in balance"))
+	    (vector 'omit-bal
+		    (N_ "Omit Balance")
+		    (N_ "Do not show parent account balances")))))
+    (add-option
+     (gnc:make-multichoice-option
+      gnc:pagename-display optname-parent-total-mode
+      "d" opthelp-parent-total-mode
+      'f
+      (list (vector 't
+		    (N_ "Show subtotals")
+		    (N_ "Show subtotals for selected accounts which have subaccounts"))
+	    (vector 'f
+		    (N_ "Do not show subtotals")
+		    (N_ "Do not subtotal selected parent accounts"))
+	    (vector 'canonically-tabbed
+		    ;;(N_ "Subtotals indented text book style")
+		    (N_ "Text book style (experimental)")
+		    (N_ "Show parent account subtotals, indented per text book practice (experimental)")))))
+    
     ;; some detailed formatting options
     (add-option 
      (gnc:make-simple-boolean-option
@@ -362,10 +384,13 @@
                                  optname-show-foreign))
          (show-rates? (get-option pagename-commodities
                                   optname-show-rates))
-         (show-parent-balance? (get-option gnc:pagename-display
-                                           optname-show-parent-balance))
-         (show-parent-total? (get-option gnc:pagename-display
-                                         optname-show-parent-total))
+         (parent-balance-mode (get-option gnc:pagename-display
+                                           optname-parent-balance-mode))
+         (parent-total-mode
+	  (car
+	   (assoc-ref '((t #t) (f #f) (canonically-tabbed canonically-tabbed))
+		      (get-option gnc:pagename-display
+				  optname-parent-total-mode))))
          (show-zb-accts? (get-option gnc:pagename-display
 				     optname-show-zb-accts))
          (omit-zb-bals? (get-option gnc:pagename-display
@@ -409,7 +434,7 @@
 	 ;; (asset, liability, equity) have the same width.
          (tree-depth (if (equal? depth-limit 'all)
                          (gnc:get-current-group-depth) 
-                         depth-limit))
+			 depth-limit))
          ;; exchange rates calculation parameters
 	 (exchange-fn
 	  (gnc:case-exchange-fn price-source report-commodity date-tp))
@@ -420,6 +445,7 @@
     (define (add-subtotal-line table pos-label neg-label signed-balance)
       (define allow-same-column-totals #t)
       (let* ((neg? (and signed-balance
+			neg-label
 			(gnc:numeric-negative-p
 			 (gnc:gnc-monetary-amount
 			  (gnc:sum-collector-commodity
@@ -459,7 +485,7 @@
     
     ;;(gnc:warn "account names" liability-account-names)
     (gnc:html-document-set-title! 
-     doc (string-append report-title " " company-name " "
+     doc (string-append company-name " " report-title " "
 			(gnc:print-date date-tp))
      )
     
@@ -616,7 +642,7 @@
 						 'summarize))
 		 (list 'report-commodity report-commodity)
 		 (list 'exchange-fn exchange-fn)
-		 (list 'parent-account-subtotal-mode show-parent-total?)
+		 (list 'parent-account-subtotal-mode parent-total-mode)
 		 (list 'zero-balance-mode (if show-zb-accts?
 					      'show-leaf-acct
 					      'omit-leaf-acct))
@@ -627,11 +653,7 @@
 		)
 	  (set! params
 		(list
-		 (list 'parent-account-balance-mode
-		       (if show-parent-balance?
-			   'immediate-bal
-			   'omit-bal
-			   ))
+		 (list 'parent-account-balance-mode parent-balance-mode)
 		 (list 'zero-balance-display-mode (if omit-zb-bals?
 						      'omit-balance
 						      'show-balance))
Index: equity-statement.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/standard-reports/equity-statement.scm,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lsrc/report/standard-reports/equity-statement.scm -Lsrc/report/standard-reports/equity-statement.scm -u -r1.1 -r1.2
--- src/report/standard-reports/equity-statement.scm
+++ src/report/standard-reports/equity-statement.scm
@@ -19,7 +19,8 @@
 ;;    statement to no more than daily resolution.
 ;;    
 ;;    The Accounts option panel needs a way to select (and select by
-;;    default) capital and draw accounts.
+;;    default) capital and draw accounts. There really should be a
+;;    contra account type or attribute....
 ;;    
 ;;    The variables in this code could use more consistent naming.
 ;;    
@@ -87,6 +88,19 @@
 (define optname-show-rates (N_ "Show Exchange Rates"))
 (define opthelp-show-rates (N_ "Show the exchange rates used"))
 
+(define pagename-entries (N_ "Entries"))
+(define optname-closing-pattern (N_ "Closing Entries pattern"))
+(define opthelp-closing-pattern
+  (N_ "Any text in the Description column which identifies closing entries"))
+(define optname-closing-casing
+  (N_ "Closing Entries pattern is case-sensitive"))
+(define opthelp-closing-casing
+  (N_ "Causes the Closing Entries Pattern match to be case-sensitive"))
+(define optname-closing-regexp
+  (N_ "Closing Entries Pattern is regular expression"))
+(define opthelp-closing-regexp
+  (N_ "Causes the Closing Entries Pattern to be treated as a regular expression"))
+
 ;; This calculates the increase in the balance(s) of all accounts in
 ;; <accountlist> over the period from <start-date> to <end-date>.
 ;; Returns a commodity collector.
@@ -189,6 +203,23 @@
       gnc:pagename-display optname-use-rules
       "f" opthelp-use-rules #f))
     
+    ;; adjusting/closing entry match criteria
+    ;; 
+    ;; N.B.: transactions really should have a field where we can put
+    ;; transaction types like "Adjusting/Closing/Correcting Entries"
+    (add-option
+      (gnc:make-string-option
+      pagename-entries optname-closing-pattern
+      "a" opthelp-closing-pattern (N_ "Closing Entries")))
+    (add-option
+     (gnc:make-simple-boolean-option
+      pagename-entries optname-closing-casing
+      "b" opthelp-closing-casing #f))
+    (add-option
+     (gnc:make-simple-boolean-option
+      pagename-entries optname-closing-regexp
+      "c" opthelp-closing-regexp #f))
+    
     ;; Set the accounts page as default option tab
     (gnc:options-set-default-section options gnc:pagename-accounts)
     
@@ -241,6 +272,12 @@
                                   optname-show-rates))
          (use-rules? (get-option gnc:pagename-display
 				    optname-use-rules))
+	 (closing-str (get-option pagename-entries
+				  optname-closing-pattern))
+	 (closing-cased (get-option pagename-entries
+				    optname-closing-casing))
+	 (closing-regexp (get-option pagename-entries
+				     optname-closing-regexp))
 	 
          ;; decompose the account list
          (split-up-accounts (gnc:decompose-accountlist accounts))
@@ -257,6 +294,16 @@
 	 ;; these must still be split-out and itemized separately
 	 (capital-accounts #f)
 	 (drawing-accounts #f)
+	 (investments #f)
+	 (withdrawals #f)
+	 (net-investment #f)
+	 (income-expense-closing #f)
+	 (closing-pattern
+	  (list (list 'str closing-str)
+		(list 'cased closing-cased)
+		(list 'regexp closing-regexp)
+		)
+	  )
 	 
          (doc (gnc:make-html-document))
          ;; exchange rates calculation parameters
@@ -271,11 +318,11 @@
     (gnc:html-document-set-title! 
      doc (sprintf #f
 		  (string-append "%s %s "
-				 (N_ "For Period")
+				 (N_ "For Period Covering")
 				 " %s "
 				 (N_ "to")
 				 " %s")
-		  report-title company-name
+		  company-name report-title
                   (gnc:print-date start-date-printable)
                   (gnc:print-date end-date-tp)))
     
@@ -303,6 +350,8 @@
                (neg-start-equity-balance #f)
                (neg-end-equity-balance #f)
 	       
+	       ;; these variables wont be used until gnucash gets
+	       ;; conta account types
                (start-capital-balance #f)
                (end-capital-balance #f)
                (start-drawing-balance #f)
@@ -315,14 +364,14 @@
 	       (end-unrealized-gains #f)
 	       (net-unrealized-gains #f)
 	       
-	       (start-total-equity #f)
-	       (end-total-equity #f)
-	       
-	       (investments #f)
-	       (draws #f)
+	       (equity-closing #f)
+	       (neg-pre-closing-equity #f)
 	       
 	       (capital-increase #f)
 	       
+	       (start-total-equity #f)
+	       (end-total-equity #f)
+	       
 	       ;; Create the account table below where its
 	       ;; percentage time can be tracked.
 	       (build-table (gnc:make-html-table)) ;; gnc:html-table
@@ -350,6 +399,7 @@
 		   table pos-label neg-label amount col
 		   exchange-fn rule? row-style)
 	    (let* ((neg? (and amount
+			      neg-label
 			      (gnc:numeric-negative-p
 			       (gnc:gnc-monetary-amount
 				(gnc:sum-collector-commodity
@@ -363,10 +413,11 @@
 		   (bal (gnc:sum-collector-commodity
 			 pos-bal report-commodity exchange-fn))
 		   (balance
-		    (or (and (gnc:uniform-commodity? bal report-commodity) bal)
+		    (or (and (gnc:uniform-commodity? pos-bal report-commodity)
+			     bal)
 			(and show-fucr?
 			     (gnc:commodity-table
-			      bal report-commodity exchange-fn))
+			      pos-bal report-commodity exchange-fn))
 			bal
 			))
 		   (column (or col 0))
@@ -444,12 +495,26 @@
 		(accountlist-get-comm-balance-at-date
 		 income-expense-accounts
 		 forever-ago end-date-tp)) ; OK
+	  ;; neg-pre-end-retained-earnings is not used to calculate
+	  ;; profit but is used to calculate unrealized gains
+	  
+	  ;; calculate net income
+	  ;; first, ask out how much profit/loss was closed
+	  (set! income-expense-closing
+		(gnc:account-get-trans-type-balance-interval
+		 income-expense-accounts closing-pattern
+		 start-date-tp end-date-tp)
+		)
+	  ;; find retained earnings for the period
 	  (set! neg-net-income
 		(accountlist-get-comm-balance-at-date
 		 income-expense-accounts
 		 start-date-tp end-date-tp)) ; OK
+	  ;; revert the income/expense to its pre-closing balance
+	  (neg-net-income 'minusmerge income-expense-closing #f)
 	  (set! net-income (gnc:make-commodity-collector))
 	  (net-income 'minusmerge neg-net-income #f)
+	  ;; now we know the net income for the period
 	  
 	  ;; start and end (unadjusted) equity balances
 	  (set! neg-start-equity-balance
@@ -458,6 +523,8 @@
 	  (set! neg-end-equity-balance
                 (gnc:accounts-get-comm-total-assets 
                  equity-accounts get-end-balance-fn)) ; OK
+	  ;; neg-end-equity-balance is used to calculate unrealized
+	  ;; gains and investments/withdrawals
 	  
 	  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 	  ;; 
@@ -482,6 +549,10 @@
 		(unrealized-gains-at-date start-book-balance
 					  start-exchange-fn
 					  start-date-tp)) ; OK
+	  ;; I suspect that unrealized gains (since never realized)
+	  ;; must be counted from forever-ago....
+	  ;; ...yep, this appears to be correct.
+	  (set! start-unrealized-gains (gnc:make-commodity-collector))
 	  (set! end-unrealized-gains
 		(unrealized-gains-at-date end-book-balance
 					  end-exchange-fn
@@ -492,17 +563,6 @@
 	  (net-unrealized-gains 'merge end-unrealized-gains #f)
 	  (net-unrealized-gains 'minusmerge start-unrealized-gains #f) ; OK
 	  
-	  ;; starting and ending total equity...
-	  (set! start-total-equity (gnc:make-commodity-collector))
-	  (start-total-equity 'minusmerge neg-start-equity-balance #f)
-	  (start-total-equity 'minusmerge neg-pre-start-retained-earnings #f)
-	  (start-total-equity 'merge start-unrealized-gains #f) ; OK
-	  
-	  (set! end-total-equity (gnc:make-commodity-collector))
-	  (end-total-equity 'minusmerge neg-end-equity-balance #f)
-	  (end-total-equity 'minusmerge neg-pre-end-retained-earnings #f)
-	  (end-total-equity 'merge end-unrealized-gains #f) ; OK
-	  
 	  ;; 
 	  ;; calculate investments & draws...
 	  ;; 
@@ -511,21 +571,52 @@
 	  ;; bit...  i'll do a transaction query and classify the
 	  ;; splits by debit/credit.
 	  ;; 
+	  ;;   withdrawals = investments - (investments - withdrawals)
+	  ;;   investments = withdrawals + (investments - withdrawals)
+	  ;; 
+	  ;; assume that positive shares on an equity account are debits...
+	  ;; 
 	  
-	  ;; FIXME: um... no.  that sounds like too much work.
-	  ;; ok, for now, just assume draws are zero and investments signed
-	  (set! draws (gnc:make-commodity-collector))           ;; 0
-	  (set! investments (gnc:make-commodity-collector))     ;; 0
-	  (investments 'minusmerge neg-end-equity-balance #f)   ;; > 0
-	  (investments 'merge neg-start-equity-balance #f)      ;; net increase
+	  (set! equity-closing 
+		(gnc:account-get-trans-type-balance-interval
+		 equity-accounts closing-pattern
+		 start-date-tp end-date-tp)
+		)
+	  (set! neg-pre-closing-equity (gnc:make-commodity-collector))
+	  (neg-pre-closing-equity 'merge neg-end-equity-balance #f)
+	  (neg-pre-closing-equity 'minusmerge equity-closing #f)
+	  
+	  (set! net-investment (gnc:make-commodity-collector))  ;; 0
+	  (net-investment 'minusmerge neg-pre-closing-equity #f);; > 0
+	  (net-investment 'merge neg-start-equity-balance #f)   ;; net increase
+	  
+	  (set! withdrawals (gnc:make-commodity-collector))
+	  (withdrawals 'merge (gnc:account-get-pos-trans-total-interval
+				    equity-accounts closing-pattern
+				    start-date-tp end-date-tp)
+		       #f)
+	  (set! investments (gnc:make-commodity-collector))
+	  (investments 'merge net-investment #f)
+	  (investments 'merge withdrawals #f)
 	  
 	  ;; increase in equity
 	  (set! capital-increase (gnc:make-commodity-collector))
 	  (capital-increase 'merge net-income #f)
 	  (capital-increase 'merge investments #f)
-	  (capital-increase 'minusmerge draws #f)
+	  (capital-increase 'minusmerge withdrawals #f)
 	  (capital-increase 'merge net-unrealized-gains #f)
 	  
+	  ;; starting total equity
+	  (set! start-total-equity (gnc:make-commodity-collector))
+	  (start-total-equity 'minusmerge neg-start-equity-balance #f)
+	  (start-total-equity 'minusmerge neg-pre-start-retained-earnings #f)
+	  (start-total-equity 'merge start-unrealized-gains #f) ; OK
+	  
+	  ;; ending total equity
+	  (set! end-total-equity (gnc:make-commodity-collector))
+	  (end-total-equity 'merge start-total-equity #f)
+	  (end-total-equity 'merge capital-increase #f) ; OK
+	  
 	  (gnc:report-percent-done 30)
 	  
 	  ;; Workaround to force gtkhtml into displaying wide
@@ -555,18 +646,27 @@
 	   )
 	  (report-line
 	   build-table 
-	   (string-append (N_ "Investments less withdrawals") period-for)
+	   (string-append (N_ "Investments") period-for)
 	   #f
 	   investments
 	   0 end-exchange-fn #f #f
 	   )
 	  (report-line
 	   build-table 
-	   (string-append (N_ "Unrealized gains") period-for)
-	   (string-append (N_ "Unrealized losses") period-for)
-	   net-unrealized-gains
+	   (string-append (N_ "Withdrawals") period-for)
+	   #f
+	   withdrawals
 	   0 end-exchange-fn #f #f
 	   )
+	  (or (gnc:commodity-collector-allzero? net-unrealized-gains)
+	      (report-line
+	       build-table 
+	       (N_ "Unrealized gains")
+	       (N_ "Unrealized losses")
+	       net-unrealized-gains
+	       0 end-exchange-fn #f #f
+	       )
+	   )
 	  (report-line
 	   build-table 
 	   (N_ "Increase in capital")


More information about the gnucash-changes mailing list