Christian Stimming's report patch.

* src/scm/report/report-list.scm: Renamed file.

	* src/scm/report/account-piecharts.scm: Renamed to this filename
	(used to be: income-or-expense-pie.scm). Introduced some more
	generality such that this file also has an asset and a liability
	balance piechart.

	* src/scm/report/category-barchart.scm: Introduced some
	more generality such that this file also has a asset and liability
	balance barchart.


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3930 57a11ea4-9604-0410-9ed3-97b8803252fd

ChangeLog

@@ -1,3 +1,16 @@
+2001-04-11  Christian Stimming  <stimming@tuhh.de>
+
+	* src/scm/report/report-list.scm: Renamed file.
+	
+	* src/scm/report/account-piecharts.scm: Renamed to this filename
+	(used to be: income-or-expense-pie.scm). Introduced some more
+	generality such that this file also has an asset and a liability
+	balance piechart.
+
+	* src/scm/report/category-barchart.scm: Introduced some
+	more generality such that this file also has a asset and liability
+	balance barchart.
+
 2001-04-10  Christian Stimming  <stimming@tuhh.de>
 
 	* src/scm/report-utilities.scm: Added function

src/scm/report/Makefile.am

@@ -2,13 +2,13 @@
 gncscmdir = ${GNC_SCM_INSTALL_DIR}/report
 
 gncscm_DATA = \
+  account-piecharts.scm \
   account-summary.scm \
   average-balance.scm \
   balance-sheet.scm \
   category-barchart.scm \
   hello-world.scm \
   income-expense-graph.scm \
-  income-or-expense-pie.scm \
   net-worth-timeseries.scm \
   pnl.scm \
   portfolio.scm \

src/scm/report/account-piecharts.scm

@@ -1,19 +1,52 @@
-;; -*-scheme-*-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; account-piecharts.scm: shows piechart of accounts
+;;  
+;; By Robert Merkel (rgmerk@mira.net) 
+;; and Christian Stimming <stimming@tu-harburg.de>
+;;
+;; This program is free software; you can redistribute it and/or    
+;; modify it under the terms of the GNU General Public License as   
+;; published by the Free Software Foundation; either version 2 of   
+;; the License, or (at your option) any later version.              
+;;                                                                  
+;; This program is distributed in the hope that it will be useful,  
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of   
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    
+;; GNU General Public License for more details.                     
+;;                                                                  
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation           Voice:  +1-617-542-5942
+;; 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
+;; Boston, MA  02111-1307,  USA       gnu@gnu.org
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;; income-or-expense-pie.scm
+(gnc:support "report/account-piecharts.scm")
-;; Display expenses/incomes from various accounts as a pie chart
-;; by Robert Merkel (rgmerk@mira.net)
-
-(gnc:support "report/income-or-expense-pie.scm")
 (gnc:depend  "report-html.scm")
 (gnc:depend  "date-utilities.scm")
 
