[Gnucash-changes] r13244 - gnucash/trunk - Mike Alexander's patch to handle multiple currencies in reports. (#314554)

Derek Atkins warlord at cvs.gnucash.org
Sun Feb 12 16:46:36 EST 2006


Author: warlord
Date: 2006-02-12 16:46:36 -0500 (Sun, 12 Feb 2006)
New Revision: 13244
Trac: http://svn.gnucash.org/trac/changeset/13244

Modified:
   gnucash/trunk/ChangeLog
   gnucash/trunk/src/report/report-system/commodity-utilities.scm
   gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm
   gnucash/trunk/src/report/standard-reports/cash-flow.scm
   gnucash/trunk/src/report/standard-reports/portfolio.scm
   gnucash/trunk/src/report/standard-reports/transaction.scm
Log:
Mike Alexander's patch to handle multiple currencies in reports. (#314554)
        * src/report/standard-reports/portfolio.scm:
        * src/report/standard-reports/advanced-portfolio.scm:
          Report currency option
          Sort accounts
          Handle "nearest price" option better
        * src/report/standard-reports/cash-flow.scm:
          Handle multiple currencies better
        * src/report/standard-reports/transaction.scm:
          Add common currency option.
          Handle "nearest price" option better.
        * src/report/report-system/commodity-utilities.scm
          (gnc:exchange-by-pricedb-nearest):
          Use price nearest to noon on the day specified.
	Fixes bug #314554.



Modified: gnucash/trunk/ChangeLog
===================================================================
--- gnucash/trunk/ChangeLog	2006-02-12 20:31:11 UTC (rev 13243)
+++ gnucash/trunk/ChangeLog	2006-02-12 21:46:36 UTC (rev 13244)
@@ -47,6 +47,22 @@
 	  Apply dividend and brokerage to moneyin and moneyout to more
 	  accurately reflect account activity.  Fixes bug #311549.
 
+	Mike Alexander's patch to handle multiple currencies in reports.
+        * src/report/standard-reports/portfolio.scm:
+        * src/report/standard-reports/advanced-portfolio.scm:
+          Report currency option
+          Sort accounts
+          Handle "nearest price" option better
+        * src/report/standard-reports/cash-flow.scm:
+          Handle multiple currencies better
+        * src/report/standard-reports/transaction.scm:
+          Add common currency option.
+          Handle "nearest price" option better.
+        * src/report/report-system/commodity-utilities.scm
+          (gnc:exchange-by-pricedb-nearest):
+          Use price nearest to noon on the day specified.
+	Fixes bug #314554.
+
 2006-02-11  Derek Atkins  <derek at ihtfp.com>
 
 	* src/report/report-gnome/gnc-plugin-page-report.c:

Modified: gnucash/trunk/src/report/report-system/commodity-utilities.scm
===================================================================
--- gnucash/trunk/src/report/report-system/commodity-utilities.scm	2006-02-12 20:31:11 UTC (rev 13243)
+++ gnucash/trunk/src/report/report-system/commodity-utilities.scm	2006-02-12 21:46:36 UTC (rev 13244)
@@ -778,7 +778,7 @@
              (gnc:book-get-pricedb (gnc:get-current-book))
 	     (gnc:gnc-monetary-amount foreign)
 	     (gnc:gnc-monetary-commodity foreign)
-	     domestic date)))
+	     domestic (gnc:timepair-canonical-day-time date))))
       #f))
 
 ;; Exchange by the nearest price from pricelist. This function takes

Modified: gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm	2006-02-12 20:31:11 UTC (rev 13243)
+++ gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm	2006-02-12 21:46:36 UTC (rev 13244)
@@ -170,113 +170,123 @@
                  (price-list (price-fn commodity to-date))
                  (price      (if (> (length price-list) 0)
 				 (car price-list) #f))
-                 
-                 (value (exchange-fn (gnc:make-gnc-monetary commodity units) currency to-date))
-               )
+		 (commod-currency (gnc:price-get-currency price))
+                 (value (exchange-fn (gnc:make-gnc-monetary commodity units)
+				     currency))
+		 )
 
