Christian Stimming's report patch.

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

src/scm/report-utilities.scm

@@ -27,7 +27,9 @@
   (gnc:amount->string-helper amount info))
 
 (define (gnc:account-has-shares? account)
-  (let ((type (gw:enum-GNCAccountType-val->sym
+  ;; FYI: The val->sym function used to be called 
+  ;; gw:enum-GNCAccountType-val->sym
+  (let ((type (gw:enum-<gnc:AccountType>-val->sym
                (gnc:account-get-type account)
                #f)))
     (member type '(stock mutual-fund currency))))

src/scm/report/account-summary.scm

@@ -97,8 +97,37 @@
         (_ "General") (_ "Include Sub-Account balances")
         "d" (_ "Include sub-account balances in printed balance?") #t))
       
+      (opt-register
+       (gnc:make-simple-boolean-option
+	(_ "General") (_ "Show Foreign Currencies")
+	"da" (_ "Display the account's foreign currency amount?") #f))
+      
+      (opt-register
+       (gnc:make-currency-option 
+	(_ "General") (_ "Report's currency") 
+	"db" (_ "All other currencies will get converted to this currency.")
+	(gnc:locale-default-currency)))
+      
       options))
 
+  ;; In progress: A suggested function to calculate the weighted
+  ;; average exchange rate between all commodities and the
+  ;; report-commodity. Returns an alist.
+  (define (make-exchange-alist report-commodity)
+    (let* ((all-accounts (gnc:group-get-subaccounts
+			 (gnc:get-current-group)))
+	   (curr-accounts 
+	    (filter 
+	     (lambda (a) (let ((t (gw:enum-<gnc:AccountType>-val->sym
+				    (gnc:account-get-type a) #f)))
+			   (member t '(stock mutual-fund currency))))
+	     all-accounts)))
+      ;;(gnc:free-account-group all-accounts)
+      (for-each (lambda (a)
+		  (warn a (gnc:account-get-name a)))
+		curr-accounts)))
+  ;; Unfinished.
+
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; Start of report generating code
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -116,58 +145,133 @@
 	(cons #f (make-empty-cells (- n 1)))
 	'()))
 
-  ;; returns a list which makes up a row in the table
+  ;; returns the account name as html-text and anchor to the register.
-  (define (make-row acct end-date tree-depth current-depth subtot?)
+  (define (html-account-anchor acct)
-    (append
-     (make-empty-cells (- current-depth 1))
-     (list (gnc:make-html-table-cell/size 
-	    1 (+ 1 (- tree-depth current-depth)) 
     (gnc:make-html-text (gnc:html-markup-anchor
 			 (string-append 
 			  "gnc-register:account=" 
 			  (gnc:account-get-full-name acct))
-				 (gnc:account-get-name acct)))))
+			 (gnc:account-get-name acct))))
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; build-acct-table
+  ;; builds and returns the tree-shaped table
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (define (build-acct-table accounts end-date tree-depth do-subtot?
+			    show-fcur? report-commodity exchange-fn)
+    (let ((table (gnc:make-html-table)))
+
+      ;; The following functions are defined inside build-acct-table
+      ;; to avoid passing tons of arguments which are constant anyway
+      ;; inside this function.
+
+      ;;;;;;;;;;;;;;;;;
+      ;; functions for table without foreign commodities 
+      
+      ;; returns a list which makes up a row in the table
+      (define (make-row acct current-depth)
+	(append
+	 (make-empty-cells (- current-depth 1))
+	 (list (gnc:make-html-table-cell/size 
+		1 (+ 1 (- tree-depth current-depth)) 
+		(html-account-anchor acct)))
 	 (make-empty-cells (- tree-depth current-depth))
 	 ;; the account balance
 	 (list 
+	  ;; FIXME: report-commodity is ignored right now.
 	  (let ((pair ((gnc:account-get-comm-balance-at-date 
-		    acct end-date subtot?) 
+			acct end-date do-subtot?) 
 		       'getpair (gnc:account-get-commodity acct) #f)))
 	    ;; pair is a list of one gnc:commodity and 
 	    ;; one gnc:numeric value. 
 	    (commodity-value->string pair)))
 	 (make-empty-cells (- current-depth 1))))
       
-  ;; Goes through the list of accounts, runs make-row on each account.
+      ;; Adds rows to the table. Therefore it goes through the list of
-  ;; If tree-depth and current-depth require, it will recursively call
+      ;; accounts, runs make-row on each account.  If tree-depth and
-  ;; itself on the list of children accounts.
+      ;; current-depth require, it will recursively call itself on the
-  (define (traverse-accounts accounts table end-date 
+      ;; list of children accounts. Is used if the foreign commodity is
-			     tree-depth current-depth subtot?)
+      ;; not shown.
+      (define (traverse-accounts! accnts current-depth)
 	(if (<= current-depth tree-depth)
 	    (map (lambda (acct)
 		   (begin
 		     (gnc:html-table-append-row!
 		      table 
-		  (make-row acct end-date tree-depth current-depth 
+		      (make-row acct current-depth))
-			    subtot?))
+		     (let ((children 
+			     (gnc:account-get-immediate-subaccounts acct)))
+		       (if (not (null? children))
+			   (traverse-accounts! 
+			    children (+ 1 current-depth))))))
+		 accnts)))
+      
+      ;;;;;;;;;;;;;;;;;;;
+      ;; functions for table with foreign commodities visible
+
+      ;; adds all appropriate rows to the table which belong to one
+      ;; account, i.e. one row for each commodity. (Note: Multiple
+      ;; commodities come from subaccounts with different commodities.) Is
+      ;; used only if options "show foreign commodities" == #t.
+      (define (add-commodity-rows! acct current-depth) 
+	(let ((balance (gnc:account-get-comm-balance-at-date 
+			acct end-date do-subtot?)))
+	  ;; the first row for each account: shows the name and the
+	  ;; balance in the report-commodity
+	  (gnc:html-table-append-row! 
+	   table
+	   (append
+	    (make-empty-cells (- current-depth 1))
+	    (list (gnc:make-html-table-cell/size 
+		   1 (+ 1 (- tree-depth current-depth)) 
+		   (html-account-anchor acct)))
+	    (make-empty-cells (+ 1 (* 2 (- tree-depth current-depth))))
+	    ;; the account balance in terms of report commodity
+	    (list
+	     (commodity-value->string (balance 'getpair report-commodity #f)))
+	    (make-empty-cells (* 2 (- current-depth 1)))))
+	  ;; The additional rows: show no name, but the foreign currency
+	  ;; balance and its corresponding value in the
+	  ;; report-currency. One row for each non-report-currency.
+	  (balance 
+	   'format 
+	   (lambda (curr val)
+	     (if (gnc:commodity-equiv? curr report-commodity)
+	     '()
+	     (gnc:html-table-append-row! 
+	      table
+	      (append
+	       ;; print no account name 
+	       (make-empty-cells tree-depth)
+	       (make-empty-cells  (* 2 (- tree-depth current-depth)))
+	       ;; print the account balance in the respective commodity
+	       (list
+		(commodity-value->string (list curr val))
+		(commodity-value->string 
+		 (exchange-fn (list curr val) report-commodity)))
+	       (make-empty-cells (* 2 (- current-depth 1))))))) 
+       #f)))
+  
+      ;; The same as above, but for showing foreign currencies/commodities.
+      (define (traverse-accounts-fcur! accnts current-depth) 
+	(if (<= current-depth tree-depth)
+	    (map (lambda (acct)
+		   (begin
+		     (add-commodity-rows! acct current-depth)
 		     (let* ((children 
 			     (gnc:account-get-immediate-subaccounts acct)))
 		       (if (not (null? children))
-		       (traverse-accounts children table end-date
+			   (traverse-accounts-fcur! 
-					  tree-depth (+ 1 current-depth)
+			    children (+ 1 current-depth))))))
-					  subtot?)))))
+		 accnts)))
-	     accounts)))
 
-  ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; build-acct-table
-  ;; builds the tree-shaped table
-  ;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-  (define (build-acct-table accounts end-date tree-depth do-subtot?)
-    (let ((table (gnc:make-html-table)))
 	
       ;; start the recursive account processing
-      (traverse-accounts accounts table end-date tree-depth 1 do-subtot?)
+      (if show-fcur?
+	  (traverse-accounts-fcur! accounts 1)
+	  (traverse-accounts! accounts 1))
       
       ;; set default alignment to right, and override for the name
       ;; columns
@@ -226,31 +330,51 @@
        (gnc:lookup-option options (_ "General") optname)))
     
     (let ((accounts (get-option (_ "Account")))
-          (date-tp (vector-ref (get-option (_ "Date")) 1))
           (display-depth (get-option (_ "Account Display Depth")))
           (do-subtotals? (get-option (_ "Include Sub-Account balances")))
+	  (show-fcur? (get-option (_ "Show Foreign Currencies")))
+	  (report-currency (get-option (_ "Report's currency")))
+	  ;; DIRTY BUGFIX! Without this +[one day] only those splits
+	  ;; which have a date <= the first second of the desired
+	  ;; end-date are returned. Permanent repair: Change the
+	  ;; semantics of the date-option to return not the first but
+	  ;; the last second of the desired day.
+          (date-tp (cons (+ 86399 
+			    (car (vector-ref (get-option (_ "Date")) 1)))
+			 0))
           (doc (gnc:make-html-document)))
       
       (gnc:html-document-set-title! doc "Account Summary")
       (if (not (null? accounts))
 	  ;; if no max. tree depth is given we have to find the
 	  ;; maximum existing depth
-	  (let ((tree-depth (if (equal? display-depth 'all)
+	  (let* ((tree-depth (if (equal? display-depth 'all)
 				(find-depth accounts)
-				display-depth)))
+				display-depth))
+		 ;; temporary replacement for the real function
+		 (exchange-fn (lambda(foreign-pair domestic)
+				(list domestic (cadr foreign-pair))))
 		 ;; do the (recursive) processing here
-	    (let ((table (build-acct-table accounts date-tp 
+		 (table (build-acct-table accounts date-tp 
-					   tree-depth do-subtotals?)))
+					  tree-depth do-subtotals?
+					  show-fcur? report-currency
+					  exchange-fn)))
+	    ;; TEST
+	    ;;(make-exchange-alist report-currency)
+
 	    ;; set some column headers 
 	    (gnc:html-table-set-col-headers!
 	     table 
 	     (list (gnc:make-html-table-header-cell/size 
 		    1 tree-depth (_ "Account name"))
 		   (gnc:make-html-table-header-cell/size
-                      1 tree-depth (_ "Balance"))))
+		    1 (if show-fcur? 
+			  (* 2 tree-depth)
+			  tree-depth)
+		    (_ "Balance"))))
 	    
 	    ;; add the table 
-              (gnc:html-document-add-object! doc table)))	        
+	    (gnc:html-document-add-object! doc table))
       
 	  ;; error condition: no accounts specified
           (let ((p (gnc:make-html-text)))