-(let ((pagename-general (N_ "General"))
+(let ((reportname-income (N_ "Income Piechart"))
+      (reportname-expense (N_ "Expense Piechart"))
+      (reportname-assets (N_ "Asset Piechart"))
+      (reportname-liabilities (N_ "Liability Piechart"))
+      ;; The names are used in the menu, as labels and as identifiers.
+
+      ;; The titels here are only printed as titles of the report.
+      (reporttitle-income (_ "Income Accounts"))
+      (reporttitle-expense (_ "Expense Accounts"))
+      (reporttitle-assets (_ "Assets"))
+      (reporttitle-liabilities (_ "Liabilities/Equity"))
+
+      (pagename-general (N_ "General"))
       (optname-from-date (N_ "From"))
       (optname-to-date (N_ "To"))
+      (optname-report-currency (N_ "Report's currency"))
+
+      (pagename-accounts (N_ "Accounts"))
       (optname-accounts (N_ "Accounts"))
       (optname-levels (N_ "Show Accounts until level"))
-      (optname-report-currency (N_ "Report's currency"))
 
       (pagename-display (N_ "Display"))
       (optname-fullname (N_ "Show long account names"))
@@ -22,44 +55,47 @@
       (optname-plot-width (N_ "Plot Width"))
       (optname-plot-height (N_ "Plot Height")))
 
-  ;; Note the options-generator has a boolean argument, which
+  ;; The option-generator. The only dependance on the type of piechart
-  ;; is true for income piecharts.  We use a lambda to wrap
+  ;; is the list of account types that the account selection option
-  ;; up this function in the define-reports.
+  ;; accepts.
-
+  (define (options-generator account-types do-intervals?)
-  (define (options-generator is-income?)    
     (let* ((options (gnc:new-options)) 
            (add-option 
             (lambda (new-option)
               (gnc:register-option options new-option))))
 
-      (gnc:options-add-date-interval!
+      (if do-intervals?
-       options pagename-general
+	  (gnc:options-add-date-interval!
-       optname-from-date optname-to-date "a")
+	   options pagename-general
+	   optname-from-date optname-to-date "a")
+	  (gnc:options-add-report-date!
+	   options pagename-general
+	   optname-to-date "a"))
 
+      (gnc:options-add-currency! 
+       options pagename-general optname-report-currency "b")
+      
       (add-option
        (gnc:make-account-list-option
-	pagename-general optname-accounts
+	pagename-accounts optname-accounts
-	"b"
+	"a"
 	(N_ "Report on these accounts, if chosen account level allows.")
 	(lambda ()
 	  (gnc:filter-accountlist-type 
-	   (if is-income? '(income) '(expense))
+	   account-types
 	   (gnc:group-get-subaccounts (gnc:get-current-group))))
 	(lambda (accounts)
 	  (list #t
 		(gnc:filter-accountlist-type
-		 (if is-income? '(income) '(expense))
+		 account-types
 		 accounts)))
 	#t))
 
       (gnc:options-add-account-levels! 
-       options pagename-general optname-levels "c" 
+       options pagename-accounts optname-levels "b" 
        (N_ "Show accounts to this depth and not further") 
        2)
 
-      (gnc:options-add-currency! 
-       options pagename-general optname-report-currency "d")
-      
       (add-option
        (gnc:make-simple-boolean-option
         pagename-display optname-fullname
@@ -84,25 +120,31 @@
 
       options))
 
-  ;; Similar arrangement to the options-generator.
-  (define (income-or-expense-pie-renderer report-obj is-income?)
-
-    ;; These are some helper functions for looking up option values.
-    (define (get-op section name)
-      (gnc:lookup-option (gnc:report-options report-obj) section name))
 
+  ;; The rendering function. Since it works for a bunch of different
+  ;; account settings, you have to give the reportname, the
+  ;; report-title, and tthe account-types to work on as arguments.
+  (define (piechart-renderer report-obj reportname
+			     account-types report-title do-intervals?)
+    
+    ;; This is a helper function for looking up option values.
     (define (op-value section name)
-      (gnc:option-value (get-op section name)))
+      (gnc:option-value 
-
+       (gnc:lookup-option 
+	(gnc:report-options report-obj) section name)))
+    
     ;; Get all options
     (let ((to-date-tp (gnc:timepair-end-day-time 
 		       (vector-ref (op-value pagename-general
 					     optname-to-date) 1)))
-	  (from-date-tp (gnc:timepair-start-day-time 
+	  (from-date-tp (if do-intervals?
-			 (vector-ref (op-value pagename-general
+			    (gnc:timepair-start-day-time 
-					       optname-from-date) 1)))
+			     (vector-ref 
-	  (accounts (op-value pagename-general optname-accounts))
+			      (op-value pagename-general
-	  (account-levels (op-value pagename-general optname-levels))
+					optname-from-date) 1))
+			    '()))
+	  (accounts (op-value pagename-accounts optname-accounts))
+	  (account-levels (op-value pagename-accounts optname-levels))
 	  (report-currency (op-value pagename-general
 				     optname-report-currency))
 
@@ -115,7 +157,7 @@
 	  (document (gnc:make-html-document))
 	  (chart (gnc:make-html-piechart))
 	  (topl-accounts (gnc:filter-accountlist-type 
-			  (if is-income? '(income) '(expense))
+			  account-types
 			  (gnc:group-get-account-list 
 			   (gnc:get-current-group)))))
 
@@ -129,8 +171,12 @@
       ;; subaccount's balances are included as well. Returns a
       ;; commodity-collector.
       (define (profit-fn account subaccts?)
-	(gnc:account-get-comm-balance-interval
+	(if do-intervals?
-	 account from-date-tp to-date-tp subaccts?))
+	    (gnc:account-get-comm-balance-interval
+	     account from-date-tp to-date-tp subaccts?)
+	    (gnc:account-get-comm-balance-at-date
+	     account to-date-tp subaccts?)))
+
       
       ;; Define more helper variables.
       (let* ((exchange-alist (gnc:make-exchange-alist
@@ -192,6 +238,7 @@
 		 (list (collector->double (profit-fn a #t)) a))
 	       (filter show-acct? accts))))
 	
+	;; Now do the work here.
 	(set! combined
 	      (sort (filter (lambda (pair) (not (= 0.0 (car pair))))
 			    (traverse-accounts 
@@ -208,13 +255,11 @@
 	      (set! combined
 		    (append start
 			    (list (list sum (_ "Other")))))
-	      (let* ((name (if is-income?
+	      (let* ((name reportname)
-                               (N_ "Income Piechart") 
-			       (N_ "Expense Piechart")))
 		     (options (gnc:make-report-options name))
 		     (account-op 
-		      (gnc:lookup-option options pagename-general
+		      (gnc:lookup-option options pagename-accounts
-                                         optname-accounts)))
+					 optname-accounts)))
 		;; now copy all the options
 		(define (set-option! pagename optname value)
 		  (gnc:option-set-value
@@ -222,19 +267,22 @@
 		   value))
 		(for-each
 		 (lambda (l) (set-option! (car l) (cadr l) (caddr l)))
-		 (list
+		 (append
-		  (list pagename-general optname-from-date
+		  (if do-intervals?
-			(cons 'absolute from-date-tp))
+		      (list (list pagename-general optname-from-date
-		  (list pagename-general optname-to-date
+				  (cons 'absolute from-date-tp)))
-			(cons 'absolute to-date-tp))
+		      '())
-		  (list pagename-general optname-report-currency
+		  (list
-			report-currency)
+		   (list pagename-general optname-to-date
-		  (list pagename-general optname-levels account-levels)
+			 (cons 'absolute to-date-tp))
-		  (list pagename-display optname-fullname show-fullname?)
+		   (list pagename-general optname-report-currency
-		  (list pagename-display optname-show-total show-total?)
+			 report-currency)
-		  (list pagename-display optname-slices max-slices)
+		   (list pagename-accounts optname-levels account-levels)
-		  (list pagename-display optname-plot-height height) 
+		   (list pagename-display optname-fullname show-fullname?)
-		  (list pagename-display optname-plot-width width)))
+		   (list pagename-display optname-show-total show-total?)
+		   (list pagename-display optname-slices max-slices)
+		   (list pagename-display optname-plot-height height) 
+		   (list pagename-display optname-plot-width width))))
 		(call-with-values (lambda () (unzip2 finish))
 				  (lambda (ds as)
 				    (gnc:option-set-value account-op as)))
@@ -243,23 +291,25 @@
 		       (gnc:make-report name options))))))
 
 	(gnc:html-piechart-set-title!
-	 chart (if is-income? 
+	 chart report-title)
-		   (_ "Income by Account")
-		   (_ "Expenses by Account")))
 
 	(gnc:html-piechart-set-subtitle!
 	 chart (string-append
-                (sprintf #f
+		(if do-intervals?
-                         (_ "%s to %s")
+		    (sprintf #f
-                         (gnc:timepair-to-datestring from-date-tp) 
+			     (_ "%s to %s")
-                         (gnc:timepair-to-datestring to-date-tp))
+			     (gnc:timepair-to-datestring from-date-tp) 
-                (if show-total?
+			     (gnc:timepair-to-datestring to-date-tp))
-                    (let ((total (apply + (unzip1 combined))))
+		    (sprintf #f
-                      (sprintf #f ": %s"
+			     (_ "Balance at %s")
-                               (gnc:amount->string total print-info)))
+			     (gnc:timepair-to-datestring to-date-tp)))
-                          
+		(if show-total?
-                    "")))
+		    (let ((total (apply + (unzip1 combined))))
-
+		      (sprintf #f ": %s"
+			       (gnc:amount->string total print-info)))
+		    
+		    "")))
+	
 	(gnc:html-piechart-set-width! chart width)
 	(gnc:html-piechart-set-height! chart height)
 	(gnc:html-piechart-set-data! chart (unzip1 combined))
@@ -291,17 +341,28 @@
 	(gnc:html-document-add-object! document chart) 
 
 	document)))
-
+  
-  (gnc:define-report
+  (for-each 
-   'version 1
+   (lambda (l)
-   'name (N_ "Income Piechart")
+     (gnc:define-report
-   'options-generator (lambda () (options-generator #t))
+      'version 1
-   'renderer (lambda (report-obj)
+      'name (car l)
-               (income-or-expense-pie-renderer report-obj #t)))
+      'options-generator (lambda () (options-generator (cadr l) 
-
+						       (cadddr l)))
-  (gnc:define-report
+      'renderer (lambda (report-obj)
-   'version 1
+		  (piechart-renderer report-obj 
-   'name (N_ "Expense Piechart")
+				     (car l) 
-   'options-generator (lambda () (options-generator #f))
+				     (cadr l)
-   'renderer (lambda (report-obj)
+				     (caddr l)
-               (income-or-expense-pie-renderer report-obj #f))))
+				     (cadddr l)))))
+   (list 
+    ;; reportname, account-types, reporttitle, do-intervals?
+    (list reportname-income '(income) reporttitle-income #t)
+    (list reportname-expense '(expense) reporttitle-expense #t)
+    (list reportname-assets 
+	  '(asset bank cash checking savings money-market 
+		  stock mutual-fund currency)
+	  reporttitle-assets #f)
+    (list reportname-liabilities 
+	  '(liability credit credit-line equity)
+	  reporttitle-liabilities #f))))

src/scm/report/category-barchart.scm

@@ -137,7 +137,7 @@
   ;; *really* complicated.
 
   (define (category-barchart-renderer report-obj reportname 
-				      account-types report-title)
+				      account-types report-title do-intervals?)
     ;; A helper functions for looking up option values.
     (define (get-option section name)
       (gnc:option-value 
@@ -183,16 +183,23 @@
 			     (gnc:get-current-group-depth)
 			     account-levels))
 	     ;; This is the list of date intervals to calculate.
-	     (dates-list (gnc:make-date-interval-list
+	     (dates-list (if do-intervals?
-			  (gnc:timepair-start-day-time from-date-tp) 
+			     (gnc:make-date-interval-list
-			  (gnc:timepair-end-day-time to-date-tp)
+			      (gnc:timepair-start-day-time from-date-tp) 
-			  (eval interval)))
+			      (gnc:timepair-end-day-time to-date-tp)
+			      (eval interval))
+			     (gnc:make-date-list
+			      (gnc:timepair-end-day-time from-date-tp) 
+			      (gnc:timepair-end-day-time to-date-tp)
+			      (eval interval))))
 	     ;; Here the date strings for the x-axis labels are
 	     ;; created.
 	     (date-string-list
 	      (map (lambda (date-list-item)
 		     (gnc:timepair-to-datestring
-		      (car date-list-item)))
+		      (if do-intervals?
+			  (car date-list-item)
+			  date-list-item)))
 		   dates-list))
 	     (other-anchor "")
 	     (all-data '()))
@@ -219,11 +226,14 @@
 	  ((if (gnc:account-reverse-balance? account)
 	       - +)
 	   (collector->double
-	    (gnc:account-get-comm-balance-interval 
+	    (if do-intervals?
-	     account 
+		(gnc:account-get-comm-balance-interval 
-	     (car date-list-entry) 
+		 account 
-	     (cadr date-list-entry) subacct?))))
+		 (car date-list-entry) 
-
+		 (cadr date-list-entry) subacct?)
+		(gnc:account-get-comm-balance-at-date
+		 account date-list-entry subacct?)))))
+	
 	;; Creates the <balance-list> to be used in the function
 	;; below. 
 	(define (account->balance-list account subacct?)
@@ -290,7 +300,9 @@
 	(gnc:html-barchart-set-title! chart report-title)
 	(gnc:html-barchart-set-subtitle!
 	 chart (sprintf #f
-			(_ "%s to %s")
+			(if do-intervals?
+			    (_ "%s to %s")
+			    (_ "Balances %s to %s"))
 			(gnc:timepair-to-datestring from-date-tp) 
 			(gnc:timepair-to-datestring to-date-tp)))
 	(gnc:html-barchart-set-width! chart width)
@@ -388,14 +400,16 @@
 		  (category-barchart-renderer report-obj 
 					      (car l) 
 					      (cadr l)
-					      (caddr l)))))
+					      (caddr l)
+					      (cadddr l)))))
    (list 
-    (list reportname-income '(income) reporttitle-income)
+    ;; reportname, account-types, reporttitle, do-intervals?
-    (list reportname-expense '(expense) reporttitle-expense)
+    (list reportname-income '(income) reporttitle-income #t)
+    (list reportname-expense '(expense) reporttitle-expense #t)
     (list reportname-assets 
 	  '(asset bank cash checking savings money-market 
 		  stock mutual-fund currency)
-	  reporttitle-assets)
+	  reporttitle-assets #f)
     (list reportname-liabilities 
 	  '(liability credit credit-line equity)
-	  reporttitle-liabilities))))
+	  reporttitle-liabilities #f))))

src/scm/report/report-list.scm

@@ -10,7 +10,7 @@
 (gnc:depend "report/average-balance.scm")
 (gnc:depend "report/balance-sheet.scm")
 (gnc:depend "report/income-expense-graph.scm")
-(gnc:depend "report/income-or-expense-pie.scm")
+(gnc:depend "report/account-piecharts.scm")
 (gnc:depend "report/net-worth-timeseries.scm")
 (gnc:depend "report/category-barchart.scm")
 (gnc:depend "report/pnl.scm")