-;;               (gnc:debug "---" name "---")
-               (for-each
-                 (lambda (split)
-                   (set! work-done (+ 1 work-done))
-                   (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
-                   (let ((parent (gnc:split-get-parent split)))
-                     (if (gnc:timepair-le (gnc:transaction-get-date-posted parent) to-date)
-                       (for-each
-                         (lambda (s)
-                           (cond
-                             ((same-split? s split) 
-			      ;; (gnc:debug "amount" (gnc:numeric-to-double (gnc:split-get-amount s)) )
-                              (cond
-                              ((or include-gains (not (gnc:numeric-zero-p (gnc:split-get-amount s))))
-                                 (unitscoll 'add commodity (gnc:split-get-amount s)) ;; Is the stock transaction?
-                                 (if (< 0 (gnc:numeric-to-double
-                                           (gnc:split-get-amount s)))
-                                     (set! totalunits
-                                           (+ totalunits
-                                              (gnc:numeric-to-double (gnc:split-get-amount s)))))
-                                 (set! totalunityears
-                                       (+ totalunityears 
-                                          (* (gnc:numeric-to-double (gnc:split-get-amount s)) 
-                                             (gnc:date-year-delta 
-                                              (car (gnc:transaction-get-date-posted parent))
-                                              (current-time))))) 
-                                 (cond 
-                                  ((gnc:numeric-negative-p (gnc:split-get-value s))
-                                   (moneyoutcoll
-                                    'add currency
-                                    (gnc:numeric-neg (gnc:split-get-value s))))
-                                  (else (moneyincoll 
-                                         'add currency
-                                         (gnc:numeric-neg (gnc:split-get-value s))))))))
-
-                             ((split-account-type? s 'expense)
-			      (brokeragecoll 'add currency (gnc:split-get-value s)))
-
-                             ((split-account-type? s 'income)
-			      (dividendcoll 'add currency (gnc:split-get-value s)))
-                           )
-                         )
-                         (gnc:transaction-get-splits parent)
-                       )
+;;          (gnc:debug "---" name "---")
+	    (for-each
+	     (lambda (split)
+	       (set! work-done (+ 1 work-done))
+	       (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
+	       (let ((parent (gnc:split-get-parent split)))
+		 (if (gnc:timepair-le (gnc:transaction-get-date-posted parent) to-date)
+		     (for-each
+		      (lambda (s)
+			(cond
+			 ((same-split? s split) 
+;;                       (gnc:debug "amount " (gnc:numeric-to-double (gnc:split-get-amount s))
+;;                                  " acct " (gnc:account-get-name (gnc:split-get-account s)) )
+;;                       (gnc:debug "value " (gnc:numeric-to-double (gnc:split-get-value s))
+;;                                  " in " (gnc:commodity-get-printname commod-currency)
+;;                                  " from " (gnc:transaction-get-description (gnc:split-get-parent s)))
+			  (cond
+			   ((or include-gains (not (gnc:numeric-zero-p (gnc:split-get-amount s))))
+			    (unitscoll 'add commodity (gnc:split-get-amount s)) ;; Is the stock transaction?
+			    (if (< 0 (gnc:numeric-to-double
+				      (gnc:split-get-amount s)))
+				(set! totalunits
+				      (+ totalunits
+					 (gnc:numeric-to-double (gnc:split-get-amount s)))))
+			    (set! totalunityears
+				  (+ totalunityears 
+				     (* (gnc:numeric-to-double (gnc:split-get-amount s)) 
+					(gnc:date-year-delta 
+					 (car (gnc:transaction-get-date-posted parent))
+					 (current-time))))) 
+			    (cond 
+			     ((gnc:numeric-negative-p (gnc:split-get-value s))
+			      (moneyoutcoll
+			       'add commod-currency
+			       (gnc:numeric-neg (gnc:split-get-value s))))
+			     (else (moneyincoll 
+				    'add commod-currency
+				    (gnc:numeric-neg (gnc:split-get-value s))))))))
+			 
+			 ((split-account-type? s 'expense)
+			  (brokeragecoll 'add commod-currency (gnc:split-get-value s)))
+			 
+			 ((split-account-type? s 'income)
+			  (dividendcoll 'add commod-currency (gnc:split-get-value s)))
+			 )
+			)
+		      (gnc:transaction-get-splits parent)
+		      )
                      )
-                   )
-                 )
-                 (gnc:account-get-split-list current)
-               )
-;;               (gnc:debug "totalunits" totalunits)
-;;               (gnc:debug "totalunityears" totalunityears)
+		 )
+	       )
+	     (gnc:account-get-split-list current)
+	     )
+;;          (gnc:debug "totalunits" totalunits)
+;;          (gnc:debug "totalunityears" totalunityears)
 
-               (moneyincoll 'minusmerge dividendcoll #f)
-               (moneyoutcoll 'minusmerge brokeragecoll #f)
-               (gaincoll 'merge moneyoutcoll #f)
-               (gaincoll 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))
-               (gaincoll 'merge moneyincoll #f)
-
-	    (if (or include-empty (not (gnc:numeric-zero-p units)))
-		(begin (total-value 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))
-                       (total-moneyin 'merge moneyincoll #f)
-                       (total-moneyout 'merge moneyoutcoll #f)
-                       (total-gain 'merge gaincoll #f)
-		       (gnc:html-table-append-row/markup!
-			table
-			row-style
-			(list (gnc:html-account-anchor current)
-			      ticker-symbol
-			      listing
-			      (gnc:make-html-table-header-cell/markup
-			       "number-cell" (gnc:amount->string units share-print-info))
-			      (gnc:make-html-table-header-cell/markup
-			       "number-cell"
-			       (if price
-				   (gnc:html-price-anchor
-				    price
-				    (gnc:make-gnc-monetary
-				     (gnc:price-get-currency price)
-				     (gnc:price-get-value price)))
-				   #f))
-			      (gnc:make-html-table-header-cell/markup
-			       "number-cell" value)
-                              (gnc:make-html-table-header-cell/markup
-                               "number-cell" (gnc:monetary-neg (gnc:sum-collector-commodity moneyincoll currency exchange-fn)))
-                              (gnc:make-html-table-header-cell/markup
-                               "number-cell" (gnc:sum-collector-commodity moneyoutcoll currency exchange-fn))
-                              (gnc:make-html-table-header-cell/markup
-                               "number-cell" (gnc:sum-collector-commodity gaincoll currency exchange-fn))
-                              (gnc:make-html-table-header-cell/markup
-                               "number-cell" (sprintf #f "%.2f%%" (* 100 (/ (gnc:numeric-to-double (cadr (gaincoll 'getpair currency #f)))
-                                                                            (gnc:numeric-to-double (cadr (moneyincoll 'getpair currency #t)))))))
-                        )
-                      )
-		      (table-add-stock-rows-internal rest (not odd-row?))
-                )
-		(table-add-stock-rows-internal rest odd-row?)
+	    (moneyincoll 'minusmerge dividendcoll #f)
+	    (moneyoutcoll 'minusmerge brokeragecoll #f)
+	    (gaincoll 'merge moneyoutcoll #f)
+	    (gaincoll 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))
+	    (gaincoll 'merge moneyincoll #f)
+	    
+	    (let ((moneyin (gnc:monetary-neg
+			    (gnc:sum-collector-commodity moneyincoll currency exchange-fn)))
+		  (moneyout (gnc:sum-collector-commodity moneyoutcoll currency exchange-fn))
+		  (gain (gnc:sum-collector-commodity gaincoll currency exchange-fn))
+		  )
+	      (total-value 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))
+	      (total-moneyin 'merge moneyincoll #f)
+	      (total-moneyout 'merge moneyoutcoll #f)
+	      (total-gain 'merge gaincoll #f)
+	      (gnc:html-table-append-row/markup!
+	       table
+	       row-style
+	       (list (gnc:html-account-anchor current)
+		     ticker-symbol
+		     listing
+		     (gnc:make-html-table-header-cell/markup
+		      "number-cell" (gnc:amount->string units share-print-info))
+		     (gnc:make-html-table-header-cell/markup
+		      "number-cell"
+		      (if price
+			  (gnc:html-price-anchor
+			   price
+			   (gnc:make-gnc-monetary
+			    (gnc:price-get-currency price)
+			    (gnc:price-get-value price)))
+			  #f))
+		     (gnc:make-html-table-header-cell/markup "number-cell" value)
+		     (gnc:make-html-table-header-cell/markup "number-cell" moneyin)
+		     (gnc:make-html-table-header-cell/markup "number-cell" moneyout)
+		     (gnc:make-html-table-header-cell/markup "number-cell" gain)
+		     (gnc:make-html-table-header-cell/markup
+		      "number-cell"
+		      (sprintf #f "%.2f%%"
+			       (* 100 (/ (gnc:numeric-to-double
+					  (gnc:gnc-monetary-amount gain))
+					 (gnc:numeric-to-double
+					  (gnc:gnc-monetary-amount moneyin))))
+			       ))
+		     )
+	       )
+	      (table-add-stock-rows-internal rest (not odd-row?))
+	      )
+	    (table-add-stock-rows-internal rest odd-row?)
             )
             (gnc:price-list-destroy price-list)
-          )))
+	    )))
 
     (set! work-to-do (gnc:accounts-count-splits accounts))
-    (table-add-stock-rows-internal accounts #t)))
-
+    (table-add-stock-rows-internal accounts #t))
+  
   ;; Tell the user that we're starting.
   (gnc:report-starting reportname)
 
@@ -309,15 +319,9 @@
                report-title
                (sprintf #f " %s" (gnc:print-date to-date))))
 
-;;    (gnc:debug "accounts" accounts)
     (if (not (null? accounts))
         ; at least 1 account selected
-        (let* ((exchange-fn
-                (case price-source
-                  ('pricedb-latest 
-                   (lambda (foreign domestic date)
-		    (gnc:exchange-by-pricedb-latest foreign domestic)))
-                  ('pricedb-nearest gnc:exchange-by-pricedb-nearest)))
+        (let* ((exchange-fn (gnc:case-exchange-fn price-source currency to-date))
                (pricedb (gnc:book-get-pricedb (gnc:get-current-book)))
                (price-fn
                 (case price-source
@@ -326,7 +330,8 @@
                     (gnc:pricedb-lookup-latest-any-currency pricedb foreign)))
                   ('pricedb-nearest 
                    (lambda (foreign date) 
-                    (gnc:pricedb-lookup-nearest-in-time-any-currency pricedb foreign date))))))
+                    (gnc:pricedb-lookup-nearest-in-time-any-currency
+		     pricedb foreign (gnc:timepair-canonical-day-time date)))))))
           
           (gnc:html-table-set-col-headers!
            table
@@ -341,6 +346,11 @@
                  (_ "Gain")
                  (_ "Total Return")))
           
+	  (set! accounts (sort accounts
+			       (lambda (a b)
+				 (string<? (gnc:account-get-name a)
+					   (gnc:account-get-name b)))))
+
           (table-add-stock-rows
            table accounts to-date currency price-fn exchange-fn
            include-empty include-gains total-value total-moneyin total-moneyout total-gain)

Modified: gnucash/trunk/src/report/standard-reports/cash-flow.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/cash-flow.scm	2006-02-12 20:31:11 UTC (rev 13243)
+++ gnucash/trunk/src/report/standard-reports/cash-flow.scm	2006-02-12 21:46:36 UTC (rev 13244)
@@ -70,7 +70,7 @@
 
     (gnc:options-add-price-source! 
      options gnc:pagename-general
-     optname-price-source "c" 'weighted-average)
+     optname-price-source "c" 'pricedb-nearest)
 
     (gnc:register-option 
      options
@@ -235,8 +235,17 @@
 
                (money-diff-collector (gnc:make-commodity-collector))
 	       (splits-to-do (gnc:accounts-count-splits accounts))
-	       (seen-split-list '()))
+	       (seen-split-list '())
+	       (time-exchange-fn #f)
+	       (commodity-list #f))
 
+	  ;; Helper function to convert currencies
+	  (define (to-report-currency currency amount date)
+	    (gnc:gnc-monetary-amount
+	     (time-exchange-fn (gnc:make-gnc-monetary currency amount)
+			       report-currency
+			       date)))
+
           ;; function to add inflow and outflow of money
           (define (calc-money-in-out accounts)
             (define (calc-money-in-out-internal accounts-internal)
@@ -282,11 +291,11 @@
 				      (if (not (split-in-list? s seen-split-list))
 					  (begin  
 					    (set! seen-split-list (cons s seen-split-list))
-					    (if (gnc:numeric-negative-p (gnc:split-get-value s))
+					    (if (gnc:numeric-negative-p s-value)
 						(let ((pair (account-in-alist s-account money-in-alist)))
 						  ;(gnc:debug "in:" (gnc:commodity-get-printname s-commodity)
 						;	     (gnc:numeric-to-double s-amount) 
-						;	     (gnc:commodity-get-printname curr-commodity)
+						;	     (gnc:commodity-get-printname parent-currency)
 						;	     (gnc:numeric-to-double s-value))
 						  (if (not pair)
 						      (begin
@@ -296,14 +305,18 @@
 							;(gnc:debug money-in-alist)
 							)
 						      )
-						  (let ((s-account-in-collector (cadr pair)))
-						    (money-in-collector 'add parent-currency (gnc:numeric-neg s-value))
-						    (s-account-in-collector 'add parent-currency (gnc:numeric-neg s-value)))
+						  (let ((s-account-in-collector (cadr pair))
+							(s-report-value (to-report-currency parent-currency
+											    (gnc:numeric-neg s-value)
+											    (gnc:transaction-get-date-posted
+											     parent))))
+						    (money-in-collector 'add report-currency s-report-value)
+						    (s-account-in-collector 'add report-currency s-report-value))
 						  )
 						(let ((pair (account-in-alist s-account money-out-alist)))
 						  ;(gnc:debug "out:" (gnc:commodity-get-printname s-commodity)
 						;	     (gnc:numeric-to-double s-amount) 
-						;	     (gnc:commodity-get-printname curr-commodity)
+						;	     (gnc:commodity-get-printname parent-currency)
 						;	     (gnc:numeric-to-double s-value))
 						  (if (not pair)
 						      (begin
@@ -313,9 +326,13 @@
 							;(gnc:debug money-out-alist)
 							)
 						      )
-						  (let ((s-account-out-collector (cadr pair)))
-						    (money-out-collector 'add parent-currency s-value)
-						    (s-account-out-collector 'add parent-currency s-value))
+						  (let ((s-account-out-collector (cadr pair))
+							(s-report-value (to-report-currency parent-currency
+											    s-value
+											    (gnc:transaction-get-date-posted
+											     parent))))
+						    (money-out-collector 'add report-currency s-report-value)
+						    (s-account-out-collector 'add report-currency s-report-value))
 						  )
 						)
 					    )
@@ -336,7 +353,17 @@
 
             (calc-money-in-out-internal accounts))
 
+	  ;; Get an exchange function that will convert each transaction using the
+	  ;; nearest available exchange rate if that is what is specified
+	  (set! commodity-list (gnc:accounts-get-commodities
+				accounts
+				report-currency))
+	  (set! time-exchange-fn (gnc:case-exchange-time-fn
+				  price-source report-currency
+				  commodity-list to-date-tp
+				  0 0))
 
+
           (calc-money-in-out accounts)
 
           (money-diff-collector 'merge money-in-collector #f)

Modified: gnucash/trunk/src/report/standard-reports/portfolio.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/portfolio.scm	2006-02-12 20:31:11 UTC (rev 13243)
+++ gnucash/trunk/src/report/standard-reports/portfolio.scm	2006-02-12 21:46:36 UTC (rev 13244)
@@ -106,8 +106,8 @@
   (define (get-option section name)
     (gnc:option-value (get-op section name)))
   
-  (define (table-add-stock-rows table accounts to-date
-                                currency price-fn include-empty collector)
+  (define (table-add-stock-rows table accounts to-date currency
+                                exchange-fn price-fn include-empty collector)
 
    (let ((share-print-info
 	  (gnc:share-print-info-places
@@ -126,20 +126,14 @@
                                   current to-date #f))
                  (units (cadr (unit-collector 'getpair commodity #f)))
 
-                 (price-info (price-fn commodity currency to-date))
+                 (price-info (price-fn commodity to-date))
                  
-                 (value-num (gnc:numeric-mul
-                             units 
-                             (cdr price-info)
-                             (gnc:commodity-get-fraction currency)
-                             GNC-RND-ROUND))
+		 (value (exchange-fn (gnc:make-gnc-monetary commodity units) currency)))
 
-                 (value (gnc:make-gnc-monetary currency value-num)))
-
 	    (set! work-done (+ 1 work-done))
 	    (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
 	    (if (or include-empty (not (gnc:numeric-zero-p units)))
-		(begin (collector 'add currency value-num)
+		(begin (collector 'add currency (gnc:gnc-monetary-amount value))
 		       (gnc:html-table-append-row/markup!
 			table
 			row-style
@@ -153,8 +147,8 @@
 			       "number-cell"
 			       (gnc:html-price-anchor
 				(car price-info)
-				(gnc:make-gnc-monetary currency
-						       (cdr price-info))))
+				(gnc:make-gnc-monetary (gnc:price-get-currency (car price-info))
+						       (gnc:price-get-value (car price-info)))))
 			      (gnc:make-html-table-header-cell/markup
 			       "number-cell" value)))
 		       ;;(display (sprintf #f "Shares: %6.6d  " (gnc:numeric-to-double units)))
@@ -199,32 +193,33 @@
                                  (gnc:acccounts-get-all-subaccounts 
                                   accounts) accounts) currency))
                (pricedb (gnc:book-get-pricedb (gnc:get-current-book)))
+	       (exchange-fn (gnc:case-exchange-fn price-source currency to-date))
                (price-fn
                 (case price-source
                   ('weighted-average 
                    (let ((pricealist 
                           (gnc:get-commoditylist-totalavg-prices
-                           commodity-list currency to-date)))
-                     (lambda (foreign domestic date) 
+                           commodity-list currency to-date 0 0)))
+                     (lambda (foreign date) 
                        (cons #f (gnc:pricealist-lookup-nearest-in-time
 				 pricealist foreign date)))))
                   ('pricedb-latest 
-                   (lambda (foreign domestic date) 
+                   (lambda (foreign date) 
                      (let ((price
-                            (gnc:pricedb-lookup-latest
-                             pricedb foreign domestic)))
-                       (if price
-                           (let ((v (gnc:price-get-value price)))
-                             (cons price v))
+                            (gnc:pricedb-lookup-latest-any-currency
+                             pricedb foreign)))
+                       (if (and price (> (length price) 0))
+                           (let ((v (gnc:price-get-value (car price))))
+                             (cons (car price) v))
                            (cons #f (gnc:numeric-zero))))))
                   ('pricedb-nearest 
-                   (lambda (foreign domestic date) 
+                   (lambda (foreign date) 
                      (let ((price
-                            (gnc:pricedb-lookup-nearest-in-time 
-                             pricedb foreign domestic date)))
-                       (if price
-                           (let ((v (gnc:price-get-value price)))
-                             (cons price v))
+                            (gnc:pricedb-lookup-nearest-in-time-any-currency 
+                             pricedb foreign (gnc:timepair-canonical-day-time date))))
+                       (if (and price (> (length price) 0))
+                           (let ((v (gnc:price-get-value (car price))))
+                             (cons (car price) v))
                            (cons #f (gnc:numeric-zero)))))))))
           
           (gnc:html-table-set-col-headers!
@@ -236,9 +231,14 @@
                  (_ "Price")
                  (_ "Value")))
           
+	  (set! accounts (sort accounts
+			       (lambda (a b)
+				 (string<? (gnc:account-get-name a)
+					   (gnc:account-get-name b)))))
+
           (table-add-stock-rows
            table accounts to-date currency 
-           price-fn include-empty collector)
+           exchange-fn price-fn include-empty collector)
           
           (gnc:html-table-append-row/markup!
            table

Modified: gnucash/trunk/src/report/standard-reports/transaction.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/transaction.scm	2006-02-12 20:31:11 UTC (rev 13243)
+++ gnucash/trunk/src/report/standard-reports/transaction.scm	2006-02-12 21:46:36 UTC (rev 13244)
@@ -56,6 +56,8 @@
 (define optname-sec-date-subtotal (N_ "Secondary Subtotal for Date Key"))
 (define optname-void-transactions (N_ "Void Transactions?"))
 (define optname-table-export (N_ "Table for Exporting"))
+(define optname-common-currency (N_ "Common Currency"))
+(define optname-currency (N_ "Report Currency"))
 (define def:grand-total-style "grand-total")
 (define def:normal-row-style "normal-row")
 (define def:alternate-row-style "alternate-row")
@@ -401,8 +403,13 @@
         (addto! heading-list (_ "Balance")))
     (reverse heading-list)))
 
-(define (add-split-row table split column-vector
+(define (add-split-row table split column-vector options
                        row-style account-types-to-reverse transaction-row?)
+
+  (define (opt-val section name)
+    (gnc:option-value 
+     (gnc:lookup-option options section name)))
+
   (let* ((row-contents '())
 	 (dummy  (gnc:debug "split is originally" split))
          (parent (gnc:split-get-parent split))
@@ -412,14 +419,24 @@
          (currency (if account
                        (gnc:account-get-commodity account)
                        (gnc:default-currency)))
+	 (report-currency (if (opt-val gnc:pagename-general optname-common-currency)
+			       (opt-val gnc:pagename-general optname-currency)
+			       currency))
          (damount (if (gnc:split-voided? split)
 					 (gnc:split-void-former-amount split)
 					 (gnc:split-get-amount split)))
-         (split-value (gnc:make-gnc-monetary 
-                       currency 
-                       (if (member account-type account-types-to-reverse) 
-                           (gnc:numeric-neg damount)
-                           damount))))
+	 (trans-date (gnc:transaction-get-date-posted parent))
+	 (split-value (gnc:exchange-by-pricedb-nearest
+		       (gnc:make-gnc-monetary 
+			currency
+			(if (member account-type account-types-to-reverse) 
+			    (gnc:numeric-neg damount)
+			    damount))
+		       report-currency
+		       ;; Use midday as the transaction time so it matches a price
+		       ;; on the same day.  Otherwise it uses midnight which will
+		       ;; likely match a price on the previous day
+		       (gnc:timepair-canonical-day-time trans-date))))
     
     (if (used-date column-vector)
         (addto! row-contents
@@ -465,7 +482,7 @@
     (if (used-price column-vector)
         (addto! 
          row-contents 
-         (gnc:make-gnc-monetary currency
+         (gnc:make-gnc-monetary (gnc:transaction-get-currency parent)
                                 (gnc:split-get-share-price split))))
     (if (used-amount-single column-vector)
         (addto! row-contents
@@ -524,9 +541,24 @@
                   (N_ "Display 1 line")))))
 
   (gnc:register-trep-option
+   (gnc:make-complex-boolean-option
+    gnc:pagename-general optname-common-currency
+    "e" (N_ "Convert all transactions into a common currency") #f
+    #f
+    (lambda (x) (gnc:option-db-set-option-selectable-by-name
+		 gnc:*transaction-report-options*
+		 gnc:pagename-general
+		 optname-currency
+		 x))
+    ))
+
+  (gnc:options-add-currency!
+   gnc:*transaction-report-options* gnc:pagename-general optname-currency "f")
+
+  (gnc:register-trep-option
    (gnc:make-simple-boolean-option
     gnc:pagename-general optname-table-export
-    "e" (N_ "Formats the table suitable for cut & paste exporting with extra cells") #f))  
+    "g" (N_ "Formats the table suitable for cut & paste exporting with extra cells") #f))  
   
   ;; Accounts options
   
@@ -890,7 +922,7 @@
               ((equal? current split)
                (other-rows-driver split parent table used-columns (+ i 1)))
               (else (begin
-                      (add-split-row table current used-columns
+                      (add-split-row table current used-columns options
                                      row-style account-types-to-reverse #f)
                       (other-rows-driver split parent table used-columns
                                          (+ i 1)))))))
@@ -939,7 +971,8 @@
                (split-value (add-split-row 
                              table 
                              current 
-                             used-columns 
+                             used-columns
+			     options
                              current-row-style
                              account-types-to-reverse
                              #t)))



More information about the gnucash-changes mailing list