mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
r3@basement: andrew | 2007-12-07 20:57:48 -0800
Create a branch for advanced portfolio work r4@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. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@16620 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Andrew Sackville-West
parent
1a408c8160
commit
85a860f0ee
@ -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,76 +192,12 @@
|
||||
(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)))
|
||||
|
||||
;; 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.
|
||||
(define (basis-builder b-list b-units b-value b-method)
|
||||
(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)
|
||||
(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-numeric-add b-units
|
||||
(caar b-list) 10000 GNC-RND-ROUND)
|
||||
10000 GNC-RND-ROUND)))
|
||||
(append b-list
|
||||
(list (cons b-units (gnc-numeric-div
|
||||
b-value b-units 10000
|
||||
GNC-RND-ROUND))))))
|
||||
(else (append b-list
|
||||
(list (cons b-units (gnc-numeric-div
|
||||
b-value b-units 10000
|
||||
GNC-RND-ROUND))))))
|
||||
(if (not (eqv? b-list '()))
|
||||
(case b-method
|
||||
((fifo-basis)
|
||||
(if (not (= -1 (gnc-numeric-compare
|
||||
(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)
|
||||
b-value b-method)
|
||||
(append (list (cons (gnc-numeric-add
|
||||
b-units
|
||||
(caar b-list) 10000 GNC-RND-ROUND)
|
||||
(cdar b-list))) (cdr b-list))))
|
||||
((filo-basis)
|
||||
(if (not (= -1 (gnc-numeric-compare
|
||||
(gnc-numeric-abs b-units) (caar (reverse b-list)))))
|
||||
(basis-builder (reverse (cdr (reverse b-list)))
|
||||
(gnc-numeric-add
|
||||
b-units
|
||||
(caar (reverse b-list))
|
||||
10000 GNC-RND-ROUND)
|
||||
b-value b-method)
|
||||
(append (cdr (reverse b-list))
|
||||
(list (cons (gnc-numeric-add
|
||||
b-units
|
||||
(caar (reverse b-list)) 10000 GNC-RND-ROUND)
|
||||
(cdar (reverse b-list)))))))
|
||||
((average-basis)
|
||||
(list (cons (gnc-numeric-add
|
||||
(caar b-list) b-units 10000 GNC-RND-ROUND)
|
||||
(cdar b-list)))))
|
||||
'()
|
||||
)
|
||||
)
|
||||
)
|
||||
(equal? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))
|
||||
|
||||
;; sum up the contents of the b-list built by basis-builder above
|
||||
;; 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)
|
||||
@ -269,20 +206,116 @@
|
||||
)
|
||||
)
|
||||
|
||||
;; sum up the total number of units in the b-list built by basis-builder above
|
||||
;; 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 GNC-RND-ROUND)
|
||||
(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) 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)
|
||||
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) 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 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 GNC-DENOM-AUTO
|
||||
(logior GNC-DENOM-REDUCE GNC-RND-NEVER)))))))
|
||||
(if (not (eqv? b-list '()))
|
||||
(case b-method
|
||||
((fifo-basis)
|
||||
(if (not (= -1 (gnc-numeric-compare
|
||||
(gnc-numeric-abs b-units) (caar b-list))))
|
||||
(basis-builder (cdr b-list) (gnc-numeric-add
|
||||
b-units
|
||||
(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) GNC-DENOM-AUTO (logior GNC-DENOM-REDUCE GNC-RND-NEVER))
|
||||
(cdar b-list))) (cdr b-list))))
|
||||
((filo-basis)
|
||||
(if (not (= -1 (gnc-numeric-compare
|
||||
(gnc-numeric-abs b-units) (caar (reverse b-list)))))
|
||||
(basis-builder (reverse (cdr (reverse b-list)))
|
||||
(gnc-numeric-add
|
||||
b-units
|
||||
(caar (reverse b-list))
|
||||
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)) 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 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 ))
|
||||
'()
|
||||
)
|
||||
)
|
||||
(gnc:debug "blist is " b-list " units ratio is " units-ratio)
|
||||
(apply-ratio b-list units-ratio)
|
||||
)
|
||||
|
||||
;; 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,95 +371,157 @@
|
||||
(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))
|
||||
|
||||
|
||||
;; 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))
|
||||
|
||||
(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)))
|
||||
|
||||
(let
|
||||
;; get the split's units and value
|
||||
((split-units (xaccSplitGetAmount s))
|
||||
(split-value (xaccSplitGetValue 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))
|
||||
))
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user