mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
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.
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@13244 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Derek Atkins
16
ChangeLog
16
ChangeLog
@@ -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@ihtfp.com>
|
||||
|
||||
* src/report/report-gnome/gnc-plugin-page-report.c:
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -170,112 +170,122 @@
|
||||
(price-list (price-fn commodity to-date))
|
||||
(price (if (> (length price-list) 0)
|
||||
(car price-list) #f))
|
||||
(commod-currency (gnc:price-get-currency price))
|
||||
(value (exchange-fn (gnc:make-gnc-monetary commodity units)
|
||||
currency))
|
||||
)
|
||||
|
||||
(value (exchange-fn (gnc:make-gnc-monetary commodity units) currency to-date))
|
||||
)
|
||||
;; (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))))))))
|
||||
|
||||
;; (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 commod-currency (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)
|
||||
)
|
||||
((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)
|
||||
(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?)
|
||||
(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)
|
||||
|
||||
@@ -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,7 +235,16 @@
|
||||
|
||||
(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)
|
||||
@@ -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,6 +353,16 @@
|
||||
|
||||
(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)
|
||||
|
||||
|
||||
@@ -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 (gnc:make-gnc-monetary currency value-num)))
|
||||
(value (exchange-fn (gnc:make-gnc-monetary commodity units) currency)))
|
||||
|
||||
(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
|
||||
|
||||
@@ -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
|
||||
@@ -523,10 +540,25 @@
|
||||
(N_ "Single")
|
||||
(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 @@ Credit Card, and Income accounts")))))
|
||||
((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)))))))
|
||||
@@ -940,6 +972,7 @@ Credit Card, and Income accounts")))))
|
||||
table
|
||||
current
|
||||
used-columns
|
||||
options
|
||||
current-row-style
|
||||
account-types-to-reverse
|
||||
#t)))
|
||||
|
||||
Reference in New Issue
Block a user