Merge branch 'maint-797743' price renderers

This commit is contained in:
Christopher Lam 2020-05-13 13:20:09 +08:00
commit f8bad131a5
13 changed files with 74 additions and 67 deletions

View File

@ -189,10 +189,18 @@
(define (gnc:default-html-gnc-numeric-renderer datum params)
(xaccPrintAmount datum (gnc-default-print-info #f)))
;; renders a price to target currency
(define (gnc:default-price-renderer currency amount)
(xaccPrintAmount amount (gnc-price-print-info currency #t)))
(define (gnc:default-html-gnc-monetary-renderer datum params)
(xaccPrintAmount
(gnc:gnc-monetary-amount datum)
(gnc-commodity-print-info (gnc:gnc-monetary-commodity datum) #t)))
(let* ((comm (gnc:gnc-monetary-commodity datum))
(scu (gnc-commodity-get-fraction comm))
(amount (gnc:gnc-monetary-amount datum))
(amt-display (if (exact? amount)
(gnc-numeric-convert amount scu GNC-HOW-RND-ROUND)
amount)))
(xaccPrintAmount amt-display (gnc-commodity-print-info comm #t))))
(define (gnc:default-html-number-renderer datum params)
(xaccPrintAmount

View File

@ -196,9 +196,12 @@
(for-each
(lambda (commodity)
(let* ((orig-amt (gnc:make-gnc-monetary commodity 1))
(exchanged (exchange-fn orig-amt common-commodity)))
(exchanged (exchange-fn orig-amt common-commodity))
(conv-amount (gnc:gnc-monetary-amount exchanged)))
(gnc:html-table-append-row!
table (map markup (list orig-amt exchanged)))))
table (list (markup orig-amt)
(markup (gnc:default-price-renderer common-commodity
conv-amount))))))
comm-list)
(gnc:html-table-set-col-headers!
table (list (gnc:make-html-table-header-cell/size

View File

@ -719,6 +719,7 @@
(export gnc:select-assoc-account-balance)
(export gnc:get-assoc-account-balances-total)
(export gnc:multiline-to-html-text)
(export gnc:default-price-renderer)
(export make-file-url)
(export gnc:strify)
(export gnc:pk)

View File

@ -925,18 +925,12 @@ by preventing negative stock balances.<br/>")
"number-cell"
(if use-txn
(if pricing-txn
(gnc:html-transaction-anchor
pricing-txn
price
)
price
)
(gnc:html-transaction-anchor pricing-txn price)
price)
(gnc:html-price-anchor
price
(gnc:make-gnc-monetary
(gnc-price-get-currency price)
(gnc-price-get-value price)))
)))))
price (gnc:default-price-renderer
(gnc-price-get-currency price)
(gnc-price-get-value price))))))))
(append! activecols (list (if use-txn (if pricing-txn "*" "**") " ")
(gnc:make-html-table-header-cell/markup
"number-cell" (gnc:make-gnc-monetary currency (sum-basis basis-list

View File

@ -833,12 +833,14 @@ also show overall period profit & loss."))
(lambda (commodity)
(let ((orig-monetary (gnc:make-gnc-monetary commodity 1)))
(if (has-price? commodity)
(let ((conv-monetary (convert-curr-fn orig-monetary col-idx)))
(let* ((conv-monetary (convert-curr-fn orig-monetary col-idx))
(conv-amount (gnc:gnc-monetary-amount conv-monetary)))
(gnc:html-text-append!
cell
(format #f "~a ~a"
(gnc:monetary->string orig-monetary)
(gnc:monetary->string conv-monetary))))
(gnc:default-price-renderer common-currency
conv-amount))))
(gnc:html-text-append!
cell
(string-append

View File

@ -245,8 +245,10 @@
(gnc:make-html-table-cell/markup
"text-cell"
(if split-info?
(gnc:make-gnc-monetary
currency (xaccSplitGetSharePrice split))
(gnc:default-price-renderer
(gnc-account-get-currency-or-parent
(xaccSplitGetAccount split))
(xaccSplitGetSharePrice split))
" "))))
(if (amount-single-col column-vector)
(addto! row-contents

View File

@ -329,7 +329,7 @@
'("#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00")
(sxml->table-row-col sxml 1 3 6))
(test-equal "show-rates enabled"
'("#1.00" "$1.70" "1 FUNDS" "$500.00")
'("#1.00" "$1.7000" "1 FUNDS" "$500.0000")
(sxml->table-row-col sxml 2 #f #f)))
;;make-multilevel
@ -465,7 +465,7 @@
(list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00")
(sxml->table-row-col sxml 1 3 6))
(test-equal "show-rates enabled"
(list "#1.00" "$1.70")
(list "#1.00" "$1.7000")
(sxml->table-row-col sxml 2 #f #f)))
;;make-multilevel
@ -520,21 +520,21 @@
"$6,870.00" "$0.00" "$100.00" "$4,000.00" "$2,000.00" "$2,000.00"
"10 FUNDS " "$130.00" "$130.00" "#100.00 " "$100,000.00" "$113,100.00"
"$9,500.00" "$9,500.00" "$500.00" "$9,000.00" "$9,500.00" "$103,600.00"
"$0.00" "$0.00" "$103,600.00" "#1.00 $1.30" "1 FUNDS $200.00")
"$0.00" "$0.00" "$103,600.00" "#1.00 $1.3000" "1 FUNDS $200.0000")
(sxml->table-row-col sxml 1 #f 2))
(test-equal "bal-1/1/71"
'("01/01/71" "$116,009.00" "$116,009.00" "$4,709.00" "$2,000.00"
"$2,609.00" "$0.00" "$100.00" "$11,000.00" "$2,000.00" "$9,000.00"
"30 FUNDS " "$300.00" "$300.00" "#200.00 " "$100,000.00" "$116,009.00"
"$9,500.00" "$9,500.00" "$500.00" "$9,000.00" "$9,500.00" "$103,600.00"
"$2,909.00" "$0.00" "$106,509.00" "#1.00 $1.50" "1 FUNDS $300.00")
"$2,909.00" "$0.00" "$106,509.00" "#1.00 $1.5000" "1 FUNDS $300.0000")
(sxml->table-row-col sxml 1 #f 3))
(test-equal "bal-1/1/72"
'("01/01/72" "$117,529.00" "$117,529.00" "$4,709.00" "$2,000.00"
"$2,609.00" "$0.00" "$100.00" "$12,500.00" "$2,000.00" "$10,500.00"
"30 FUNDS " "$320.00" "$320.00" "#200.00 " "$100,000.00" "$117,529.00"
"$9,500.00" "$9,500.00" "$500.00" "$9,000.00" "$9,500.00" "$103,600.00"
"$4,429.00" "$0.00" "$108,029.00" "#1.00 $1.60" "1 FUNDS $350.00")
"$4,429.00" "$0.00" "$108,029.00" "#1.00 $1.6000" "1 FUNDS $350.0000")
(sxml->table-row-col sxml 1 #f 4)))
;; the following includes non-zero retained earnings of $1,270
@ -548,7 +548,7 @@
"$100.00" "$17,000.00" "$2,000.00" "$15,000.00" "30 FUNDS " "$1,190.00"
"$1,190.00" "#700.00 " "$100,000.00" "$123,319.00" "$9,500.00" "$9,500.00"
"$500.00" "$9,000.00" "$9,500.00" "$103,600.00" "$8,949.00" "$1,270.00"
"$113,819.00" "#1.00 $1.70" "1 FUNDS $500.00")
"$113,819.00" "#1.00 $1.7000" "1 FUNDS $500.0000")
(sxml->table-row-col sxml 1 #f 2)))))
(define (multicol-pnl-tests)
@ -585,13 +585,13 @@
"multicol-pnl-halfyear")))
(test-equal "pnl-1/80"
'("01/01/80" " to 01/31/80" "$1,100.00" "$250.00" "$850.00" "#500.00 "
"$1,100.00" "#1.00 $1.70")
"$1,100.00" "#1.00 $1.7000")
(sxml->table-row-col sxml 1 #f 2))
(test-equal "pnl-2/80"
'("02/01/80" " to 02/29/80" "$170.00" "$0.00" "$170.00" "#100.00 "
"$170.00" "#1.00 $1.70")
"$170.00" "#1.00 $1.7000")
(sxml->table-row-col sxml 1 #f 3))
(test-equal "pnl-3/80"
'("03/01/80" " to 03/31/80" "$0.00" "$0.00" "$0.00" "#0.00 "
"$0.00" "#1.00 $1.70")
"$0.00" "#1.00 $1.7000")
(sxml->table-row-col sxml 1 #f 4)))))

View File

@ -91,7 +91,7 @@
(set-option! options "General" "Price Source" 'weighted-average)
(let ((sxml (options->sxml portfolio-uuid options "'weighted-average")))
(test-equal "portfolio: weighted-average"
'("AAPL" "AAPL" "NASDAQ" "1.00" "$233.33" "$233 + 1/3")
'("AAPL" "AAPL" "NASDAQ" "1.00" "$233.33" "$233.33")
(sxml->table-row-col sxml 1 1 #f))))
(teardown)))
@ -101,7 +101,7 @@
(options (gnc:make-report-options advanced-uuid)))
(let ((sxml (options->sxml advanced-uuid options "basic average")))
(test-equal "advanced: average basis"
'("AAPL" "AAPL" "NASDAQ" "42.00" "$6.00" "$484.88" "$252.00" "$800.00"
'("AAPL" "AAPL" "NASDAQ" "42.00" "$6.0000" "$484.88" "$252.00" "$800.00"
"$553.00" "$227.88" "-$232.88" "-$5.00" "-0.63%" "$4.00"
"$10.00" "-$1.00" "-0.13%")
(sxml->table-row-col sxml 1 1 #f)))
@ -109,7 +109,7 @@
(set-option! options "General" "Basis calculation method" 'fifo-basis)
(let ((sxml (options->sxml advanced-uuid options "basic fifo")))
(test-equal "advanced: fifo basis"
'("AAPL" "AAPL" "NASDAQ" "42.00" "$6.00" "$543.94" "$252.00" "$800.00"
'("AAPL" "AAPL" "NASDAQ" "42.00" "$6.0000" "$543.94" "$252.00" "$800.00"
"$553.00" "$286.94" "-$291.94" "-$5.00" "-0.63%" "$4.00" "$10.00"
"-$1.00" "-0.13%")
(sxml->table-row-col sxml 1 1 #f)))
@ -117,7 +117,7 @@
(set-option! options "General" "Basis calculation method" 'filo-basis)
(let ((sxml (options->sxml advanced-uuid options "basic filo")))
(test-equal "advanced: filo basis"
'("AAPL" "AAPL" "NASDAQ" "42.00" "$6.00" "$400.00" "$252.00" "$800.00"
'("AAPL" "AAPL" "NASDAQ" "42.00" "$6.0000" "$400.00" "$252.00" "$800.00"
"$553.00" "$143.00" "-$148.00" "-$5.00" "-0.63%" "$4.00" "$10.00"
"-$1.00" "-0.13%")
(sxml->table-row-col sxml 1 1 #f))))

View File

@ -281,25 +281,23 @@
<p><?scm:d (_ "<strong>Exchange Rates</strong> used for this report") ?>
<table border="0">
<?scm
(for xpair in xlist do
(let* ((comm (car xpair))
(one-num 10000/1)
(one-foreign-mny (gnc:make-gnc-monetary comm one-num))
(one-local-mny (exchange-fn one-foreign-mny opt-report-commodity)))
(for-each
(lambda (xpair)
(let* ((comm (car xpair))
(one-foreign-mny (gnc:make-gnc-monetary comm 1))
(one-local-mny (exchange-fn one-foreign-mny opt-report-commodity))
(conv-amount (gnc:gnc-monetary-amount one-local-mny))
(price-str (gnc:default-price-renderer
opt-report-commodity conv-amount)))
?>
<tr>
<td align="right">1 <?scm:d (gnc-commodity-get-mnemonic comm) ?></td>
<td align="right"><?scm:d (gnc:monetary->string one-foreign-mny) ?></td>
<td>=</td>
<td align="left"><?scm:d (fmtnumeric
(gnc-numeric-div
(gnc:gnc-monetary-amount one-local-mny)
(gnc:gnc-monetary-amount one-foreign-mny)
GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))) ?>
<?scm:d (gnc-commodity-get-mnemonic opt-report-commodity) ?></td>
<td align="right"><?scm:d price-str ?></td>
</tr>
<?scm
))
))
xlist)
?>
</table>
<?scm

View File

@ -1238,24 +1238,11 @@ be excluded from periodic reporting.")
(add-if (column-uses? 'price)
(vector (_ "Price")
(lambda (split transaction-row?)
;; share price is retrieved as an
;; exact rational; convert for
;; presentation to decimal, rounded
;; to the currency SCU, optionally
;; increasing precision by 2
;; significant digits.
(let* ((currency (xaccTransGetCurrency
(xaccSplitGetParent split)))
(scu (gnc-commodity-get-fraction currency))
(price (xaccSplitGetSharePrice split))
(price-decimal
(gnc-numeric-convert
price (min 10000 (* 100 scu))
GNC-HOW-RND-ROUND)))
(gnc:make-html-table-cell/markup
"number-cell"
(gnc:make-gnc-monetary
currency price-decimal)))))))))
(gnc:make-html-table-cell/markup
"number-cell"
(gnc:default-price-renderer
(xaccTransGetCurrency (xaccSplitGetParent split))
(xaccSplitGetSharePrice split)))))))))
(if (or (column-uses? 'subtotals-only)
(and (null? left-cols-list)

View File

@ -100,6 +100,8 @@ GNCPrintAmountInfo gnc_account_print_info (const Account *account,
gboolean use_symbol);
GNCPrintAmountInfo gnc_commodity_print_info (const gnc_commodity *commodity,
gboolean use_symbol);
GNCPrintAmountInfo gnc_price_print_info (const gnc_commodity *curr,
gboolean use_symbol);
GNCPrintAmountInfo gnc_share_print_info_places (int decplaces);
const char * xaccPrintAmount (gnc_numeric val, GNCPrintAmountInfo info);

View File

@ -1425,7 +1425,7 @@ gnc_share_print_info_places (int decplaces)
}
GNCPrintAmountInfo
gnc_default_price_print_info (const gnc_commodity *curr)
gnc_price_print_info (const gnc_commodity *curr, gboolean use_symbol)
{
GNCPrintAmountInfo info;
gboolean force = gnc_prefs_get_bool (GNC_PREFS_GROUP_GENERAL,
@ -1447,7 +1447,7 @@ gnc_default_price_print_info (const gnc_commodity *curr)
}
info.use_separators = 1;
info.use_symbol = 0;
info.use_symbol = use_symbol ? 1 : 0;
info.use_locale = 1;
info.monetary = 1;
@ -1456,6 +1456,13 @@ gnc_default_price_print_info (const gnc_commodity *curr)
return info;
}
GNCPrintAmountInfo
gnc_default_price_print_info (const gnc_commodity *curr)
{
return gnc_price_print_info (curr, FALSE);
}
GNCPrintAmountInfo
gnc_integral_print_info (void)
{

View File

@ -303,6 +303,9 @@ GNCPrintAmountInfo gnc_account_print_info (const Account *account,
GNCPrintAmountInfo gnc_split_amount_print_info (Split *split,
gboolean use_symbol);
GNCPrintAmountInfo gnc_price_print_info (const gnc_commodity *curr,
gboolean use_symbol);
GNCPrintAmountInfo gnc_share_print_info_places (int decplaces);
GNCPrintAmountInfo gnc_default_share_print_info (void);
GNCPrintAmountInfo gnc_default_price_print_info (const gnc_commodity *curr);