IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Handle reversed prices from gnc_pricedb_lookup*.

Browse Source 
In several cases replaces attempting to check both directions directly. This
had produced incorrect results because an older forward price would be preferred
over a reverse price.
This commit is contained in:
John Ralls 2015-10-29 14:13:37 -07:00
parent edefc9e57c
commit 7adc5e4451
10 changed files with 383 additions and 405 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/app-utils/gnc-sx-instance-model.c
View File

@ -1122,9 +1122,6 @@ create_each_transaction_helper(Transaction *template_txn, void *user_data)
price = gnc_pricedb_lookup_latest(price_db, first_cmdty, split_cmdty);
if (price == NULL)
{
price = gnc_pricedb_lookup_latest(price_db, split_cmdty, first_cmdty);
if (price == NULL)
{
GString *err = g_string_new("");
g_string_printf(err, "could not find pricedb entry for commodity-pair (%s, %s).",
gnc_commodity_get_mnemonic(first_cmdty),
@ -1135,7 +1132,9 @@ create_each_transaction_helper(Transaction *template_txn, void *user_data)
}
else
{
exchange = gnc_numeric_invert(gnc_price_get_value(price));
if (gnc_commodity_equiv(first_cmdty,
gnc_price_get_commodity(price)))
exchange = gnc_numeric_invert(gnc_price_get_value(price));
exchange = gnc_numeric_convert(exchange, 1000,
GNC_HOW_RND_ROUND_HALF_UP);
}

24
src/gnome-utils/dialog-transfer.c
View File

@ -263,34 +263,18 @@ lookup_price(PriceReq *pr, PriceDate pd)
case SAME_DAY:
prc = gnc_pricedb_lookup_day (pr->pricedb, pr->from,
pr->to, pr->ts);
if (!prc)
{
prc = gnc_pricedb_lookup_day (pr->pricedb, pr->to,
pr->from, pr->ts);
pr->reverse = TRUE;
}
break;
break;
case NEAREST:
prc = gnc_pricedb_lookup_nearest_in_time (pr->pricedb, pr->from,
pr->to, pr->ts);
if (!prc)
{
prc = gnc_pricedb_lookup_nearest_in_time (pr->pricedb, pr->to,
pr->from, pr->ts);
pr->reverse = TRUE;
}
break;
break;
case LATEST:
prc = gnc_pricedb_lookup_latest (pr->pricedb, pr->from, pr->to);
if (!prc)
{
prc = gnc_pricedb_lookup_latest (pr->pricedb, pr->to, pr->from);
pr->reverse = TRUE;
}
break;
}
if (pr->reverse)
if (gnc_commodity_equiv(gnc_price_get_currency(prc), pr->from))
{
pr->reverse = TRUE;
PINFO("Found reverse price: 1 %s = %f %s",
gnc_commodity_get_mnemonic(pr->to),
gnc_numeric_to_double(gnc_price_get_value(prc)),

32
src/gnome-utils/gnc-tree-util-split-reg.c
View File

@ -90,38 +90,16 @@ static gnc_numeric
gtu_sr_get_rate_from_db (gnc_commodity *from, gnc_commodity *to)
{
GNCPrice *prc;
gnc_numeric rate_split;
gboolean have_rate = FALSE;
QofBook *book = gnc_get_current_book ();
/* Do we have a rate allready */
prc = gnc_pricedb_lookup_latest (gnc_pricedb_get_db (book), from, to);
if (prc)
{
rate_split = gnc_price_get_value (prc);
gnc_price_unref (prc);
have_rate = TRUE;
}
/* Lets try reversing the commodities */
if (!have_rate)
{
prc = gnc_pricedb_lookup_latest (gnc_pricedb_get_db (book), to, from);
if (prc)
{
rate_split = gnc_numeric_div (gnc_numeric_create (100, 100), gnc_price_get_value (prc),
GNC_DENOM_AUTO, GNC_HOW_DENOM_REDUCE);
if (!prc)
return gnc_numeric_create (100, 100);
gnc_price_unref (prc);
have_rate = TRUE;
}
}
/* No rate, set to 1/1 */
if (!have_rate)
rate_split = gnc_numeric_create (100, 100);
return rate_split;
if (gnc_commodity_equiv(from, gnc_price_get_currency(prc)))
return gnc_numeric_invert(gnc_price_get_value(prc));
return gnc_price_get_value(prc);
}

5
src/gnome/assistant-stock-split.c
View File

@ -231,7 +231,10 @@ refresh_details_page (StockSplitInfo *info)
if (prices)
{
/* Use the first existing price */
currency = gnc_price_get_currency(prices->data);
if (gnc_commodity_equiv (commodity, gnc_price_get_currency(prices->data)))
currency = gnc_price_get_commodity(prices->data);
else
currency = gnc_price_get_currency(prices->data);
}
else
{

6
src/gnome/dialog-price-editor.c
View File

@ -347,7 +347,11 @@ pedit_commodity_changed_cb (GtkComboBox *cbwe, gpointer data)
(pedit_dialog->price_db, commodity);
if (price_list)
{
currency = gnc_price_get_currency((GNCPrice *)price_list->data);
GNCPrice * price = (GNCPrice*)price_list->data;
if (gnc_commodity_equiv(commodity, gnc_price_get_currency(price)))
currency = gnc_price_get_commodity((GNCPrice *)price);
else
currency = gnc_price_get_currency((GNCPrice *)price);
if (currency)
gnc_currency_edit_set_currency

10
src/register/ledger-core/split-register.c
View File

@ -2067,15 +2067,9 @@ record_price (SplitRegister *reg, Account *account, gnc_numeric value,
return;
gnc_date_cell_get_date ((DateCell*)cell, &ts);
price = gnc_pricedb_lookup_day (pricedb, comm, curr, ts);
if (!price)
{
price = gnc_pricedb_lookup_day (pricedb, curr, comm, ts);
if (price)
/* It might be better to raise an error here: We shouldn't be creating
* currency->commodity prices.
*/
if (gnc_commodity_equiv (comm, gnc_price_get_currency (price)))
swap = TRUE;
}
if (price)
{
price_value = gnc_price_get_value(price);

189
src/report/locale-specific/us/taxtxf.scm
View File

@ -1,5 +1,5 @@
;; -*-scheme-*-
;; by Richard -Gilligan- Uschold
;; by Richard -Gilligan- Uschold
;;
;; updated by J. Alex Aycinena, July 2008, October 2009
;;
@ -46,7 +46,7 @@
;; Add support for Format 6
;; Use Form/Schedule line #'s to sort report.
;; Update from "V037" to "V041"
;; Add support for taxpayer types other than F1040
;; Add support for taxpayer types other than F1040
;;
;; September, 2010 Update:
;;
@ -60,7 +60,7 @@
;;
;; February, 2013 Update:
;;
;; Fix beginning balance sign and signs for Transfer From/To amounts for
;; Fix beginning balance sign and signs for Transfer From/To amounts for
;; liability/equity accounts
;;
;; From prior version:
@ -142,7 +142,7 @@
;; returns a predicate that returns true only if a split is
;; between early-date and late-date
(define (split-report-make-date-filter-predicate begin-date-tp end-date-tp)
(lambda (split)
(lambda (split)
(let ((tp
(gnc-transaction-get-date-posted
(xaccSplitGetParent split))))
@ -169,9 +169,9 @@
(define (gnc:register-tax-option new-option)
(gnc:register-option options new-option))
;; date at which to report
;; date at which to report
(gnc:options-add-date-interval!
options gnc:pagename-general
options gnc:pagename-general
(N_ "From") (N_ "To") "a")
(gnc:register-tax-option
@ -216,7 +216,7 @@
"d" (N_ "Select accounts.")
(lambda () '())
#f #t))
(gnc:register-tax-option
(gnc:make-simple-boolean-option
gnc:pagename-display (N_ "Suppress $0.00 values")
@ -419,7 +419,7 @@
(define (render-header-row table heading-line-text)
(let ((heading (gnc:make-html-text)))
(gnc:html-text-append! heading (gnc:html-markup-b heading-line-text))
(gnc:html-text-append! heading (gnc:html-markup-b heading-line-text))
(let ((heading-cell (gnc:make-html-table-cell/markup
"header-just-top" heading)))
(gnc:html-table-cell-set-colspan! heading-cell 6)
@ -469,17 +469,17 @@
(let ((description (gnc:make-html-text))
(total (gnc:make-html-text)))
(if (or tax_code? transaction-details?)
(gnc:html-text-append! description (gnc:html-markup-b
(gnc:html-text-append! description (gnc:html-markup-b
(string-append "       "
(if end-bal-text end-bal-text "Total For "))))
(if (not tax_code?)
(gnc:html-text-append! description (gnc:html-markup-b
(gnc:html-text-append! description (gnc:html-markup-b
"       "))
)
)
(gnc:html-text-append! description (gnc:html-markup-b
(gnc:html-text-append! description (gnc:html-markup-b
total-line-text))
(gnc:html-text-append! description (gnc:html-markup-b
(gnc:html-text-append! description (gnc:html-markup-b
" "))
(gnc:html-text-append! total (gnc:html-markup-b
total-amount))
@ -490,12 +490,12 @@
(amount-table (gnc:make-html-table)) ;; to line up totals to details
(cap-gains-detail-table (gnc:make-html-table))
)
(gnc:html-table-set-style! amount-table "table"
(gnc:html-table-set-style! amount-table "table"
'attribute (list "border" "0")
'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0")
'attribute (list "width" "100%"))
(gnc:html-table-set-style! cap-gains-detail-table "table"
(gnc:html-table-set-style! cap-gains-detail-table "table"
'attribute (list "border" "0")
'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0")
@ -580,10 +580,10 @@
"Equity"
""))))))
(category-key (get-acct-txf-info 'cat-key type code))
(value-name (cond
(value-name (cond
((string=? tax-entity-type "F1040")
(if (equal? "ReinvD" action)
(string-append
(string-append
(xaccPrintAmount
(gnc-numeric-neg account-value) print-info)
" " txf-account-name)
@ -634,7 +634,7 @@
;; sub-lines of line 5 starting with 1 for first reported payer
;; these apply if pns is either 'current or 'parent', but not
;; otherwise
"L" (number->string txf-l-count) crlf
"L" (number->string txf-l-count) crlf
(if (= format 4)
(if x?
(list "P" sold-desc crlf "D" crlf "D" date-str crlf
@ -656,11 +656,11 @@
'())) ;; not detail
(else '()))
(if x?
(cond
(cond
((string=? tax-entity-type "F1040")
(list "X" x-date-str " "
(fill-clamp-sp txf-account-name 31)
(fill-clamp-sp action 7)
(fill-clamp-sp action 7)
(fill-clamp-sp value-name 82)
(fill-clamp category-key 15) crlf))
((or (string=? tax-entity-type "F1065")
@ -724,12 +724,15 @@
(begin ;; do so
(set! missing-pricedb-entry? #f)
(set! pricedb-lookup-price
(gnc-pricedb-lookup-nearest-in-time
(let ((price (gnc-pricedb-lookup-nearest-in-time
pricedb
account-commodity
USD-currency
(timespecCanonicalDayTime
lookup-date)))
lookup-date))))
(if (gnc-commodity-equiv account-commodity (gnc-price-get-currency price))
(set! price (gnc-price-invert price)))
price))
(set! pricedb-lookup-price-value
(gnc-price-get-value
pricedb-lookup-price))
@ -784,7 +787,7 @@
)
" "
converted-qty
(if
(if
(and (not (gnc-commodity-equiv account-commodity
USD-currency))
(not (gnc-commodity-equiv trans-currency
@ -827,7 +830,7 @@
)
""))
)
)
)
(list amount conversion-text pricedb-lookup-price conversion-text2)
)
)
@ -850,16 +853,16 @@
)
(if (= 4 format)
(begin
(gnc:html-table-set-style! cap-gains-detail-table "table"
(gnc:html-table-set-style! cap-gains-detail-table "table"
'attribute (list "border" "0")
'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "3")
'attribute (list "width" "100%"))
(gnc:html-table-set-style! trans-sub-heading-table "table"
(gnc:html-table-set-style! trans-sub-heading-table "table"
'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0")
'attribute (list "width" "100%"))
(gnc:html-table-set-style! trans-sub-table "table"
(gnc:html-table-set-style! trans-sub-table "table"
'attribute (list "border" "0")
'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0")
@ -957,18 +960,18 @@
(if (and (= 4 format) (gnc-numeric-negative-p
(xaccSplitGetAmount tran-split)))
(begin
(if tax-mode?
(if tax-mode?
(gnc:html-table-append-row!
cap-gains-detail-table
(append (list (gnc:make-html-table-cell
(string-append
(string-append
(xaccPrintAmount
(gnc-numeric-neg
(gnc-numeric-neg
(xaccSplitGetAmount
tran-split))
print-info)
" "
(gnc-commodity-get-mnemonic
(gnc-commodity-get-mnemonic
split-acct-commodity))))
(list (gnc:make-html-table-cell/markup
"text-cell-center"
@ -1000,13 +1003,13 @@
tax-code
copy
tax-entity-type
(string-append
(string-append
(xaccPrintAmount
(gnc-numeric-neg
(gnc-numeric-neg
(xaccSplitGetAmount
tran-split)) print-info)
" "
(gnc-commodity-get-mnemonic
(gnc-commodity-get-mnemonic
split-acct-commodity))
)))
)
@ -1135,7 +1138,7 @@
tax-mode? show-TXF-data? USD-currency account-type
tax-code acct-full-name acct-beg-bal-collector
acct-end-bal-collector copy tax-entity-type)
(let*
((account-commodity (xaccAccountGetCommodity account))
(format (get-acct-txf-info 'format account-type tax-code))
@ -1296,7 +1299,7 @@
)
#f)
(gnc:html-table-cell-set-colspan! beg-bal-cell 5)
(gnc:html-table-set-style! amount-table "table"
(gnc:html-table-set-style! amount-table "table"
'attribute (list "border" "0")
'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0")
@ -1343,12 +1346,12 @@
(if (and (> (length split-list) 0)
(not (txf-beg-bal-only? tax-code)))
(set! output
(map (lambda (split)
(map (lambda (split)
(let* ((parent (xaccSplitGetParent split))
(trans-date (gnc-transaction-get-date-posted parent))
;; TurboTax 1999 and 2000 ignore dates after Dec 31
(fudge-date (if splits-period
(if (and full-year?
(if (and full-year?
(gnc:timepair-lt to-value trans-date))
to-value
trans-date)
@ -1379,7 +1382,7 @@
(eq? account-type ACCT-TYPE-LIABILITY)
(eq? account-type ACCT-TYPE-EQUITY))
(gnc-numeric-neg splt-amount)
splt-amount))
splt-amount))
(curr-conv-note "")
(curr-conv-data (list splt-rpt-amount curr-conv-note #f ""))
(curr-conv-data (if (and (gnc-commodity-equiv
@ -1437,7 +1440,7 @@
(eq? account-type ACCT-TYPE-LIABILITY)
(eq? account-type ACCT-TYPE-EQUITY))
(gnc-numeric-neg splt-amount)
splt-amount))
splt-amount))
(acct-collector-as-dr 'add account-commodity splt-amount)
(set! account-USD-total (gnc-numeric-add-fixed
account-USD-total print-amnt))
@ -1445,19 +1448,19 @@
;; transaction-multi-transfer-detail routine for TXF output and
;; to accumulate capital gains totals for account-, tax-code-,
;; and form-level totals even when not printing transaction
;; details and/or Transfer To/From Accounts
;; details and/or Transfer To/From Accounts
(if (or (and transaction-details? tax-mode?
(null? other-account) split-details?)
(= 4 format)
)
(let ((cap-gain-data
(let ((cap-gain-data
(process-transaction-multi-transfer-detail
split
parent
USD-currency
full-names?
trans-date
trans-currency
trans-currency
account-type
currency-conversion-date
to-value
@ -1486,17 +1489,17 @@
))
(if (and transaction-details? tax-mode?)
(begin
(gnc:html-table-set-style! date-table "table"
(gnc:html-table-set-style! date-table "table"
'attribute (list "border" "0")
'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0"))
(gnc:html-table-append-row!
date-table
(gnc:make-html-table-cell/markup
"date-cell"
"date-cell"
(strftime "%Y-%b-%d"
(localtime (car trans-date)))))
(gnc:html-table-set-style! num-table "table"
(gnc:html-table-set-style! num-table "table"
'attribute (list "border" "0")
'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0"))
@ -1504,7 +1507,7 @@
num-table
(gnc:make-html-table-cell (gnc-get-num-action
parent split)))
(gnc:html-table-set-style! desc-table "table"
(gnc:html-table-set-style! desc-table "table"
'attribute (list "border" "0")
'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0"))
@ -1512,14 +1515,14 @@
desc-table
(gnc:make-html-table-cell
(xaccTransGetDescription parent)))
(gnc:html-table-set-style! notes-table "table"
(gnc:html-table-set-style! notes-table "table"
'attribute (list "border" "0")
'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0"))
(gnc:html-table-append-row!
notes-table
(gnc:make-html-table-cell notes-act-memo))
(gnc:html-table-set-style! transfer-table "table"
(gnc:html-table-set-style! transfer-table "table"
'attribute (list "border" "0")
'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0")
@ -1571,7 +1574,7 @@
)
)
)
(gnc:html-table-set-style! amount-table "table"
(gnc:html-table-set-style! amount-table "table"
'attribute (list "border" "0")
'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0")
@ -1744,7 +1747,7 @@
(define (get-option pagename optname)
(gnc:option-value
(gnc:lookup-option
(gnc:lookup-option
(gnc:report-options report-obj) pagename optname)))
(define tax-entity-type (gnc-get-current-book-tax-type))
@ -1795,7 +1798,7 @@
#f
#t))
(let* ((form (if form form "")) ;; needed for "N000'
(copy (number->string
(copy (number->string
(xaccAccountGetTaxUSCopyNumber account)))
(line (get-acct-txf-info 'line type tax-code-sym))
(line (if line
@ -1892,7 +1895,7 @@
"None"
(list "Set as tax-related, no tax code assigned"
account-name form account)))
selected-accounts-sorted-by-form-line-acct)
selected-accounts-sorted-by-form-line-acct)
(begin ;; not tax related - skip for report
selected-accounts-sorted-by-form-line-acct)
)
@ -1948,7 +1951,7 @@
(if prior-char-num?
(begin
(if (string=? string-part "")
#f
#f
(set! lst (append lst (list
(string->number string-part)))))
(set! string-part (string char))
@ -2040,14 +2043,14 @@
"USD"))
(gnc:report-starting reportname)
(let* ((from-value (gnc:date-option-absolute-time
(let* ((from-value (gnc:date-option-absolute-time
(get-option gnc:pagename-general "From")))
(to-value (gnc:timepair-end-day-time
(gnc:date-option-absolute-time
(gnc:date-option-absolute-time
(get-option gnc:pagename-general "To"))))
(alt-period (get-option gnc:pagename-general "Alternate Period"))
(selected-style-sheet (get-option gnc:pagename-general "Stylesheet"))
(suppress-0? (get-option gnc:pagename-display
(suppress-0? (get-option gnc:pagename-display
"Suppress $0.00 values"))
(full-names? (not (get-option gnc:pagename-display
"Do not print full account names")))
@ -2063,13 +2066,13 @@
(gnc:report-options report-obj)
gnc:pagename-display
"Do not print Action:Memo data")
(get-option gnc:pagename-display
(get-option gnc:pagename-display
"Do not print Action:Memo data")
(get-option gnc:pagename-display
(get-option gnc:pagename-display
"Do not print T-Num:Memo data")))
(shade-alternate-transactions? (if (gnc-html-engine-supports-css)
#t
(get-option gnc:pagename-display
#t
(get-option gnc:pagename-display
"Shade alternate transactions")))
(currency-conversion-date (get-option gnc:pagename-display
"Currency conversion date"))
@ -2079,7 +2082,7 @@
;; If no selected accounts, check all.
(selected-accounts (if (not (null? user-sel-accnts))
valid-user-sel-accnts
(validate (reverse
(validate (reverse
(gnc-account-get-children-sorted
(gnc-get-current-root-account))))))
@ -2090,13 +2093,13 @@
(from-date (gnc:timepair->date from-value))
(from-value (gnc:timepair-start-day-time
(let ((bdtm from-date))
(if (member alt-period
(if (member alt-period
'(last-year 1st-last 2nd-last
3rd-last 4th-last))
(set-tm:year bdtm (- (tm:year bdtm) 1)))
(or (eq? alt-period 'from-to)
(set-tm:mday bdtm 1))
(if (< (gnc:date-get-year bdtm)
(if (< (gnc:date-get-year bdtm)
tax-qtr-real-qtr-year)
(case alt-period
((1st-est 1st-last last-year) ; Jan 1
@ -2122,7 +2125,7 @@
(to-value (gnc:timepair-end-day-time
(let ((bdtm from-date))
(if (member alt-period
(if (member alt-period
'(last-year 1st-last 2nd-last
3rd-last 4th-last))
(set-tm:year bdtm (- (tm:year bdtm) 1)))
@ -2130,7 +2133,7 @@
;; The exact same code, in from-value, further above,
;; only subtraces one! Go figure!
;; So, we add one back below!
(if (member alt-period
(if (member alt-period
'(last-year 1st-last 2nd-last
3rd-last 4th-last))
(set-tm:year bdtm (+ (tm:year bdtm) 1)))
@ -2159,7 +2162,7 @@
(set-tm:mon bdtm 8))
((4th-est 4th-last last-year) ; Dec 31
(set-tm:mon bdtm 11))
(else
(else
(set! bdtm (gnc:timepair->date to-value)))))
(set-tm:isdst bdtm -1)
(cons (car (mktime bdtm)) 0))))
@ -2177,7 +2180,7 @@
(define (txf-special-splits-period account from-value to-value)
(if (and (xaccAccountGetTaxRelated account)
(txf-special-date? (gnc:account-get-txf-code account)))
(let*
(let*
((full-year?
(let ((bdto (localtime (car to-value)))
(bdfrom (localtime (car from-value))))
@ -2252,13 +2255,13 @@
(acct-beg-bal-collector (if (not
(or (eq? account-type ACCT-TYPE-INCOME)
(eq? account-type ACCT-TYPE-EXPENSE)))
(gnc:account-get-comm-balance-at-date account
(gnc:account-get-comm-balance-at-date account
(gnc:timepair-previous-day from-value) #f)
#f))
(acct-end-bal-collector (if (not
(or (eq? account-type ACCT-TYPE-INCOME)
(eq? account-type ACCT-TYPE-EXPENSE)))
(gnc:account-get-comm-balance-at-date account
(gnc:account-get-comm-balance-at-date account
to-value #f)
#f))
(account-commodity (xaccAccountGetCommodity account))
@ -2395,8 +2398,8 @@
(let ((from-date (strftime "%Y-%b-%d" (localtime (car from-value))))
(to-date (strftime "%Y-%b-%d" (localtime (car to-value))))
(today-date (strftime "D%m/%d/%Y"
(localtime
(today-date (strftime "D%m/%d/%Y"
(localtime
(car (timespecCanonicalDayTime
(cons (current-time) 0))))))
(tax-year (strftime "%Y" (localtime (car from-value))))
@ -2496,7 +2499,7 @@
(xaccPrintAmount
tax-code-sub-item-USD-total
print-info))
)
)
;; print prior tax-code-sub-item
;; total and reset accum
(render-total-row
@ -2562,7 +2565,7 @@
)
)
;; process prior tax code break, if appropriate, before
;; processing current account
;; processing current account
(if (string=? prior-tax-code "")
#t ;; do nothing
(if tax-mode?
@ -2590,7 +2593,7 @@
(xaccPrintAmount
tax-code-cap-gain-basis-USD-total
print-info))
)
)
;; print prior tax-code total and
;; reset accum
(render-total-row
@ -2711,7 +2714,7 @@
)
)
;; process prior form-schedule-line break, if appropriate,
;; before processing current account
;; before processing current account
(if (string=? prior-form-sched-line "")
(set! form-sched-line-USD-total (gnc-numeric-zero))
(if tax-mode?
@ -2738,7 +2741,7 @@
(xaccPrintAmount
form-sched-line-cap-gain-sales-USD-total
print-info))
)
)
;; print prior form-schedule-line total
;; and reset accum
(render-total-row
@ -2835,7 +2838,7 @@
""
(string-append "Line "
current-form-sched-line ": "))
description " ("
description " ("
(substring current-tax-code 1
(string-length current-tax-code))
(if show-TXF-data?
@ -2854,7 +2857,7 @@
"Y"
"N")
", TXF Format "
(number->string
(number->string
(get-acct-txf-info
'format
type
@ -2989,7 +2992,7 @@
))
(if (not tax-mode?) ; Do Txf mode
(if tax-entity-type-valid?
(if tax-entity-type-valid?
(if file-name ; cancel TXF if no file selected
(let ((port (catch #t ;;e.g., system-error
(lambda () (open-output-file file-name))
@ -3018,7 +3021,7 @@
today-date crlf
"^" crlf
output
(if (or
(if (or
(gnc-numeric-zero-p tax-code-USD-total)
(not prior-account))
'()
@ -3050,7 +3053,7 @@
(if prior-account
(gnc:display-report-list-item output-txf port
"taxtxf.scm - ")
#f)
#f)
(close-output-port port)
#t
) ; end of let
@ -3173,8 +3176,8 @@
(gnc:html-document-set-title! doc report-name)
(gnc:html-document-add-object!
doc (gnc:make-html-text
(gnc:html-document-add-object!
doc (gnc:make-html-text
(gnc:html-markup-p
(gnc:html-markup
"center"
@ -3199,8 +3202,8 @@
(if (not (null? txf-invalid-alist))
(begin
(gnc:html-document-add-object!
doc (gnc:make-html-text
(gnc:html-document-add-object!
doc (gnc:make-html-text
(gnc:html-markup-p
(gnc:html-markup/format
"<BR>The following Account(s) have errors with their Income Tax code assignments (use 'Edit->Tax Report Options' to correct):"))))
@ -3262,8 +3265,8 @@
)
)
txf-invalid-alist)
(gnc:html-document-add-object!
doc (gnc:make-html-text
(gnc:html-document-add-object!
doc (gnc:make-html-text
(gnc:html-markup-p
(gnc:html-markup/format
" <BR> "))))
@ -3272,7 +3275,7 @@
(gnc:html-document-add-object! doc table)
(if tax-entity-type-valid?
(if tax-entity-type-valid?
(map (lambda (form-line-acct) (handle-tax-code form-line-acct))
selected-accounts-sorted-by-form-line-acct))
@ -3307,7 +3310,7 @@
(tax-code-sub-item-total-amount
(xaccPrintAmount tax-code-sub-item-USD-total
print-info))
)
)
(render-total-row
table
tax-code-sub-item-total-amount
@ -3360,7 +3363,7 @@
(xaccPrintAmount
tax-code-cap-gain-basis-USD-total
print-info))
)
)
(render-total-row table tax-code-total-amount
(string-append "Line (Code): "
saved-tax-code-text)
@ -3405,7 +3408,7 @@
(xaccPrintAmount
form-sched-line-cap-gain-basis-USD-total
print-info))
)
)
;; print prior form-schedule-line total; reset accum
(render-total-row
table
@ -3452,8 +3455,8 @@
"The Income Tax Report is only available for valid Income Tax Entity Types. Go to the Edit->Tax Report Options dialog to change your Income Tax Entity Type selection and set up tax-related accounts."
"No Tax Related accounts were found with your account selection. Change your selection or go to the Edit->Tax Report Options dialog to set up tax-related accounts."))))
;; or print selected report options
(gnc:html-document-add-object!
doc (gnc:make-html-text
(gnc:html-document-add-object!
doc (gnc:make-html-text
(gnc:html-markup-p
(gnc:html-markup/format
(string-append

344
src/report/standard-reports/advanced-portfolio.scm
View File

@ -6,16 +6,16 @@
;; Heavily based on portfolio.scm
;; by Robert Merkel (rgmerk@mira.net)
;;
;; 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.
;;
;; 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:
;;
@ -54,34 +54,34 @@
(define units-denom 100000000)
(define (options-generator)
(let* ((options (gnc:new-options))
(let* ((options (gnc:new-options))
;; This is just a helper function for making options.
;; See gnucash/src/scm/options.scm for details.
(add-option
(add-option
(lambda (new-option)
(gnc:register-option options new-option))))
;; General Tab
;; date at which to report balance
(gnc:options-add-report-date!
options gnc:pagename-general
options gnc:pagename-general
(N_ "Date") "a")
(gnc:options-add-currency!
(gnc:options-add-currency!
options gnc:pagename-general (N_ "Report's currency") "c")
(add-option
(gnc:make-multichoice-option
gnc:pagename-general optname-price-source
"d" (N_ "The source of price information.") 'pricedb-nearest
(list (vector 'pricedb-latest
(list (vector 'pricedb-latest
(N_ "Most recent")
(N_ "The most recent recorded price."))
(vector 'pricedb-nearest
(N_ "Nearest in time")
(N_ "The price recorded nearest in time to the report date."))
)))
(add-option
(gnc:make-multichoice-option
gnc:pagename-general optname-basis-method
@ -99,7 +99,7 @@
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-general optname-prefer-pricelist "f"
gnc:pagename-general optname-prefer-pricelist "f"
(N_ "Prefer use of price editor pricing over transactions, where applicable.")
#t))
@ -117,7 +117,7 @@
(N_ "Ignore")
(N_ "Ignore brokerage fees entirely."))
)))
(gnc:register-option
options
(gnc:make-simple-boolean-option
@ -161,18 +161,18 @@
(lambda () (filter gnc:account-is-stock?
(gnc-account-get-descendants-sorted
(gnc-get-current-root-account))))
(lambda (accounts) (list #t
(lambda (accounts) (list #t
(filter gnc:account-is-stock? accounts)))
#t))
(gnc:register-option
options
(gnc:register-option
options
(gnc:make-simple-boolean-option
gnc:pagename-accounts optname-zero-shares "e"
gnc:pagename-accounts optname-zero-shares "e"
(N_ "Include accounts that have a zero share balances.")
#f))
(gnc:options-set-default-section options gnc:pagename-general)
(gnc:options-set-default-section options gnc:pagename-general)
options))
;; This is the rendering function. It accepts a database of options
@ -183,7 +183,7 @@
;; defined above.
(define (advanced-portfolio-renderer report-obj)
(let ((work-done 0)
(work-to-do 0)
(warn-no-price #f)
@ -192,10 +192,10 @@
;; 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))
(define (get-option section name)
(gnc:option-value (get-op section name)))
(define (split-account-type? split type)
(eq? type (xaccAccountGetType (xaccSplitGetAccount split))))
@ -213,11 +213,11 @@
(gnc-numeric-zero)
)
)
;; sum up the total number of units in the b-list built by basis-builder below
(define (units-basis b-list)
(if (not (eqv? b-list '()))
(gnc-numeric-add (caar b-list) (units-basis (cdr b-list))
(gnc-numeric-add (caar b-list) (units-basis (cdr b-list))
units-denom GNC-RND-ROUND)
(gnc-numeric-zero)
)
@ -231,42 +231,42 @@
(gnc-numeric-mul value-ratio (cdar b-list) price-denom GNC-RND-ROUND))
(apply-basis-ratio (cdr b-list) units-ratio value-ratio))
'()
)
)
)
;; this builds a list for basis calculation and handles average, fifo and lifo methods
;; the list is cons cells of (units-of-stock . price-per-unit)... average method produces only one
;; cell that mutates to the new average. Need to add a date checker so that we allow for prices
;; coming in out of order, such as a transfer with a price adjusted to carryover the basis.
(define (basis-builder b-list b-units b-value b-method currency-frac)
(gnc:debug "actually in basis-builder")
(gnc:debug "b-list is " b-list " b-units is " (gnc-numeric-to-string b-units)
(gnc:debug "b-list is " b-list " b-units is " (gnc-numeric-to-string b-units)
" b-value is " (gnc-numeric-to-string b-value) " b-method is " b-method)
;; if there is no b-value, then this is a split/merger and needs special handling
(cond
(cond
;; we have value and positive units, add units to basis
((and (not (gnc-numeric-zero-p b-value))
(gnc-numeric-positive-p b-units))
(case b-method
((average-basis)
((average-basis)
(if (not (eqv? b-list '()))
(list (cons (gnc-numeric-add b-units
(caar b-list) units-denom GNC-RND-ROUND)
(caar b-list) units-denom GNC-RND-ROUND)
(gnc-numeric-div
(gnc-numeric-add b-value
(gnc-numeric-mul (caar b-list)
(cdar b-list)
(cdar b-list)
GNC-DENOM-AUTO GNC-DENOM-REDUCE)
GNC-DENOM-AUTO GNC-DENOM-REDUCE)
(gnc-numeric-add b-units
(caar b-list) GNC-DENOM-AUTO GNC-DENOM-REDUCE)
price-denom GNC-RND-ROUND)))
(append b-list
(append b-list
(list (cons b-units (gnc-numeric-div
b-value b-units price-denom GNC-RND-ROUND))))))
(else (append b-list
(else (append b-list
(list (cons b-units (gnc-numeric-div
b-value b-units price-denom GNC-RND-ROUND)))))))
@ -275,7 +275,7 @@
(gnc-numeric-negative-p b-units))
(if (not (eqv? b-list '()))
(case b-method
((fifo-basis)
((fifo-basis)
(case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar b-list))
((-1)
;; Sold less than the first lot, create a new first lot from the remainder
@ -284,12 +284,12 @@
((0)
;; Sold all of the first lot
(cdr b-list))
((1)
((1)
;; Sold more than the first lot, delete it and recurse
(basis-builder (cdr b-list) (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND)
b-value ;; Only the sign of b-value matters since the new b-units is negative
b-method currency-frac))))
((filo-basis)
((filo-basis)
(let ((rev-b-list (reverse b-list)))
(case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar rev-b-list))
((-1)
@ -305,29 +305,29 @@
(basis-builder (reverse (cdr rev-b-list)) (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND)
b-value b-method currency-frac)
))))
((average-basis)
((average-basis)
(list (cons (gnc-numeric-add
(caar b-list) b-units units-denom GNC-RND-ROUND)
(caar b-list) b-units units-denom GNC-RND-ROUND)
(cdar b-list)))))
'()
))
;; no value, just units, this is a split/merge...
((and (gnc-numeric-zero-p b-value)
(not (gnc-numeric-zero-p b-units)))
(let* ((current-units (units-basis b-list))
(units-ratio (gnc-numeric-div (gnc-numeric-add b-units current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)
(units-ratio (gnc-numeric-div (gnc-numeric-add b-units current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)
current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE))
;; If the units ratio is zero the stock is worthless and the value should be zero too
;; If the units ratio is zero the stock is worthless and the value should be zero too
(value-ratio (if (gnc-numeric-zero-p units-ratio)
(gnc-numeric-zero)
(gnc-numeric-div (gnc:make-gnc-numeric 1 1) units-ratio GNC-DENOM-AUTO GNC-DENOM-REDUCE))))
(gnc:debug "blist is " b-list " current units is "
(gnc-numeric-to-string current-units)
(gnc:debug "blist is " b-list " current units is "
(gnc-numeric-to-string current-units)
" value ratio is " (gnc-numeric-to-string value-ratio)
" units ratio is " (gnc-numeric-to-string units-ratio))
(apply-basis-ratio b-list units-ratio value-ratio)
(apply-basis-ratio b-list units-ratio value-ratio)
))
;; If there are no units, just a value, then its a spin-off,
@ -336,9 +336,9 @@
((and (gnc-numeric-zero-p b-units)
(not (gnc-numeric-zero-p b-value)))
(let* ((current-value (sum-basis b-list GNC-DENOM-AUTO))
(value-ratio (gnc-numeric-div (gnc-numeric-add b-value current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE)
(value-ratio (gnc-numeric-div (gnc-numeric-add b-value current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE)
current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE)))
(gnc:debug "this is a spinoff")
(gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string value-ratio))
(apply-basis-ratio b-list (gnc:make-gnc-numeric 1 1) value-ratio))
@ -359,20 +359,22 @@
(for-each
(lambda (p)
(if (gnc-commodity-equiv currency (gnc-price-get-currency p))
(set! price p)))
(set! price p))
(if (gnc-commodity-equiv currency (gnc-price-get-commodity p))
(set! price (gnc-price-invert p))))
price-list)
(gnc-price-ref price)
(gnc-price-list-destroy price-list)
price)))
;; Return true if either account is the parent of the other or they are siblings
(define (parent-or-sibling? a1 a2)
(let ((a2parent (gnc-account-get-parent a2))
(a1parent (gnc-account-get-parent a1)))
(or (same-account? a2parent a1)
(same-account? a1parent a2)
(same-account? a1parent a2)
(same-account? a1parent a2parent))))
;; Test whether the given split is the source of a spin off transaction
;; This will be a no-units split with only one other split.
;; xaccSplitGetOtherSplit only returns on a two-split txn. It's not a spinoff
@ -384,21 +386,21 @@
(not (null? other-split))
(not (split-account-type? other-split ACCT-TYPE-EXPENSE))
(not (split-account-type? other-split ACCT-TYPE-INCOME)))))
(define (table-add-stock-rows table accounts to-date
currency price-fn exchange-fn price-source
include-empty show-symbol show-listing show-shares show-price
basis-method prefer-pricelist handle-brokerage-fees
basis-method prefer-pricelist handle-brokerage-fees
total-basis total-value
total-moneyin total-moneyout total-income total-gain
total-moneyin total-moneyout total-income total-gain
total-ugain total-brokerage)
(let ((share-print-info
(gnc-share-print-info-places
(inexact->exact (get-option gnc:pagename-display
optname-shares-digits)))))
(define (table-add-stock-rows-internal accounts odd-row?)
(if (null? accounts) total-value
(let* ((row-style (if odd-row? "normal-row" "alternate-row"))
@ -447,7 +449,7 @@
(exchange-fn
;; This currency will usually be the same as tocurrency so the
;; call to exchange-fn below will do nothing
(gnc:make-gnc-monetary
(gnc:make-gnc-monetary
(if use-txn
(gnc:gnc-monetary-commodity price)
(gnc-price-get-currency price))
@ -458,30 +460,30 @@
currency-frac GNC-RND-ROUND))
tocurrency)
(exchange-fn fromunits tocurrency)))
(gnc:debug "Starting account " (xaccAccountGetName current) ", initial price: "
(gnc:debug "Starting account " (xaccAccountGetName current) ", initial price: "
(if price
(gnc-commodity-value->string
(list (gnc-price-get-currency price) (gnc-price-get-value price)))
(list (gnc-price-get-currency price) (gnc-price-get-value price)))
#f))
;; If we have a price that can't be converted to the report currency
;; don't use it
(if (and price (gnc-numeric-zero-p (gnc:gnc-monetary-amount
(exchange-fn
(gnc:make-gnc-monetary
(if (and price (gnc-numeric-zero-p (gnc:gnc-monetary-amount
(exchange-fn
(gnc:make-gnc-monetary
(gnc-price-get-currency price)
(gnc:make-gnc-numeric 100 1))
currency))))
(set! price #f))
;; If we are told to use a pricing transaction, or if we don't have a price
;; from the price DB, find a good transaction to use.
(if (and (not use-txn)
(or (not price) (not prefer-pricelist)))
(let ((split-list (reverse (gnc:get-match-commodity-splits-sorted
(list current)
(case price-source
(let ((split-list (reverse (gnc:get-match-commodity-splits-sorted
(list current)
(case price-source
((pricedb-latest) (gnc:get-today))
((pricedb-nearest) to-date)
(else (gnc:get-today))) ;; error, but don't crash
@ -494,7 +496,7 @@
(let* ((trans (xaccSplitGetParent split))
(trans-currency (xaccTransGetCurrency trans))
(trans-price (exchange-fn (gnc:make-gnc-monetary
trans-currency
trans-currency
(xaccSplitGetSharePrice split))
currency)))
(if (not (gnc-numeric-zero-p (gnc:gnc-monetary-amount trans-price)))
@ -517,13 +519,13 @@
(set! use-txn #t)
(set! pricing-txn #f)
)
)
)
;; Now that we have a pricing transaction if needed, set the value of the asset
(set! value (my-exchange-fn (gnc:make-gnc-monetary commodity units) currency))
(gnc:debug "Value " (gnc:monetary->string value)
(gnc:debug "Value " (gnc:monetary->string value)
" from " (gnc-commodity-numeric->string commodity units))
(for-each
;; we're looking at each split we find in the account. these splits
;; could refer to the same transaction, so we have to examine each
@ -531,12 +533,12 @@
(lambda (split)
(set! work-done (+ 1 work-done))
(gnc:report-percent-done (* 100 (/ work-done work-to-do)))
(let* ((parent (xaccSplitGetParent split))
(txn-date (gnc-transaction-get-date-posted parent))
(commod-currency (xaccTransGetCurrency parent))
(commod-currency-frac (gnc-commodity-get-fraction commod-currency)))
(if (and (gnc:timepair-le txn-date to-date)
(not (assoc-ref seen_trans (gncTransGetGUID parent))))
(let ((trans-income (gnc-numeric-zero))
@ -553,30 +555,30 @@
;; Add this transaction to the list of processed transactions so we don't
;; do it again if there is another split in it for this account
(set! seen_trans (acons (gncTransGetGUID parent) #t seen_trans))
;; Go through all the splits in the transaction to get an overall idea of
;; Go through all the splits in the transaction to get an overall idea of
;; what it does in terms of income, money in or out, shares bought or sold, etc.
(for-each
(lambda (s)
(let ((split-units (xaccSplitGetAmount s))
(split-value (xaccSplitGetValue s)))
(gnc:debug "Pass 1: split units " (gnc-numeric-to-string split-units) " split-value "
(gnc-numeric-to-string split-value) " commod-currency "
(gnc:debug "Pass 1: split units " (gnc-numeric-to-string split-units) " split-value "
(gnc-numeric-to-string split-value) " commod-currency "
(gnc-commodity-get-printname commod-currency))
(cond
(cond
((split-account-type? s ACCT-TYPE-EXPENSE)
;; Brokerage expense unless a two split transaction with other split
;; in the stock account in which case it's a stock donation to charity.
(if (not (same-account? current (xaccSplitGetAccount (xaccSplitGetOtherSplit s))))
(set! trans-brokerage
(if (not (same-account? current (xaccSplitGetAccount (xaccSplitGetOtherSplit s))))
(set! trans-brokerage
(gnc-numeric-add trans-brokerage split-value commod-currency-frac GNC-RND-ROUND))))
((split-account-type? s ACCT-TYPE-INCOME)
(set! trans-income (gnc-numeric-sub trans-income split-value
commod-currency-frac GNC-RND-ROUND)))
((same-account? current (xaccSplitGetAccount s))
(set! trans-shares (gnc-numeric-add trans-shares (gnc-numeric-abs split-units)
units-denom GNC-RND-ROUND))
@ -590,7 +592,7 @@
;; Gain/loss split (amount zero, value non-zero, and not spinoff). There will be
;; a corresponding income split that will incorrectly be added to trans-income
;; Fix that by subtracting it here
(set! trans-income (gnc-numeric-sub trans-income split-value
(set! trans-income (gnc-numeric-sub trans-income split-value
commod-currency-frac GNC-RND-ROUND))))
;; Non-zero amount, add the value to the sale or purchase total.
(if (gnc-numeric-positive-p split-value)
@ -601,9 +603,9 @@
(gnc-numeric-add shares-bought split-units units-denom GNC-RND-ROUND)))
(set! trans-sold
(gnc-numeric-sub trans-sold split-value commod-currency-frac GNC-RND-ROUND)))))
((split-account-type? s ACCT-TYPE-ASSET)
;; If all the asset accounts mentioned in the transaction are siblings of each other
;; If all the asset accounts mentioned in the transaction are siblings of each other
;; keep track of the money transfered to them if it is in the correct currency
(if (not trans-drp-account)
(begin
@ -619,7 +621,7 @@
))
(xaccTransGetSplitList parent)
)
(gnc:debug "Income: " (gnc-numeric-to-string trans-income)
" Brokerage: " (gnc-numeric-to-string trans-brokerage)
" Shares traded: " (gnc-numeric-to-string trans-shares)
@ -628,10 +630,10 @@
" Value purchased: " (gnc-numeric-to-string trans-bought)
" Spinoff value " (gnc-numeric-to-string trans-spinoff)
" Trans DRP residual: " (gnc-numeric-to-string trans-drp-residual))
;; We need to calculate several things for this transaction:
;; 1. Total income: this is already in trans-income
;; 2. Change in basis: calculated by loop below that looks at every
;; 2. Change in basis: calculated by loop below that looks at every
;; that acquires or disposes of shares
;; 3. Realized gain: also calculated below while calculating basis
;; 4. Money in to the account: this is the value of shares bought
@ -639,22 +641,22 @@
;; 5. Money out: the money received by disposing of shares. This
;; is in trans-sold plus trans-spinoff
;; 6. Brokerage fees: this is in trans-brokerage
;; Income
(dividendcoll 'add commod-currency trans-income)
;; Brokerage fees. May be either ignored or part of basis, but that
;; will be dealt with elsewhere.
(brokeragecoll 'add commod-currency trans-brokerage)
;; Add brokerage fees to trans-bought if not ignoring them and there are any
(if (and (not (eq? handle-brokerage-fees 'ignore-brokerage))
(gnc-numeric-positive-p trans-brokerage)
(gnc-numeric-positive-p trans-shares))
(let* ((fee-frac (gnc-numeric-div shares-bought trans-shares GNC-DENOM-AUTO GNC-DENOM-REDUCE))
(fees (gnc-numeric-mul trans-brokerage fee-frac commod-currency-frac GNC-RND-ROUND)))
(set! trans-bought (gnc-numeric-add trans-bought fees commod-currency-frac GNC-RND-ROUND))))
(set! trans-bought (gnc-numeric-add trans-bought fees commod-currency-frac GNC-RND-ROUND))))
;; Update the running total of the money in the DRP residual account. This is relevant
;; if this is a reinvestment transaction (both income and purchase) and there seems to
;; asset accounts used to hold excess income.
@ -670,12 +672,12 @@
(parent-or-sibling? trans-drp-account drp-holding-account))
(set! drp-holding-amount (gnc-numeric-add drp-holding-amount trans-drp-residual
commod-currency-frac GNC-RND-ROUND))
(begin
;; Wrong account (or no account), assume there isn't a DRP holding account
(begin
;; Wrong account (or no account), assume there isn't a DRP holding account
(set! drp-holding-account 'none)
(set trans-drp-residual (gnc-numeric-zero))
(set! drp-holding-amount (gnc-numeric-zero))))))
;; Set trans-bought to the amount of money moved in to the account which was used to
;; purchase more shares. If this is not a DRP transaction then all money used to purchase
;; shares is money in.
@ -691,21 +693,21 @@
;; If the DRP holding account balance is negative, adjust it by the amount
;; used in this transaction
(if (and (gnc-numeric-negative-p drp-holding-amount)
(gnc-numeric-positive-p trans-bought))
(gnc-numeric-positive-p trans-bought))
(set! drp-holding-amount (gnc-numeric-add drp-holding-amount trans-bought
commod-currency-frac GNC-RND-ROUND)))
;; Money in is never more than amount spent to purchase shares
(if (gnc-numeric-negative-p trans-bought)
(set! trans-bought (gnc-numeric-zero)))))
(gnc:debug "Adjusted trans-bought " (gnc-numeric-to-string trans-bought)
" DRP holding account " (gnc-numeric-to-string drp-holding-amount))
(moneyincoll 'add commod-currency trans-bought)
(moneyoutcoll 'add commod-currency trans-sold)
(moneyoutcoll 'add commod-currency trans-spinoff)
;; Look at splits again to handle changes in basis and realized gains
;; Look at splits again to handle changes in basis and realized gains
(for-each
(lambda (s)
(let
@ -713,30 +715,30 @@
((split-units (xaccSplitGetAmount s))
(split-value (xaccSplitGetValue s)))
(gnc:debug "Pass 2: split units " (gnc-numeric-to-string split-units) " split-value "
(gnc-numeric-to-string split-value) " commod-currency "
(gnc:debug "Pass 2: split units " (gnc-numeric-to-string split-units) " split-value "
(gnc-numeric-to-string split-value) " commod-currency "
(gnc-commodity-get-printname commod-currency))
(cond
(cond
((and (not (gnc-numeric-zero-p split-units))
(same-account? current (xaccSplitGetAccount s)))
;; Split into subject account with non-zero amount. This is a purchase
;; or a sale, adjust the basis
(let* ((split-value-currency (gnc:gnc-monetary-amount
(my-exchange-fn (gnc:make-gnc-monetary
(let* ((split-value-currency (gnc:gnc-monetary-amount
(my-exchange-fn (gnc:make-gnc-monetary
commod-currency split-value) currency)))
(orig-basis (sum-basis basis-list currency-frac))
;; proportion of the fees attributable to this split
(fee-ratio (gnc-numeric-div (gnc-numeric-abs split-units) trans-shares
GNC-DENOM-AUTO GNC-DENOM-REDUCE))
;; Fees for this split in report currency
(fees-currency (gnc:gnc-monetary-amount (my-exchange-fn
;; Fees for this split in report currency
(fees-currency (gnc:gnc-monetary-amount (my-exchange-fn
(gnc:make-gnc-monetary commod-currency
(gnc-numeric-mul fee-ratio trans-brokerage
commod-currency-frac GNC-RND-ROUND))
currency)))
(split-value-with-fees (if (eq? handle-brokerage-fees 'include-in-basis)
;; Include brokerage fees in basis
(split-value-with-fees (if (eq? handle-brokerage-fees 'include-in-basis)
;; Include brokerage fees in basis
(gnc-numeric-add split-value-currency fees-currency
currency-frac GNC-RND-ROUND)
split-value-currency)))
@ -744,10 +746,10 @@
(gnc-numeric-to-string split-value-with-fees))
;; adjust the basis
(set! basis-list (basis-builder basis-list split-units split-value-with-fees
(set! basis-list (basis-builder basis-list split-units split-value-with-fees
basis-method currency-frac))
(gnc:debug "coming out of basis list " basis-list)
;; If it's a sale or the stock is worthless, calculate the gain
(if (not (gnc-numeric-positive-p split-value))
;; Split value is zero or negative. If it's zero it's either a stock split/merge
@ -756,7 +758,7 @@
(let ((new-basis (sum-basis basis-list currency-frac)))
(if (or (gnc-numeric-zero-p new-basis)
(gnc-numeric-negative-p split-value))
;; Split value is negative or new basis is zero (stock is worthless),
;; Split value is negative or new basis is zero (stock is worthless),
;; Capital gain is money out minus change in basis
(let ((gain (gnc-numeric-sub (gnc-numeric-abs split-value-with-fees)
(gnc-numeric-sub orig-basis new-basis
@ -773,30 +775,30 @@
;; in an income or expense account.
((spin-off? s current)
(gnc:debug "before spin-off basis list " basis-list)
(set! basis-list (basis-builder basis-list split-units (gnc:gnc-monetary-amount
(my-exchange-fn (gnc:make-gnc-monetary
commod-currency split-value)
currency))
(set! basis-list (basis-builder basis-list split-units (gnc:gnc-monetary-amount
(my-exchange-fn (gnc:make-gnc-monetary
commod-currency split-value)
currency))
basis-method
currency-frac))
(gnc:debug "after spin-off basis list " basis-list))
)
))
(xaccTransGetSplitList parent)
)
)
)
)
)
)
(xaccAccountGetSplitList current)
)
;; Look for income and expense transactions that don't have a split in the
;; the account we're processing. We do this as follow
;; 1. Make sure the parent account is a currency-valued asset or bank account
;; 2. If so go through all the splits in that account
;; 3. If a split is part of a two split transaction where the other split is
;; to an income or expense account and the leaf name of that account is the
;; to an income or expense account and the leaf name of that account is the
;; same as the leaf name of the account we're processing, add it to the
;; income or expense accumulator
;;
@ -809,20 +811,20 @@
;; Dividends (type INCOME)
;; Widget Stock (type INCOME)
;;
;; If you are producing a report on "Assets:Broker:Widget Stock" a
;; transaction that debits the Assets:Broker account and credits the
;; "Income:Dividends:Widget Stock" account will count as income in
;; the report even though it doesn't have a split in the account
;; If you are producing a report on "Assets:Broker:Widget Stock" a
;; transaction that debits the Assets:Broker account and credits the
;; "Income:Dividends:Widget Stock" account will count as income in
;; the report even though it doesn't have a split in the account
;; being reported on.
(let ((parent-account (gnc-account-get-parent current))
(account-name (xaccAccountGetName current)))
(if (and (not (null? parent-account))
(member (xaccAccountGetType parent-account) (list ACCT-TYPE-ASSET ACCT-TYPE-BANK))
(member (xaccAccountGetType parent-account) (list ACCT-TYPE-ASSET ACCT-TYPE-BANK))
(gnc-commodity-is-currency (xaccAccountGetCommodity parent-account)))
(for-each
(lambda (split)
(let* ((other-split (xaccSplitGetOtherSplit split))
(let* ((other-split (xaccSplitGetOtherSplit split))
;; This is safe because xaccSplitGetAccount returns null for a null split
(other-acct (xaccSplitGetAccount other-split))
(parent (xaccSplitGetParent split))
@ -831,7 +833,7 @@
(gnc:timepair-le txn-date to-date)
(string=? (xaccAccountGetName other-acct) account-name)
(gnc-commodity-is-currency (xaccAccountGetCommodity other-acct)))
;; This is a two split transaction where the other split is to an
;; This is a two split transaction where the other split is to an
;; account with the same name as the current account. If it's an
;; income or expense account accumulate the value of the transaction
(let ((val (xaccSplitGetValue split))
@ -840,13 +842,13 @@
(gnc:debug "More income " (gnc-numeric-to-string val))
(dividendcoll 'add curr val))
((split-account-type? other-split ACCT-TYPE-EXPENSE)
(gnc:debug "More expense " (gnc-numeric-to-string
(gnc:debug "More expense " (gnc-numeric-to-string
(gnc-numeric-neg val)))
(brokeragecoll 'add curr (gnc-numeric-neg val)))
)
)
)
)
)
)
)
)
(xaccAccountGetSplitList parent-account)
)
@ -858,7 +860,7 @@
(gnc:debug "prefer-pricelist is " prefer-pricelist)
(gnc:debug "price is " price)
(gnc:debug "basis we're using to build rows is " (gnc-numeric-to-string (sum-basis basis-list
(gnc:debug "basis we're using to build rows is " (gnc-numeric-to-string (sum-basis basis-list
currency-frac)))
(gnc:debug "but the actual basis list is " basis-list)
@ -872,9 +874,9 @@
(income (gnc:sum-collector-commodity dividendcoll currency my-exchange-fn))
;; just so you know, gain == realized gain, ugain == un-realized gain, bothgain, well..
(gain (gnc:sum-collector-commodity gaincoll currency my-exchange-fn))
(ugain (gnc:make-gnc-monetary currency
(ugain (gnc:make-gnc-monetary currency
(gnc-numeric-sub (gnc:gnc-monetary-amount (my-exchange-fn value currency))
(sum-basis basis-list (gnc-commodity-get-fraction currency))
(sum-basis basis-list (gnc-commodity-get-fraction currency))
currency-frac GNC-RND-ROUND)))
(bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount gain)
(gnc:gnc-monetary-amount ugain)
@ -916,7 +918,7 @@
price
)
price
)
)
(gnc:html-price-anchor
price
(gnc:make-gnc-monetary
@ -924,7 +926,7 @@
(gnc-price-get-value price)))
)))))
(append! activecols (list (if use-txn (if pricing-txn "*" "**") " ")
(gnc:make-html-table-header-cell/markup
(gnc:make-html-table-header-cell/markup
"number-cell" (gnc:make-gnc-monetary currency (sum-basis basis-list
currency-frac)))
(gnc:make-html-table-header-cell/markup "number-cell" value)
@ -947,7 +949,7 @@
(if (not (eq? handle-brokerage-fees 'ignore-brokerage))
(append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" brokerage))))
(append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" totalreturn)
(gnc:make-html-table-header-cell/markup "number-cell"
(gnc:make-html-table-header-cell/markup "number-cell"
(let* ((moneyinvalue (gnc-numeric-to-double
(gnc:gnc-monetary-amount moneyin)))
(totalreturnvalue (gnc-numeric-to-double
@ -958,12 +960,12 @@
(sprintf #f "%.2f%%" (* 100 (/ totalreturnvalue moneyinvalue))))))
)
)
(gnc:html-table-append-row/markup!
table
row-style
activecols)
(if (and (not use-txn) price) (gnc-price-unref price))
(table-add-stock-rows-internal rest (not odd-row?))
)
@ -976,7 +978,7 @@
(set! work-to-do (gnc:accounts-count-splits accounts))
(table-add-stock-rows-internal accounts #t)))
;; Tell the user that we're starting.
(gnc:report-starting reportname)
@ -989,7 +991,7 @@
(currency (get-option gnc:pagename-general "Report's currency"))
(price-source (get-option gnc:pagename-general
optname-price-source))
(report-title (get-option gnc:pagename-general
(report-title (get-option gnc:pagename-general
gnc:optname-reportname))
(include-empty (get-option gnc:pagename-accounts
optname-zero-shares))
@ -1021,7 +1023,7 @@
(document (gnc:make-html-document)))
(gnc:html-document-set-title!
document (string-append
document (string-append
report-title
(sprintf #f " %s" (gnc-print-date to-date))))
@ -1031,12 +1033,12 @@
(pricedb (gnc-pricedb-get-db (gnc-get-current-book)))
(price-fn
(case price-source
((pricedb-latest)
(lambda (foreign domestic date)
((pricedb-latest)
(lambda (foreign domestic date)
(find-price (gnc-pricedb-lookup-latest-any-currency pricedb foreign)
domestic)))
((pricedb-nearest)
(lambda (foreign domestic date)
((pricedb-nearest)
(lambda (foreign domestic date)
(find-price (gnc-pricedb-lookup-nearest-in-time-any-currency
pricedb foreign (timespecCanonicalDayTime date)) domestic)))))
(headercols (list (_ "Account")))
@ -1047,22 +1049,22 @@
(sum-total-gain (gnc-numeric-zero))
(sum-total-ugain (gnc-numeric-zero))
(sum-total-brokerage (gnc-numeric-zero))
(sum-total-totalreturn (gnc-numeric-zero)))
(sum-total-totalreturn (gnc-numeric-zero))) ;;end of let
;;begin building lists for which columns to display
(if show-symbol
(if show-symbol
(begin (append! headercols (list (_ "Symbol")))
(append! totalscols (list " "))))
(if show-listing
(if show-listing
(begin (append! headercols (list (_ "Listing")))
(append! totalscols (list " "))))
(if show-shares
(if show-shares
(begin (append! headercols (list (_ "Shares")))
(append! totalscols (list " "))))
(if show-price
(if show-price
(begin (append! headercols (list (_ "Price")))
(append! totalscols (list " "))))
@ -1088,14 +1090,14 @@
(gnc:html-table-set-col-headers!
table
headercols)
(table-add-stock-rows
table accounts to-date currency price-fn exchange-fn price-source
include-empty show-symbol show-listing show-shares show-price basis-method
prefer-pricelist handle-brokerage-fees
total-basis total-value total-moneyin total-moneyout
total-income total-gain total-ugain total-brokerage)
(set! sum-total-moneyin (gnc:sum-collector-commodity total-moneyin currency exchange-fn))
(set! sum-total-income (gnc:sum-collector-commodity total-income currency exchange-fn))
@ -1152,17 +1154,17 @@
(gnc:make-html-table-cell/markup
"total-number-cell" sum-total-totalreturn)
(gnc:make-html-table-cell/markup
"total-number-cell"
"total-number-cell"
(let* ((totalinvalue (gnc-numeric-to-double
(gnc:gnc-monetary-amount sum-total-moneyin)))
(totalreturnvalue (gnc-numeric-to-double
(gnc:gnc-monetary-amount sum-total-totalreturn)))
)
(if (= 0.0 totalinvalue)
(if (= 0.0 totalinvalue)
""
(sprintf #f "%.2f%%" (* 100 (/ totalreturnvalue totalinvalue))))))
))
(gnc:html-table-append-row/markup!
table
@ -1171,24 +1173,24 @@
)
(gnc:html-document-add-object! document table)
(if warn-price-dirty
(gnc:html-document-append-objects! document
(if warn-price-dirty
(gnc:html-document-append-objects! document
(list (gnc:make-html-text (_ "* this commodity data was built using transaction pricing instead of the price list."))
(gnc:make-html-text (gnc:html-markup-br))
(gnc:make-html-text (_ "If you are in a multi-currency situation, the exchanges may not be correct.")))))
(if warn-no-price
(gnc:html-document-append-objects! document
(list (gnc:make-html-text (if warn-price-dirty (gnc:html-markup-br) ""))
(if warn-no-price
(gnc:html-document-append-objects! document
(list (gnc:make-html-text (if warn-price-dirty (gnc:html-markup-br) ""))
(gnc:make-html-text (_ "** this commodity has no price and a price of 1 has been used.")))))
)
;if no accounts selected.
(gnc:html-document-add-object!
document
(gnc:html-make-no-account-warning
(gnc:html-make-no-account-warning
report-title (gnc:report-id report-obj))))
(gnc:report-finished)
document)))

112
src/report/standard-reports/portfolio.scm
View File

@ -2,16 +2,16 @@
;; portfolio.scm
;; by Robert Merkel (rgmerk@mira.net)
;;
;; 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.
;;
;; 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:
;;
@ -39,23 +39,23 @@
(define optname-zero-shares (N_ "Include accounts with no shares"))
(define (options-generator)
(let* ((options (gnc:new-options))
(let* ((options (gnc:new-options))
;; This is just a helper function for making options.
;; See gnucash/src/scm/options.scm for details.
(add-option
(add-option
(lambda (new-option)
(gnc:register-option options new-option))))
;; General Tab
;; date at which to report balance
(gnc:options-add-report-date!
options gnc:pagename-general
options gnc:pagename-general
(N_ "Date") "a")
(gnc:options-add-currency!
(gnc:options-add-currency!
options gnc:pagename-general (N_ "Report's currency") "c")
(gnc:options-add-price-source!
(gnc:options-add-price-source!
options gnc:pagename-general
optname-price-source "d" 'pricedb-latest)
@ -74,18 +74,18 @@
(lambda () (filter gnc:account-is-stock?
(gnc-account-get-descendants-sorted
(gnc-get-current-root-account))))
(lambda (accounts) (list #t
(lambda (accounts) (list #t
(filter gnc:account-is-stock? accounts)))
#t))
(gnc:register-option
options
(gnc:register-option
options
(gnc:make-simple-boolean-option
gnc:pagename-accounts optname-zero-shares "e"
gnc:pagename-accounts optname-zero-shares "e"
(N_ "Include accounts that have a zero share balances.")
#f))
(gnc:options-set-default-section options gnc:pagename-general)
(gnc:options-set-default-section options gnc:pagename-general)
options))
;; This is the rendering function. It accepts a database of options
@ -98,14 +98,14 @@
(let ((work-done 0)
(work-to-do 0))
;; 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))
(define (get-option section name)
(gnc:option-value (get-op section name)))
(define (table-add-stock-rows table accounts to-date currency
exchange-fn price-fn include-empty collector)
@ -149,7 +149,7 @@
(gnc:make-html-table-header-cell/markup "text-cell" ticker-symbol)
(gnc:make-html-table-header-cell/markup "text-cell" listing)
(gnc:make-html-table-header-cell/markup
"number-cell"
"number-cell"
(xaccPrintAmount units share-print-info))
(gnc:make-html-table-header-cell/markup
"number-cell"
@ -176,7 +176,7 @@
(get-option gnc:pagename-general "Date")))
(accounts (get-option gnc:pagename-accounts "Accounts"))
(currency (get-option gnc:pagename-general "Report's currency"))
(report-title (get-option gnc:pagename-general
(report-title (get-option gnc:pagename-general
gnc:optname-reportname))
(price-source (get-option gnc:pagename-general
optname-price-source))
@ -189,55 +189,67 @@
(document (gnc:make-html-document)))
(gnc:html-document-set-title!
document (string-append
document (string-append
report-title
(sprintf #f " %s" (gnc-print-date to-date))))
;(gnc:debug "accounts" accounts)
(if (not (null? accounts))
(let* ((commodity-list (gnc:accounts-get-commodities
(append
(gnc:acccounts-get-all-subaccounts
(let* ((commodity-list (gnc:accounts-get-commodities
(append
(gnc:acccounts-get-all-subaccounts
accounts) accounts) currency))
(pricedb (gnc-pricedb-get-db (gnc-get-current-book)))
(exchange-fn (gnc:case-exchange-fn price-source currency to-date))
(price-fn
(case price-source
((weighted-average average-cost)
((weighted-average average-cost)
(lambda (foreign date)
(cons #f (gnc-numeric-div
(gnc:gnc-monetary-amount
(exchange-fn (gnc:make-gnc-monetary foreign
(gnc:gnc-monetary-amount
(exchange-fn (gnc:make-gnc-monetary foreign
(gnc-numeric-create 10000 1))
currency))
(gnc-numeric-create 10000 1)
(gnc-numeric-create 10000 1)
GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 5) GNC-RND-ROUND)))))
((pricedb-latest)
(lambda (foreign date)
((pricedb-latest)
(lambda (foreign date)
(let* ((price
(gnc-pricedb-lookup-latest-any-currency
pricedb foreign))
(fn (if (and price (> (length price) 0))
(let ((v (gnc-price-get-value (car price))))
(let* ((the_price
(if (gnc-commodity-equiv
foreign
(gnc-price-get-commodity (car price)))
(car price)
(gnc-price-invert (car price))))
(v (gnc-price-get-value the_price)))
(gnc-price-ref (car price))
(cons (car price) v))
(cons #f (gnc-numeric-zero)))))
(if price (gnc-price-list-destroy price))
fn)))
((pricedb-nearest)
(lambda (foreign date)
((pricedb-nearest)
(lambda (foreign date)
(let* ((price
(gnc-pricedb-lookup-nearest-in-time-any-currency
pricedb foreign (timespecCanonicalDayTime date)))
(fn (if (and price (> (length price) 0))
(let ((v (gnc-price-get-value (car price))))
(let* ((the_price
(if (gnc-commodity-equiv
foreign
(gnc-price-get-commodity (car price)))
(car price)
(gnc-price-invert (car price))))
(v (gnc-price-get-value (car price))))
(gnc-price-ref (car price))
(cons (car price) v))
(cons #f (gnc-numeric-zero)))))
(if price (gnc-price-list-destroy price))
fn))))))
(gnc:html-table-set-col-headers!
table
(list (_ "Account")
@ -246,22 +258,22 @@
(_ "Units")
(_ "Price")
(_ "Value")))
(table-add-stock-rows
table accounts to-date currency
table accounts to-date currency
exchange-fn price-fn include-empty collector)
(gnc:html-table-append-row/markup!
table
"grand-total"
(list
(gnc:make-html-table-cell/size
1 6 (gnc:make-html-text (gnc:html-markup-hr)))))
(collector
'format
'format
(lambda (currency amount)
(gnc:html-table-append-row/markup!
(gnc:html-table-append-row/markup!
table
"grand-total"
(list (gnc:make-html-table-cell/markup
@ -270,15 +282,15 @@
1 5 "total-number-cell"
(gnc:make-gnc-monetary currency amount)))))
#f)
(gnc:html-document-add-object! document table))
;if no accounts selected.
(gnc:html-document-add-object!
document
(gnc:html-make-no-account-warning
(gnc:html-make-no-account-warning
report-title (gnc:report-id report-obj))))
(gnc:report-finished)
document)))

59
src/scm/price-quotes.scm
View File

@ -419,38 +419,37 @@
(set! saved-price (gnc-pricedb-lookup-day pricedb
commodity currency
gnc-time))
(if (null? saved-price) ;;See if there's a reversed price.
(begin
(set! saved-price (gnc-pricedb-lookup-day pricedb currency
commodity gnc-time))
(if (not (null? saved-price))
(set! price (gnc-numeric-invert price)))))
(if (not (null? saved-price))
(if (> (gnc-price-get-source saved-price) PRICE-SOURCE-FQ)
(begin
(gnc-price-begin-edit saved-price)
(gnc-price-set-time saved-price gnc-time)
(gnc-price-set-source saved-price PRICE-SOURCE-FQ)
(gnc-price-set-typestr saved-price price-type)
(gnc-price-set-value saved-price price)
(gnc-price-commit-edit saved-price)
(begin
(if (gnc-commodity-equiv (gnc-price-get-currency saved-price)
commodity)
(set! price (gnc-numeric-invert price)))
(if (> (gnc-price-get-source saved-price) PRICE-SOURCE-FQ)
(begin
(gnc-price-begin-edit saved-price)
(gnc-price-set-time saved-price gnc-time)
(gnc-price-set-source saved-price PRICE-SOURCE-FQ)
(gnc-price-set-typestr saved-price price-type)
(gnc-price-set-value saved-price price)
(gnc-price-commit-edit saved-price)
#f)
#f)
#f)
(let ((gnc-price (gnc-price-create book)))
(if (not gnc-price)
(string-append
currency-str ":" (gnc-commodity-get-mnemonic commodity))
(begin
(gnc-price-begin-edit gnc-price)
(gnc-price-set-commodity gnc-price commodity)
(gnc-price-set-currency gnc-price currency)
(gnc-price-set-time gnc-price gnc-time)
(gnc-price-set-source gnc-price PRICE-SOURCE-FQ)
(gnc-price-set-typestr gnc-price price-type)
(gnc-price-set-value gnc-price price)
(gnc-price-commit-edit gnc-price)
gnc-price)))))
)))
(let ((gnc-price (gnc-price-create book)))
(if (not gnc-price)
(string-append
currency-str ":" (gnc-commodity-get-mnemonic commodity))
(begin
(gnc-price-begin-edit gnc-price)
(gnc-price-set-commodity gnc-price commodity)
(gnc-price-set-currency gnc-price currency)
(gnc-price-set-time gnc-price gnc-time)
(gnc-price-set-source gnc-price PRICE-SOURCE-FQ)
(gnc-price-set-typestr gnc-price price-type)
(gnc-price-set-value gnc-price price)
(gnc-price-commit-edit gnc-price)
gnc-price)))))
))
))
(define (book-add-prices! book prices)
(let ((pricedb (gnc-pricedb-get-db book)))