Okay, the advanced portfolio report was broken in a number of ways. I've masssaged it pretty well I think, but made some assumptions about how it should behave. Essentially, there are three cases we encounter, listed below:
1). a normal, properly formed stock account with pricedb entries etc. In this case, the report should work as expected, handling multiple currencies etc. I do not use multiple currencies and don't really grok them so if someone could test this properly, that would be great 2) a stock account with no shares in it. In this case, the report just spews a bunch of zeros for the particular stock, as expected. It no longer crashes which should solve Eildert's problem 3) a stock account with shares in it but with no pricedb entry. In this case, I made the assumption that the file was broken. There should always be a pricedb entry if there are any shares in an account, IMO. Probably the code should be fixed so that any buy or sell or similar action automatically creates a pricedb entry. Still we have to account for 1.8 files that might be broken in this regard. phew. What it does: flags the particular stock as being "dirty" and tries to make a reasonable guess at what the current value and gain is based on data pulled from the actual transactions. I am not convinced however that this data is properly exchanged across multiple currencies. So the report spews what it can on this stock, but sticks a * in the price column and places a warning at the bottom of the report explaining the situation. Also, any stocks that don't have a pricedb entry are EXCLUDED from the totals at the bottom of the report as the information is not reliable. please give me feedback on this monster and my assumptions. I would like to make it behave appropriately and I don't know if my assumptions are correct. thanks A
Index: src/report/standard-reports/advanced-portfolio.scm
===================================================================
--- src/report/standard-reports/advanced-portfolio.scm (revision 13263)
+++ src/report/standard-reports/advanced-portfolio.scm (working copy)
@@ -42,6 +42,10 @@
(define optname-shares-digits (N_ "Share decimal places"))
(define optname-zero-shares (N_ "Include accounts with no shares"))
(define optname-include-gains (N_ "Include gains and losses"))
+(define optname-show-symbol (N_ "Show ticker symbols"))
+(define optname-show-listing (N_ "Show listings"))
+(define optname-show-price (N_ "Show prices"))
+(define optname-show-shares (N_ "Show number of shares"))
(define (options-generator)
(let* ((options (gnc:new-options))
@@ -73,12 +77,6 @@
)))
- (add-option
- (gnc:make-number-range-option
- gnc:pagename-general optname-shares-digits
- "e" (N_ "The number of decimal places to use for share numbers") 2
- 0 6 0 1))
-
(gnc:register-option
options
(gnc:make-simple-boolean-option
@@ -86,6 +84,40 @@
(N_ "Include splits with no shares for calculating money-in and
money-out")
#f))
+ (gnc:register-option
+ options
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-show-symbol "a"
+ (N_ "Display the ticker symbols")
+ #t))
+
+ (gnc:register-option
+ options
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-show-listing "b"
+ (N_ "Display exchange listings")
+ #t))
+
+ (gnc:register-option
+ options
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-show-shares "c"
+ (N_ "Display numbers of shares in accounts")
+ #t))
+
+ (add-option
+ (gnc:make-number-range-option
+ gnc:pagename-display optname-shares-digits
+ "d" (N_ "The number of decimal places to use for share numbers") 2
+ 0 6 0 1))
+
+ (gnc:register-option
+ options
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-show-price "e"
+ (N_ "Display share prices")
+ #t))
+
;; Account tab
(add-option
(gnc:make-account-list-option
@@ -115,6 +147,7 @@
;; includes all the relevant Scheme code. The option database passed
;; to the function is one created by the options-generator function
;; defined above.
+
(define (advanced-portfolio-renderer report-obj)
(let ((work-done 0)
@@ -134,16 +167,18 @@
(define (same-split? s1 s2)
(string=? (gnc:split-get-guid s1) (gnc:split-get-guid s2)))
- (define (table-add-stock-rows table accounts to-date
- currency price-fn exchange-fn include-empty
include-gains
+
+(define (table-add-stock-rows table accounts to-date
+ currency price-fn exchange-fn
+ include-empty include-gains show-symbol
show-listing show-shares show-price
total-value total-moneyin total-moneyout
total-gain)
(let ((share-print-info
(gnc:share-print-info-places
- (inexact->exact (get-option gnc:pagename-general
- optname-shares-digits)))))
-
+ (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"))
@@ -170,113 +205,133 @@
(price-list (price-fn commodity to-date))
(price (if (> (length price-list) 0)
(car price-list) #f))
-
- (value (exchange-fn (gnc:make-gnc-monetary commodity units)
currency to-date))
- )
+ (commod-currency (gnc:price-get-currency price))
+ (value (exchange-fn (gnc:make-gnc-monetary commodity units)
+ currency))
+ )
-;; (gnc:debug "---" name "---")
- (for-each
- (lambda (split)
- (set! work-done (+ 1 work-done))
- (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
- (let ((parent (gnc:split-get-parent split)))
- (if (gnc:timepair-le (gnc:transaction-get-date-posted
parent) to-date)
- (for-each
- (lambda (s)
- (cond
- ((same-split? s split)
- ;; (gnc:debug "amount" (gnc:numeric-to-double
(gnc:split-get-amount s)) )
- (cond
- ((or include-gains (not (gnc:numeric-zero-p
(gnc:split-get-amount s))))
- (unitscoll 'add commodity
(gnc:split-get-amount s)) ;; Is the stock transaction?
- (if (< 0 (gnc:numeric-to-double
- (gnc:split-get-amount s)))
- (set! totalunits
- (+ totalunits
- (gnc:numeric-to-double
(gnc:split-get-amount s)))))
- (set! totalunityears
- (+ totalunityears
- (* (gnc:numeric-to-double
(gnc:split-get-amount s))
- (gnc:date-year-delta
- (car
(gnc:transaction-get-date-posted parent))
- (current-time)))))
- (cond
- ((gnc:numeric-negative-p
(gnc:split-get-value s))
- (moneyoutcoll
- 'add currency
- (gnc:numeric-neg (gnc:split-get-value s))))
- (else (moneyincoll
- 'add currency
- (gnc:numeric-neg (gnc:split-get-value
s))))))))
+;; (gnc:debug "---" name "---")
+ (for-each
+ (lambda (split)
+ (set! work-done (+ 1 work-done))
+ (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
+ (let ((parent (gnc:split-get-parent split)))
+ (if (gnc:timepair-le (gnc:transaction-get-date-posted parent)
to-date)
+ (for-each
+ (lambda (s)
+ (cond
+ ((same-split? s split)
+;; (gnc:debug "amount " (gnc:numeric-to-double
(gnc:split-get-amount s))
+;; " acct " (gnc:account-get-name
(gnc:split-get-account s)) )
+;; (gnc:debug "value " (gnc:numeric-to-double
(gnc:split-get-value s))
+;; " in " (gnc:commodity-get-printname
commod-currency)
+;; " from " (gnc:transaction-get-description
(gnc:split-get-parent s)))
+ (cond
+ ((or include-gains (not (gnc:numeric-zero-p
(gnc:split-get-amount s))))
+ (unitscoll 'add commodity (gnc:split-get-amount s))
;; Is the stock transaction?
+ (if (< 0 (gnc:numeric-to-double
+ (gnc:split-get-amount s)))
+ (set! totalunits
+ (+ totalunits
+ (gnc:numeric-to-double
(gnc:split-get-amount s)))))
+ (set! totalunityears
+ (+ totalunityears
+ (* (gnc:numeric-to-double
(gnc:split-get-amount s))
+ (gnc:date-year-delta
+ (car (gnc:transaction-get-date-posted
parent))
+ (current-time)))))
+ (cond
+ ((gnc:numeric-negative-p (gnc:split-get-value s))
+ (moneyoutcoll
+ 'add commod-currency
+ (gnc:numeric-neg (gnc:split-get-value s))))
+ (else (moneyincoll
+ 'add commod-currency
+ (gnc:numeric-neg (gnc:split-get-value
s))))))))
+
+ ((split-account-type? s 'expense)
+ (brokeragecoll 'add commod-currency
(gnc:split-get-value s)))
+
+ ((split-account-type? s 'income)
+ (dividendcoll 'add commod-currency
(gnc:split-get-value s)))
+ )
+ )
+ (gnc:transaction-get-splits parent)
+ )
+ )
+ )
+ )
+ (gnc:account-get-split-list current)
+ )
+;; (gnc:debug "totalunits" totalunits)
+;; (gnc:debug "totalunityears" totalunityears)
- ((split-account-type? s 'expense)
- (brokeragecoll 'add currency (gnc:split-get-value
s)))
+ (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)))
+ (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))
+ (activecols (list (gnc:html-account-anchor current)))
+ )
- ((split-account-type? s 'income)
- (dividendcoll 'add 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)
+ (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)
- (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?)
+ ;; build a list for the row based on user selections
+ (if show-symbol (append! activecols (list ticker-symbol)))
+ (if show-listing (append! activecols (list listing)))
+ (if show-shares (append! activecols (list
(gnc:make-html-table-header-cell/markup
+ "number-cell" (gnc:amount->string units share-print-info)))))
+ (if show-price (append! activecols (list
(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)))))
+ (append! activecols (list (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"
+ (let ((moneyinvalue
(gnc:numeric-to-double
+ (cadr
(moneyincoll 'getpair currency #t)))))
+ (if (= 0.0 moneyinvalue)
+ (_ "N/A")
+ (sprintf #f "%.2f%%" (* 100
(/ (gnc:numeric-to-double
+
(cadr (gaincoll 'getpair currency #f)))
+
moneyinvalue))))))
+ )
+ )
+
+ (gnc:html-table-append-row/markup!
+ table
+ row-style
+ activecols)
+
+ (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)))
-
+
;; Tell the user that we're starting.
(gnc:report-starting reportname)
@@ -295,12 +350,20 @@
optname-zero-shares))
(include-gains (get-option gnc:pagename-general
optname-include-gains))
+ (show-symbol (get-option gnc:pagename-display
+ optname-show-symbol))
+ (show-listing (get-option gnc:pagename-display
+ optname-show-listing))
+ (show-shares (get-option gnc:pagename-display
+ optname-show-shares))
+ (show-price (get-option gnc:pagename-display
+ optname-show-price))
(total-value (gnc:make-commodity-collector))
(total-moneyin (gnc:make-commodity-collector))
(total-moneyout (gnc:make-commodity-collector))
(total-gain (gnc:make-commodity-collector))
- ;; document will be the HTML document that we return.
+ ;;document will be the HTML document that we return.
(table (gnc:make-html-table))
(document (gnc:make-html-document)))
@@ -309,15 +372,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,24 +383,48 @@
(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))))))
+ (headercols (list (_ "Account")))
+ (totalscols (list (gnc:make-html-table-cell/markup
"total-label-cell" (_ "Total")))))
+
+ ;;begin building lists for which columns to display
+ (if show-symbol
+ (begin (append! headercols (list (_ "Symbol")))
+ (append! totalscols (list " "))))
+
+ (if show-listing
+ (begin (append! headercols (list (_ "Listing")))
+ (append! totalscols (list " "))))
+
+ (if show-shares
+ (begin (append! headercols (list (_ "Shares")))
+ (append! totalscols (list " "))))
+
+ (if show-price
+ (begin (append! headercols (list (_ "Price")))
+ (append! totalscols (list " "))))
+
+ (append! headercols (list (_ "Value")
+ (_ "Money In")
+ (_ "Money Out")
+ (_ "Gain")
+ (_ "Total Return")))
+
+
(gnc:html-table-set-col-headers!
table
- (list (_ "Account")
- (_ "Symbol")
- (_ "Listing")
- (_ "Shares")
- (_ "Price")
- (_ "Value")
- (_ "Money In")
- (_ "Money Out")
- (_ "Gain")
- (_ "Total Return")))
+ headercols)
+ (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)
+ include-empty include-gains show-symbol show-listing show-shares
show-price
+ total-value total-moneyin total-moneyout total-gain)
(gnc:html-table-append-row/markup!
table
@@ -351,42 +432,35 @@
(list
(gnc:make-html-table-cell/size
1 10 (gnc:make-html-text (gnc:html-markup-hr)))))
-
+
+ ;; finish building the totals columns, now that totals are complete
+ (append! totalscols (list
+ (gnc:make-html-table-cell/markup
+ "total-number-cell"
(gnc:sum-collector-commodity total-value currency exchange-fn))
+ (gnc:make-html-table-cell/markup
+ "total-number-cell" (gnc:monetary-neg
(gnc:sum-collector-commodity total-moneyin currency exchange-fn)))
+ (gnc:make-html-table-cell/markup
+ "total-number-cell"
(gnc:sum-collector-commodity total-moneyout currency exchange-fn))
+ (gnc:make-html-table-cell/markup
+ "total-number-cell"
(gnc:sum-collector-commodity total-gain currency exchange-fn))
+ (gnc:make-html-table-cell/markup
+ "total-number-cell"
+ (let ((totalinvalue (gnc:numeric-to-double
+ (cadr (total-moneyin
'getpair currency #t)))))
+ (if (= 0.0 totalinvalue)
+ (_ "N/A")
+ (sprintf #f "%.2f%%" (* 100 (/
(gnc:numeric-to-double
+ (cadr
(total-gain 'getpair currency #f)))
+
totalinvalue))))))
+ ))
+
+
(gnc:html-table-append-row/markup!
table
"grand-total"
- (list (gnc:make-html-table-cell/markup
- "total-label-cell" (_ "Total"))
- ""
- ""
- ""
- ""
- (gnc:make-html-table-cell/markup
- "total-number-cell" (gnc:sum-collector-commodity total-value
currency exchange-fn))
- (gnc:make-html-table-cell/markup
- "total-number-cell" (gnc:monetary-neg
(gnc:sum-collector-commodity total-moneyin currency exchange-fn)))
- (gnc:make-html-table-cell/markup
- "total-number-cell" (gnc:sum-collector-commodity
total-moneyout currency exchange-fn))
- (gnc:make-html-table-cell/markup
- "total-number-cell" (gnc:sum-collector-commodity total-gain
currency exchange-fn))
- (gnc:make-html-table-cell/markup
- "total-number-cell" (sprintf #f "%.2f%%" (* 100 (/
(gnc:numeric-to-double (cadr (total-gain 'getpair currency #f)))
-
(gnc:numeric-to-double (cadr (total-moneyin 'getpair currency #t)))))))
- ))
-
-;; (total-value
-;; 'format
-;; (lambda (currency amount)
-;; (gnc:html-table-append-row/markup!
-;; table
-;; "grand-total"
-;; (list (gnc:make-html-table-cell/markup
-;; "total-label-cell" (_ "Total"))
-;; (gnc:make-html-table-cell/size/markup
-;; 1 5 "total-number-cell"
-;; (gnc:make-gnc-monetary currency amount)))))
-;; #f)
-
+ totalscols
+ )
+
(gnc:html-document-add-object! document table))
;if no accounts selected.
Index: advanced-portfolio.scm
===================================================================
--- advanced-portfolio.scm (revision 13273)
+++ advanced-portfolio.scm (working copy)
@@ -46,6 +46,7 @@
(define optname-show-listing (N_ "Show listings"))
(define optname-show-price (N_ "Show prices"))
(define optname-show-shares (N_ "Show number of shares"))
+(define price-is-dirty #f) ;;keep track of whether we're using good price data
(define (options-generator)
(let* ((options (gnc:new-options))
@@ -151,7 +152,8 @@
(define (advanced-portfolio-renderer report-obj)
(let ((work-done 0)
- (work-to-do 0))
+ (work-to-do 0)
+ (warn-price-dirty #f))
;; These are some helper functions for looking up option values.
(define (get-op section name)
@@ -201,15 +203,23 @@
(moneyincoll (gnc:make-commodity-collector))
(moneyoutcoll (gnc:make-commodity-collector))
(gaincoll (gnc:make-commodity-collector))
+ (dirty-value (gnc:numeric-zero))
+ (dirty-amount (gnc:numeric-zero))
(price-list (price-fn commodity to-date))
(price (if (> (length price-list) 0)
(car price-list) #f))
- (commod-currency (gnc:price-get-currency price))
+ ;; if there is no price, set a sane commod-currency for those
zero-share
+ ;; accounts. if its a no price account with shares, we'll get
a currency later.
+ (commod-currency (if (not price) (gnc:price-get-currency
price) currency))
(value (exchange-fn (gnc:make-gnc-monetary commodity units)
currency))
+ ;;if we have shares but no price in pricedb, we'll make a
dirty price guess at things
+ (price-is-dirty (if (and (not price) (< 0
(gnc:numeric-to-double units))) #t #f))
)
+ (if price-is-dirty (set! warn-price-dirty #t))
+
;; (gnc:debug "---" name "---")
(for-each
(lambda (split)
@@ -217,47 +227,69 @@
(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)
+ (begin
+ (for-each
+ (lambda (s)
+ ;; if price-is dirty and this is an asset type
account for buy or sell, then grab a
+ ;; currency and a dirty-value for later computation
+ (if (and price-is-dirty (not (or (split-account-type?
s 'stock)
+ (split-account-type?
s 'mutualfund)
+ (split-account-type?
s 'expense)
+ (split-account-type?
s 'income))))
+ (begin
+ (set! commod-currency
(gnc:account-get-commodity (gnc:split-get-account s)))
+ (set! dirty-value (gnc:split-get-value s))
+ (if (gnc:numeric-negative-p dirty-value)
+ (set! dirty-value (gnc:numeric-sub
(gnc:numeric-zero) dirty-value
+ 10000
GNC-RND-ROUND)))))
+ )
+
+ (gnc:transaction-get-splits parent))
+
+ (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))))))))
+ (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?
+ (set! dirty-amount (gnc:split-get-amount s))
+ (if (< 0 (gnc:numeric-to-double
+ (gnc:split-get-amount s)))
+ (set! totalunits
+ (+ totalunits
+ (gnc:numeric-to-double
(gnc:split-get-amount s)))))
+
+ (set! totalunityears
+ (+ totalunityears
+ (* (gnc:numeric-to-double
(gnc:split-get-amount s))
+ (gnc:date-year-delta
+ (car
(gnc:transaction-get-date-posted parent))
+ (current-time)))))
+ (cond
+ ((gnc:numeric-negative-p (gnc:split-get-value s))
+ (moneyoutcoll
+ 'add commod-currency
+ (gnc:numeric-neg (gnc:split-get-value s))))
+ (else (moneyincoll
+ 'add commod-currency
+ (gnc:numeric-neg (gnc:split-get-value
s))))))))
- ((split-account-type? s 'expense)
- (brokeragecoll 'add commod-currency
(gnc:split-get-value s)))
-
- ((split-account-type? s 'income)
- (dividendcoll 'add commod-currency
(gnc:split-get-value s)))
- )
+ ((split-account-type? s 'expense)
+ (brokeragecoll 'add commod-currency
(gnc:split-get-value s)))
+
+ ((split-account-type? s 'income)
+ (dividendcoll 'add commod-currency
(gnc:split-get-value s)))
+ )
+ )
+ (gnc:transaction-get-splits parent)
)
- (gnc:transaction-get-splits parent)
- )
+ )
)
)
)
@@ -266,25 +298,41 @@
;; (gnc:debug "totalunits" totalunits)
;; (gnc:debug "totalunityears" totalunityears)
- (moneyincoll 'minusmerge dividendcoll #f)
+
+ (if price-is-dirty
+ (set! value (gnc:make-gnc-monetary commod-currency
+ (gnc:numeric-mul units
+
(gnc:numeric-div dirty-value
+
dirty-amount
+
10000 GNC-RND-ROUND)
+ 10000
GNC-RND-ROUND))))
+ (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)))
- (let ((moneyin (gnc:monetary-neg
+ (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))
+ (gain (if price-is-dirty
+ (gnc:make-gnc-monetary commod-currency
+ (gnc:numeric-sub
(gnc:gnc-monetary-amount value)
+
(gnc:gnc-monetary-amount moneyin)
+ 10000
GNC-RND-ROUND))
+ (gnc:sum-collector-commodity gaincoll currency
exchange-fn)))
(activecols (list (gnc:html-account-anchor current)))
)
- (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)
+ (if (not price-is-dirty)
+ (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)))
+
;; build a list for the row based on user selections
(if show-symbol (append! activecols (list ticker-symbol)))
(if show-listing (append! activecols (list listing)))
@@ -298,14 +346,14 @@
(gnc:make-gnc-monetary
(gnc:price-get-currency price)
(gnc:price-get-value price)))
- #f)))))
+ (if price-is-dirty "*" #f))))))
(append! activecols (list (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)))
+ moneyin)
(gnc:make-html-table-header-cell/markup
"number-cell"
- (gnc:sum-collector-commodity
moneyoutcoll currency exchange-fn))
+ moneyout)
(gnc:make-html-table-header-cell/markup
"number-cell"
- (gnc:sum-collector-commodity
gaincoll currency exchange-fn))
+ gain)
(gnc:make-html-table-header-cell/markup
"number-cell"
(let ((moneyinvalue
(gnc:numeric-to-double
(cadr
(moneyincoll 'getpair currency #t)))))
@@ -423,9 +471,9 @@
(table-add-stock-rows
table accounts to-date currency price-fn exchange-fn
- include-empty include-gains show-symbol show-listing show-shares
show-price
+ include-empty include-gains show-symbol show-listing show-shares
show-price
total-value total-moneyin total-moneyout total-gain)
-
+
(gnc:html-table-append-row/markup!
table
"grand-total"
@@ -459,10 +507,15 @@
table
"grand-total"
totalscols
- )
-
- (gnc:html-document-add-object! document table))
+ )
+ (gnc:html-document-add-object! document table)
+ (if warn-price-dirty
+ (gnc:html-document-append-objects! document
+ (list (gnc:make-html-text (_
"* no valid price data for this commodity. It has been exluded from totals
and<BR>"))
+ (gnc:make-html-text (_
"may not be properly exchanged. Please enter a price in the Price Editor.")))))
+)
+
;if no accounts selected.
(gnc:html-document-add-object!
document
pgpzv2oAyjbaT.pgp
Description: PGP signature
_______________________________________________ gnucash-devel mailing list [email protected] https://lists.gnucash.org/mailman/listinfo/gnucash-devel
