r22750 - gnucash/trunk/src/report/report-system - Improve HTML account table generator

[Mike Alexander]

Author: mta
Date: 2013-02-03 19:50:13 -0500 (Sun, 03 Feb 2013)
New Revision: 22750
Trac: http://svn.gnucash.org/trac/changeset/22750

Modified:
   gnucash/trunk/src/report/report-system/html-acct-table.scm
Log:
Improve HTML account table generator

Make it possible to add to an existing row and do a better job of
keeping track of whether any values were display for child accounts.

Modified: gnucash/trunk/src/report/report-system/html-acct-table.scm
===================================================================
--- gnucash/trunk/src/report/report-system/html-acct-table.scm	2013-02-03 09:45:10 UTC (rev 22749)
+++ gnucash/trunk/src/report/report-system/html-acct-table.scm	2013-02-04 00:50:13 UTC (rev 22750)
@@ -577,14 +577,21 @@
 
   ;; helper to plop <env> in the next available env cell
   (define (add-row env)
-    (let ((html-table (gnc:_html-acct-table-matrix_ acct-table)))
+    (let* ((html-table (gnc:_html-acct-table-matrix_ acct-table))
+           (row (gnc:html-table-num-rows html-table)))
       (gnc:html-table-set-cell!
        html-table
-       (gnc:html-table-num-rows html-table)
+       row
        0
        env)
+      row
       )
     )
+
+  ;; Add more stuff to an existing row
+  (define (append-to-row row env)
+    (gnc:html-acct-table-set-row-env! acct-table row
+      (append (gnc:html-acct-table-get-row-env acct-table row) env)))
   
   (let* ((env (gnc:_html-acct-table-env_ acct-table))
 	 ;; establish all input parameters and their defaults 
@@ -607,7 +614,6 @@
 	 (exchange-fn (or (get-val env 'exchange-fn)
                           #f))
          (get-balance-fn (or (get-val env 'get-balance-fn) #f))
-         ;;'weighted-average))
 	 (column-header (let ((cell (get-val env 'column-header)))
 			  (if (equal? cell #t)
 			      (gnc:make-html-table-cell "Account name")
@@ -764,6 +770,7 @@
 	     (if (integer? depth-limit)
 		 (min (- depth-limit 1) logi-depth)
 		 logi-depth))
+            (row-added? #f)
 	    )
 	
 	(for-each
@@ -834,6 +841,8 @@
 			     (and (equal? label-mode 'name)
 				  (gnc:make-html-text account-name))
 			     ))
+                  (row #f)
+                  (children-displayed? #f)
 		  )
 
 	     (set! acct-depth-reached (max acct-depth-reached acct-depth))
@@ -860,19 +869,23 @@
 					(+ disp-depth indent))
 				  )
 				 ))
-		   (add-row row-env)
+		   (set! row (add-row row-env))
 		   )
 		 )
 	     ;; Recurse:
 	     ;; Dive into an account even if it isnt selected!
 	     ;; why? because some subaccts may be selected.
-	     (traverse-accounts! subaccts
-				 (+ acct-depth 1)
-				 (if (use-acct? acct)
-				     (+ logi-depth 1)
-				     logi-depth)
-				 new-balances)
+	     (set! children-displayed?
+	           (traverse-accounts! subaccts
+				       (+ acct-depth 1)
+				       (if (use-acct? acct)
+				           (+ logi-depth 1)
+				           logi-depth)
+				       new-balances))
 
+	     ;; record whether any children were displayed
+	     (if row (append-to-row row (list (list 'children-displayed? children-displayed?))))
+
 	     ;; after the return from recursion: subtotals
 	     (or (not (use-acct? acct))
 		 (not subtotal-mode)
@@ -881,7 +894,7 @@
 		      (equal? zero-mode 'omit-leaf-acct))
 		 ;; ignore use-acct for subtotals...?
 		 ;; (not (use-acct? acct))
-		 (null? subaccts)
+		 (not children-displayed?)
 		 (let* ((lbl-txt (gnc:make-html-text (_ "Total") " ")))
 		   (apply gnc:html-text-append! lbl-txt
 			  (gnc:html-text-body label))
@@ -903,12 +916,14 @@
 		   (add-row row-env)
 		   )
 		 )
+	     (if (or row-added? children-displayed? row) (set! row-added? #t))
 	     )) ;; end of (lambda (acct) ...)
 	 ;; lambda is applied to each item in the (sorted) account list
 	 (if less-p
 	     (sort accts less-p)
 	     accts)
 	 ) ;; end of for-each
+	 row-added?
 	)
       ) ;; end of definition of traverse-accounts!
 
@@ -1181,6 +1196,7 @@
 			params))
 		  (acct (get-val env 'account))
 		  (children (get-val env 'account-children))
+		  (children-displayed? (get-val env 'children-displayed?))
 		  (label (get-val env 'account-label))
 		  (acct-name (get-val env 'account-name)) ;; for diagnostics...
 		  (report-commodity  (get-val env 'report-commodity))
@@ -1318,7 +1334,7 @@
 		 ;; some reports, the output might look incorrect. but,
 		 ;; if you think long and hard about it, i think you'll
 		 ;; find the current treatment correct... i think. -DM-
-		 (- 0 (if (if (null? children)
+		 (- 0 (if (if (not children-displayed?)
 			      #f
 			      (equal? bal-method 'immediate-bal))
 			  1 0)