r16620 - gnucash/trunk - r3 at basement: andrew | 2007-12-07 20:57:48 -0800
Andrew Sackville-West
andrewsw at cvs.gnucash.org
Sat Dec 8 09:24:47 EST 2007
Author: andrewsw
Date: 2007-12-08 09:24:47 -0500 (Sat, 08 Dec 2007)
New Revision: 16620
Trac: http://svn.gnucash.org/trac/changeset/16620
Modified:
gnucash/trunk/
gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm
Log:
r3 at basement: andrew | 2007-12-07 20:57:48 -0800
Create a branch for advanced portfolio work
r4 at basement: andrew | 2007-12-08 05:56:36 -0800
Begin major overhaul to advanced-portfolio report. Fixes #343245, #347739, #460232. Implement stock splits/mergers code in basis calculations. Fix handling of directly "expensed" shares.
Property changes on: gnucash/trunk
___________________________________________________________________
Name: svk:merge
- 3889ce50-311e-0410-a464-f059747ec5d1:/local/gnucash/branches/swig-redo:802
3889ce50-311e-0410-a464-f059747ec5d1:/local/gnucash/trunk:1037
57a11ea4-9604-0410-9ed3-97b8803252fd:/gnucash/branches/gobject-engine-dev-warlord:15827
d2ab10a8-8a95-4986-baff-8d511d9f15b2:/local/gnucash/branches/gobject-engine-dev-warlord:14369
d2ab10a8-8a95-4986-baff-8d511d9f15b2:/local/gnucash/branches/gobject-engine-dev-warlord1:14446
d2ab10a8-8a95-4986-baff-8d511d9f15b2:/local/gnucash/trunk:14601
d2ab10a8-8a95-4986-baff-8d511d9f15b2:/local/gnucash/trunk2:15116
d2ab10a8-8a95-4986-baff-8d511d9f15b2:/local/gnucash/trunk3:15249
+ 3889ce50-311e-0410-a464-f059747ec5d1:/local/gnucash/branches/swig-redo:802
3889ce50-311e-0410-a464-f059747ec5d1:/local/gnucash/trunk:1037
57a11ea4-9604-0410-9ed3-97b8803252fd:/gnucash/branches/gobject-engine-dev-warlord:15827
95e783b2-15b2-415a-8f58-462a736813e0:/gnucash/advport:6
d2ab10a8-8a95-4986-baff-8d511d9f15b2:/local/gnucash/branches/gobject-engine-dev-warlord:14369
d2ab10a8-8a95-4986-baff-8d511d9f15b2:/local/gnucash/branches/gobject-engine-dev-warlord1:14446
d2ab10a8-8a95-4986-baff-8d511d9f15b2:/local/gnucash/trunk:14601
d2ab10a8-8a95-4986-baff-8d511d9f15b2:/local/gnucash/trunk2:15116
d2ab10a8-8a95-4986-baff-8d511d9f15b2:/local/gnucash/trunk3:15249
Modified: gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm 2007-12-08 14:11:03 UTC (rev 16619)
+++ gnucash/trunk/src/report/standard-reports/advanced-portfolio.scm 2007-12-08 14:24:47 UTC (rev 16620)
@@ -41,7 +41,7 @@
(define optname-price-source (N_ "Price Source"))
(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-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"))
@@ -103,12 +103,13 @@
#t))
- (gnc:register-option
- options
- (gnc:make-simple-boolean-option
- gnc:pagename-general optname-include-gains "g"
- (N_ "Include splits with no shares for calculating money-in and money-out")
- #f))
+;; this option is currently unimplemented
+;; (gnc:register-option
+;; options
+;; (gnc:make-simple-boolean-option
+;; gnc:pagename-general optname-include-gains "g"
+;; (N_ "Include splits with no shares for calculating money-in and money-out")
+;; #f))
(gnc:register-option
options
@@ -191,39 +192,67 @@
(eq? type (xaccAccountGetType (xaccSplitGetAccount split))))
(define (same-split? s1 s2)
- (string=? (gncSplitGetGUID s1) (gncSplitGetGUID s2)))
+ (equal? (gncSplitGetGUID s1) (gncSplitGetGUID s2)))
(define (same-account? a1 a2)
- (string=? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))
+ (equal? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))
+
+ ;; sum up the contents of the b-list built by basis-builder below
+ (define (sum-basis b-list)
+ (if (not (eqv? b-list '()))
+ (gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) 100 GNC-RND-ROUND)
+ (sum-basis (cdr b-list)) 100 GNC-RND-ROUND)
+ (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))
+ 100 (logior GNC-DENOM-REDUCE GNC-RND-NEVER))
+ (gnc-numeric-zero)
+ )
+ )
+
;; this builds a list for basis calculation and handles average, fifo and filo 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.
+ ;;
+ ;; FIXME!! need to implement handling of zero for b-units coming in to handle spinoffs.
(define (basis-builder b-list b-units b-value b-method)
+ (gnc:debug "actually in basis-builder")
+ (gnc:debug "b-list is " b-list " b-units is " b-units " b-value is " b-value " b-method is " b-method)
+
+ ;; if there is no b-value, then this is a split/merger and needs special handling
+ ;; FIX ME!! make a (cond (splits/merger) (spin-off) (regular basis adjustment))
+ (if (not (gnc-numeric-zero-p b-value))
+
+ ;; nope, its normal, just adjust the basis
(if (gnc-numeric-positive-p b-units)
(case b-method
((average-basis)
(if (not (eqv? b-list '()))
(list (cons (gnc-numeric-add b-units
- (caar b-list) 10000 GNC-RND-ROUND)
+ (caar b-list) GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-NEVER))
(gnc-numeric-div
(gnc-numeric-add b-value
(gnc-numeric-mul (caar b-list)
(cdar b-list)
- 10000 GNC-RND-ROUND)
- 10000 GNC-RND-ROUND)
+ GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-NEVER))
+ GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-NEVER))
(gnc-numeric-add b-units
- (caar b-list) 10000 GNC-RND-ROUND)
- 10000 GNC-RND-ROUND)))
+ (caar b-list) GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-NEVER))
+ GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-NEVER))))
(append b-list
(list (cons b-units (gnc-numeric-div
- b-value b-units 10000
- GNC-RND-ROUND))))))
+ b-value b-units GNC-DENOM-AUTO
+ (logior GNC-DENOM-REDUCE GNC-RND-NEVER)))))))
(else (append b-list
(list (cons b-units (gnc-numeric-div
- b-value b-units 10000
- GNC-RND-ROUND))))))
+ b-value b-units GNC-DENOM-AUTO
+ (logior GNC-DENOM-REDUCE GNC-RND-NEVER)))))))
(if (not (eqv? b-list '()))
(case b-method
((fifo-basis)
@@ -231,11 +260,11 @@
(gnc-numeric-abs b-units) (caar b-list))))
(basis-builder (cdr b-list) (gnc-numeric-add
b-units
- (caar b-list) 10000 GNC-RND-ROUND)
+ (caar b-list) GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-NEVER))
b-value b-method)
(append (list (cons (gnc-numeric-add
b-units
- (caar b-list) 10000 GNC-RND-ROUND)
+ (caar b-list) GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-NEVER))
(cdar b-list))) (cdr b-list))))
((filo-basis)
(if (not (= -1 (gnc-numeric-compare
@@ -244,45 +273,49 @@
(gnc-numeric-add
b-units
(caar (reverse b-list))
- 10000 GNC-RND-ROUND)
+ GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-NEVER))
b-value b-method)
(append (cdr (reverse b-list))
(list (cons (gnc-numeric-add
b-units
- (caar (reverse b-list)) 10000 GNC-RND-ROUND)
+ (caar (reverse b-list)) GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-NEVER))
(cdar (reverse b-list)))))))
((average-basis)
(list (cons (gnc-numeric-add
- (caar b-list) b-units 10000 GNC-RND-ROUND)
+ (caar b-list) b-units GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-NEVER))
(cdar b-list)))))
'()
)
)
+ ;; this is a split/merge...
+ (let* ((current-units (units-basis b-list))
+ (units-ratio (gnc-numeric-div current-units
+ (gnc-numeric-add b-units current-units GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-NEVER))
+ GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-NEVER))))
+
+ (define (apply-ratio blist ratio)
+ (if (not (eqv? blist '()))
+ (cons (cons (gnc-numeric-div (caar blist) ratio GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-NEVER))
+ (gnc-numeric-mul ratio (cdar blist) GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-NEVER)))
+ (apply-ratio (cdr blist) ratio ))
+ '()
)
-
- ;; sum up the contents of the b-list built by basis-builder above
- (define (sum-basis b-list)
- (if (not (eqv? b-list '()))
- (gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) 100 GNC-RND-ROUND)
- (sum-basis (cdr b-list)) 100 GNC-RND-ROUND)
- (gnc-numeric-zero)
)
+ (gnc:debug "blist is " b-list " units ratio is " units-ratio)
+ (apply-ratio b-list units-ratio)
)
-
- ;; sum up the total number of units in the b-list built by basis-builder above
- (define (units-basis b-list)
- (if (not (eqv? b-list '()))
- (gnc-numeric-add (caar b-list) (units-basis (cdr b-list)) 100 GNC-RND-ROUND)
- (gnc-numeric-zero)
+
+ ;; FIXME!!! If there are no units, just a value, then its a spin-off, must
+ ;; reduce the *values* but not the number of units held
)
)
(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
+ include-empty show-symbol show-listing show-shares show-price
basis-method prefer-pricelist total-basis total-value total-moneyin total-moneyout
- total-gain total-ugain)
+ total-gain total-ugain total-brokerage)
(let ((share-print-info
(gnc-share-print-info-places
@@ -295,6 +328,7 @@
(current (car accounts))
(rest (cdr accounts))
(name (xaccAccountGetName current))
+ ;; commodity is the actual stock/thing we are looking at
(commodity (xaccAccountGetCommodity current))
(ticker-symbol (gnc-commodity-get-mnemonic commodity))
(listing (gnc-commodity-get-namespace commodity))
@@ -314,11 +348,21 @@
(price-list (price-fn commodity to-date))
+ ;; the price of the commodity at the time of the report
(price (if (> (length price-list) 0)
(car price-list) #f))
- ;; 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.
+ ;; 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.
+ ;; the currency in which the transaction takes place,
+ ;; for example IBM shares are the commodity, purchsed
+ ;; with US dollars. In this case, commod-currency
+ ;; would be US dollars. If there is no price, we
+ ;; arbitrarily set the commod-currency to the same as
+ ;; that of the report, currency
(commod-currency (if price (gnc-price-get-currency price) currency))
+ ;; the value of the commodity, expressed in terms of
+ ;; the report's currency.
(value (exchange-fn (gnc:make-gnc-monetary commodity units) currency))
(txn-value (gnc-numeric-zero))
@@ -327,96 +371,158 @@
(use-txn #f)
(basis-list '())
(txn-units (gnc-numeric-zero))
+ ;; setup an alist for the splits we've already seen.
+ (seen_split '())
)
-;; (gnc:debug "---" name "---")
+ ;; (gnc:debug "---" name "---")
(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
+ ;; split, determine what kind of split it is and then act accordingly.
(lambda (split)
(set! work-done (+ 1 work-done))
(gnc:report-percent-done (* 100 (/ work-done work-to-do)))
- (let ((parent (xaccSplitGetParent split)))
- (if (gnc:timepair-le (gnc-transaction-get-date-posted parent) to-date)
- (begin
+
+ (let* ((parent (xaccSplitGetParent split))
+ (txn-date (gnc-transaction-get-date-posted parent)))
+
+ ;; we must have a good commod-currency before we go any
+ ;; farther as the rest relies on it. If we don't have a
+ ;; price, then we need to make one from somewhere and
+ ;; grab its commod-currency as well.
+ (if (not price)
(for-each
(lambda (s)
- ;; If this is an asset type account for buy or sell, then grab a
- ;; currency and a txn-value for later computation
- (cond
- ((and (not (same-account? current (xaccSplitGetAccount s)))
- (not (or (split-account-type?
- s ACCT-TYPE-EXPENSE)
- (split-account-type?
- s ACCT-TYPE-INCOME))))
-
- ;;only change the commod-currency if price failed
- (if (not price) (set! commod-currency (xaccAccountGetCommodity (xaccSplitGetAccount s))))
- (set! txn-value (gnc-numeric-abs (xaccSplitGetValue s)));;FIXME use xaccSplitGetSharePrice
- (set! txn-date (gnc-transaction-get-date-posted parent))
- (set! pricing-txn parent)
+ (if (and (not (or (split-account-type? s ACCT-TYPE-EXPENSE)
+ (split-account-type? s ACCT-TYPE-INCOME)
+ (split-account-type? s ACCT-TYPE-ROOT)))
+ (not (same-account? current (xaccSplitGetAccount s))))
+ (begin
+ ;; we're using a transaction to get the price, so we have to set some stuff
+ (set! commod-currency (xaccAccountGetCommodity (xaccSplitGetAccount s)))
+ (set! pricing-txn (xaccSplitGetParent s))
+ (gnc:debug "pricing txn is " pricing-txn)
)
- ((same-account? current (xaccSplitGetAccount s))
- (set! txn-units (xaccSplitGetAmount s)))
-
)
+ )
+ (xaccTransGetSplitList parent))
)
- (xaccTransGetSplitList parent))
+ (if (gnc:timepair-le txn-date to-date)
+ (begin
+ ;; here's where we have problems. we are now going to look at each
+ ;; split of the the parent txn of the current split (above) that we
+ ;; are on. This means we might hit each split more than once as the
+ ;; parent transaction might touch the current account more than once.
+ (for-each
+ (lambda (s)
+ ;; have we seen this split?
+ (if (not (assoc-ref seen_split (gncSplitGetGUID s)))
- ;; go build the basis-list
- ;; the use of exchange-fn here is an attempt to get the basis list into one
- ;; currency to help accomodate stock transfers and other things. might not work.
- (set! basis-list (basis-builder basis-list txn-units (gnc:gnc-monetary-amount
- (exchange-fn (gnc:make-gnc-monetary
- commod-currency txn-value)
- currency)) basis-method))
+ (let
+ ;; get the split's units and value
+ ((split-units (xaccSplitGetAmount s))
+ (split-value (xaccSplitGetValue s)))
- (for-each
- (lambda (s)
+ ;; first add this split to the seen_split list so we only look at it once.
+ (set! seen_split (acons (gncSplitGetGUID s) #t seen_split))
+
+ (gnc:debug "split units " split-units " split-value " split-value " commod-currency " commod-currency)
+
+ ;; now we look at what type of split this is and process accordingly
(cond
- ((same-split? s split)
-;; (gnc:debug "amount " (gnc-numeric-to-double (xaccSplitGetAmount s))
-;; " acct " (xaccAccountGetName (xaccSplitGetAccount s)) )
-;; (gnc:debug "value " (gnc-numeric-to-double (xaccSplitGetValue s))
-;; " in " (gnc-commodity-get-printname commod-currency)
-;; " from " (xaccTransGetDescription (xaccSplitGetParent s)))
- (cond
- ((or include-gains (not (gnc-numeric-zero-p (xaccSplitGetAmount s))))
- (unitscoll 'add commodity (xaccSplitGetAmount s)) ;; Is the stock transaction?
-;; these lines do nothing, but are in a debug so I'm leaving it, just in case. asw.
-;; (if (< 0 (gnc-numeric-to-double
-;; (xaccSplitGetAmount s)))
+ ;; in theory, the only expenses are
+ ;; brokerage fees. Not true, you can
+ ;; have expenses for "donating"
+ ;; shares to a charity, for
+ ;; example. In this case, there will
+ ;; be *only* two
+ ;; splits. xaccSplitGetOtherSplit
+ ;; returns null for a
+ ;; more-than-two-splits txn
+ ((split-account-type? s ACCT-TYPE-EXPENSE)
+ (if (equal? current (xaccSplitGetAccount (xaccSplitGetOtherSplit s)))
+ ;; "donated shares"
+ (moneyoutcoll 'add commod-currency split-value)
+ ;; brokerage fees
+ (brokeragecoll 'add commod-currency split-value)))
-;; (set! totalunits
-;; (+ totalunits
-;; (gnc-numeric-to-double (xaccSplitGetAmount s))))
-;; )
+ ;; in theory, income is a dividend of
+ ;; some kind. it could also be
+ ;; gains. that gets handled later. it
+ ;; could also be direct income into
+ ;; shares, say from an employer into
+ ;; a retirement account. basically,
+ ;; there is nothing that can be done
+ ;; with these to differentiate them
+ ;; :(
+ ((split-account-type? s ACCT-TYPE-INCOME)
+ (dividendcoll 'add commod-currency split-value))
+ ;; we have units, handle all cases of that
+ ((not (gnc-numeric-zero-p split-units))
+ (begin
+
+ (gnc:debug "going in to basis list " basis-list split-units split-value)
-;; (set! totalunityears
-;; (+ totalunityears
-;; (* (gnc-numeric-to-double (xaccSplitGetAmount s))
-;; (gnc:date-year-delta
-;; (car (gnc-transaction-get-date-posted parent))
-;; (current-time)))))
- (cond
- ((gnc-numeric-negative-p (xaccSplitGetValue s))
- (moneyoutcoll
- 'add commod-currency
- (gnc-numeric-neg (xaccSplitGetValue s))))
- (else (moneyincoll
- 'add commod-currency
- (gnc-numeric-neg (xaccSplitGetValue s))))))))
+ ;; first fix the basis. but only when we are dealing with the actual stock
+ (if (same-account? current (xaccSplitGetAccount s))
+ (set! basis-list (basis-builder basis-list split-units (gnc:gnc-monetary-amount
+ (exchange-fn (gnc:make-gnc-monetary
+ commod-currency split-value)
+ currency)) basis-method)))
+ (gnc:debug "coming out of basis list " basis-list)
+ ;; now look at what else we have to work with
+ (cond
- ((split-account-type? s ACCT-TYPE-EXPENSE)
- (brokeragecoll 'add commod-currency (xaccSplitGetValue s)))
-
- ((split-account-type? s ACCT-TYPE-INCOME)
- (dividendcoll 'add commod-currency (xaccSplitGetValue s)))
+ ;; are we looking at the same
+ ;; account? that means we're
+ ;; dealing strictly with the
+ ;; amount of stock moving, and
+ ;; its value, adjust the money
+ ;; collectors ((same-account?
+ ;; current (xaccSplitGetAccount
+ ;; s)) if the commod-currency and
+ ;; the commodity of this split,
+ ;; s, are the same then we're
+ ;; dealing with actual money
+ ;; being shuffled and we need to
+ ;; adjust moneyin/out
+ ((equal? commod-currency (xaccAccountGetCommodity (xaccSplitGetAccount s)))
+ (begin
+ (gnc:debug "adjsting the moneyin/out " split-value)
+ ;;(unitscoll 'add commodity split-units)
+ (if (gnc-numeric-negative-p split-value)
+ (moneyincoll 'add commod-currency
+ (gnc-numeric-neg split-value))
+ (moneyoutcoll 'add commod-currency split-value)
)
)
+ )
+ )
+ )
+ )
+
+ ;; here is where we handle a spin-off txn. This will be a no-units
+ ;; transaction with only one other split. xaccSplitGetOtherSplit only
+ ;; returns on a two-split txn :)
+ ;; FIXME!! not implemented in basis-builder yet!
+ ((and (gnc-numeric-zero-p txn-units) (xaccSplitGetOtherSplit s))
+ (if (same-account? current (xaccSplitGetAccount s))
+ (set! basis-list (basis-builder basis-list split-units (gnc:gnc-monetary-amount
+ (exchange-fn (gnc:make-gnc-monetary
+ commod-currency split-value)
+ currency)) basis-method))
+ )
+ )
+ )
+ )
+ )
+ )
(xaccTransGetSplitList parent)
)
)
@@ -434,6 +540,9 @@
(if prefer-pricelist #f
(if (not (gnc:timepair-le txn-date (gnc-price-get-time price)))
#t #f))))
+ (gnc:debug "use txn is " use-txn)
+ (gnc:debug "prefer-pricelist is " prefer-pricelist)
+ (gnc:debug "price is " price)
;; okay we're using the txn, so make a new price, value etc. and warn the user
(if use-txn
@@ -442,13 +551,13 @@
(gnc:make-gnc-monetary commod-currency
(gnc-numeric-div txn-value
(gnc-numeric-abs txn-units)
- 100 GNC-RND-ROUND))
+ 100 (logior GNC-DENOM-REDUCE GNC-RND-NEVER)))
(gnc:make-gnc-monetary commod-currency (gnc-numeric-zero))))
-
+
(set! value (if price (gnc:make-gnc-monetary commod-currency
(gnc-numeric-mul units
(gnc:gnc-monetary-amount price)
- 100 GNC-RND-ROUND))
+ 100 (logior GNC-DENOM-REDUCE GNC-RND-NEVER)))
(gnc:make-gnc-monetary commod-currency (gnc-numeric-zero))))
(set! warn-price-dirty #t)
)
@@ -457,27 +566,35 @@
;; what this means is gain = moneyout - moneyin + basis-of-current-shares, and
;; adjust for brokers and dividends.
(gaincoll 'add currency (sum-basis basis-list))
- (moneyincoll 'minusmerge dividendcoll #f)
- (moneyoutcoll 'minusmerge brokeragecoll #f)
+ (gnc:debug (list "basis we're using to build rows is " (sum-basis basis-list)))
+ (gnc:debug (list "but the actual basis list is " basis-list))
+ ;; FIXME! these lines were intended to adjust the dividends and
+ ;; brokerage fees back out of the money collector so the user could
+ ;; see just the pure investment money. It doesn't work because its
+ ;; impossible to tell where income comes from.
+
+ ;; (moneyincoll 'minusmerge dividendcoll #f)
+ ;; (moneyincoll 'minusmerge brokeragecoll #f)
+ ;; (moneyoutcoll 'minusmerge brokeragecoll #f)
(gaincoll 'merge moneyoutcoll #f)
- (gaincoll 'merge moneyincoll #f)
+ (gaincoll 'minusmerge 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)))
+ (let* ((moneyin (gnc:sum-collector-commodity moneyincoll currency exchange-fn))
(moneyout (gnc:sum-collector-commodity moneyoutcoll currency exchange-fn))
+ (brokerage (gnc:sum-collector-commodity brokeragecoll currency exchange-fn))
;; just so you know, gain == realized gain, ugain == un-realized gain, bothgain, well..
(gain (gnc:sum-collector-commodity gaincoll currency exchange-fn))
(ugain (gnc:make-gnc-monetary currency
(gnc-numeric-sub (gnc:gnc-monetary-amount (exchange-fn value currency))
(sum-basis basis-list)
- 100 GNC-RND-ROUND)))
+ 100 (logior GNC-DENOM-REDUCE GNC-RND-NEVER))))
(bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount gain)
(gnc:gnc-monetary-amount ugain)
- 100 GNC-RND-ROUND)))
+ 100 (logior GNC-DENOM-REDUCE GNC-RND-NEVER))))
(activecols (list (gnc:html-account-anchor current)))
)
@@ -485,6 +602,7 @@
(total-value 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))
(total-moneyin 'merge moneyincoll #f)
(total-moneyout 'merge moneyoutcoll #f)
+ (total-brokerage 'merge brokeragecoll #f)
(total-gain 'merge gaincoll #f)
(total-ugain 'add (gnc:gnc-monetary-commodity ugain) (gnc:gnc-monetary-amount ugain))
(total-basis 'add currency (sum-basis basis-list))
@@ -516,8 +634,6 @@
(gnc:make-html-table-header-cell/markup "number-cell" gain)
(gnc:make-html-table-header-cell/markup "number-cell" ugain)
(gnc:make-html-table-header-cell/markup "number-cell" bothgain)
-
-
(gnc:make-html-table-header-cell/markup "number-cell"
(let ((moneyinvalue (gnc-numeric-to-double
(gnc:gnc-monetary-amount moneyin))))
@@ -526,6 +642,7 @@
(sprintf #f "%.2f%%" (* 100 (/ (gnc-numeric-to-double
(gnc:gnc-monetary-amount bothgain))
moneyinvalue))))))
+ (gnc:make-html-table-header-cell/markup "number-cell" brokerage)
)
)
@@ -560,8 +677,9 @@
gnc:optname-reportname))
(include-empty (get-option gnc:pagename-accounts
optname-zero-shares))
- (include-gains (get-option gnc:pagename-general
- optname-include-gains))
+ ;; unimplemented option
+ ;; (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
@@ -581,6 +699,7 @@
(total-moneyout (gnc:make-commodity-collector))
(total-gain (gnc:make-commodity-collector)) ;; realized gain
(total-ugain (gnc:make-commodity-collector)) ;; unrealized gain
+ (total-brokerage (gnc:make-commodity-collector))
;;document will be the HTML document that we return.
(table (gnc:make-html-table))
(document (gnc:make-html-document)))
@@ -638,7 +757,8 @@
(_ "Realized Gain")
(_ "Unrealized Gain")
(_ "Total Gain")
- (_ "Total Return")))
+ (_ "Total Return")
+ (_ "Brokerage Fees")))
(append! totalscols (list " "))
@@ -648,22 +768,22 @@
(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
- basis-method prefer-pricelist total-basis total-value total-moneyin total-moneyout total-gain total-ugain)
+ include-empty show-symbol show-listing show-shares show-price
+ basis-method prefer-pricelist total-basis total-value total-moneyin total-moneyout total-gain total-ugain total-brokerage)
(set! sum-total-gain (gnc:sum-collector-commodity total-gain currency exchange-fn))
(set! sum-total-ugain (gnc:sum-collector-commodity total-ugain currency exchange-fn))
(set! sum-total-both-gains (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount sum-total-gain)
(gnc:gnc-monetary-amount sum-total-ugain)
- 100 GNC-RND-ROUND)))
+ 100 (logior GNC-DENOM-REDUCE GNC-RND-NEVER))))
(gnc:html-table-append-row/markup!
table
"grand-total"
(list
(gnc:make-html-table-cell/size
- 1 14 (gnc:make-html-text (gnc:html-markup-hr)))))
+ 1 15 (gnc:make-html-text (gnc:html-markup-hr)))))
;; finish building the totals columns, now that totals are complete
(append! totalscols (list
@@ -672,7 +792,7 @@
(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)))
+ "total-number-cell" (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
@@ -684,13 +804,15 @@
(gnc:make-html-table-cell/markup
"total-number-cell"
(let ((totalinvalue (gnc-numeric-to-double
- (gnc:gnc-monetary-amount (gnc:monetary-neg (gnc:sum-collector-commodity
- total-moneyin currency exchange-fn))))))
+ (gnc:gnc-monetary-amount (gnc:sum-collector-commodity
+ total-moneyin currency exchange-fn)))))
(if (= 0.0 totalinvalue)
(sprintf #f "%.2f%%" totalinvalue)
(sprintf #f "%.2f%%" (* 100 (/ (gnc-numeric-to-double
(gnc:gnc-monetary-amount sum-total-both-gains))
totalinvalue))))))
+ (gnc:make-html-table-cell/markup
+ "total-number-cell" (gnc:sum-collector-commodity total-brokerage currency exchange-fn))
))
More information about the gnucash-changes
mailing list