|
1 ;; -*-scheme-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
|
2 ;; advanced-portfolio.scm |
|
3 ;; by Martijn van Oosterhout (kleptog@svana.org) Feb 2002 |
|
4 ;; modified for GnuCash 1.8 by Herbert Thoma (herbie@hthoma.de) Oct 2002 |
|
5 ;; |
|
6 ;; Heavily based on portfolio.scm |
|
7 ;; by Robert Merkel (rgmerk@mira.net) |
|
8 ;; |
|
9 ;; This program is free software; you can redistribute it and/or |
|
10 ;; modify it under the terms of the GNU General Public License as |
|
11 ;; published by the Free Software Foundation; either version 2 of |
|
12 ;; the License, or (at your option) any later version. |
|
13 ;; |
|
14 ;; This program is distributed in the hope that it will be useful, |
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
17 ;; GNU General Public License for more details. |
|
18 ;; |
|
19 ;; You should have received a copy of the GNU General Public License |
|
20 ;; along with this program; if not, contact: |
|
21 ;; |
|
22 ;; Free Software Foundation Voice: +1-617-542-5942 |
|
23 ;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 |
|
24 ;; Boston, MA 02110-1301, USA gnu@gnu.org |
|
25 ;; |
|
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
|
27 |
|
28 (define-module (local my-advanced-portfolio)) |
|
29 |
|
30 (use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing. |
|
31 (use-modules (srfi srfi-1)) |
|
32 (use-modules (gnucash gnc-module)) |
|
33 (use-modules (gnucash gettext)) |
|
34 |
|
35 (use-modules (gnucash printf)) |
|
36 |
|
37 (gnc:module-load "gnucash/report/report-system" 0) |
|
38 |
|
39 (define reportname (N_ "My Advanced Portfolio")) |
|
40 |
|
41 (define optname-price-source (N_ "Price Source")) |
|
42 (define optname-shares-digits (N_ "Share decimal places")) |
|
43 (define optname-zero-shares (N_ "Include accounts with no shares")) |
|
44 (define optname-show-symbol (N_ "Show ticker symbols")) |
|
45 (define optname-show-listing (N_ "Show listings")) |
|
46 (define optname-show-price (N_ "Show prices")) |
|
47 (define optname-show-shares (N_ "Show number of shares")) |
|
48 (define optname-basis-method (N_ "Basis calculation method")) |
|
49 (define optname-prefer-pricelist (N_ "Set preference for price list data")) |
|
50 (define optname-brokerage-fees (N_ "How to report brokerage fees")) |
|
51 |
|
52 ;; To avoid overflows in our calculations, define a denominator for prices and unit values |
|
53 (define price-denom 100000000) |
|
54 (define units-denom 100000000) |
|
55 |
|
56 (define (options-generator) |
|
57 (let* ((options (gnc:new-options)) |
|
58 ;; This is just a helper function for making options. |
|
59 ;; See gnucash/src/scm/options.scm for details. |
|
60 (add-option |
|
61 (lambda (new-option) |
|
62 (gnc:register-option options new-option)))) |
|
63 |
|
64 ;; General Tab |
|
65 ;; date at which to report balance |
|
66 (gnc:options-add-report-date! |
|
67 options gnc:pagename-general |
|
68 (N_ "Date") "a") |
|
69 |
|
70 (gnc:options-add-currency! |
|
71 options gnc:pagename-general (N_ "Report's currency") "c") |
|
72 |
|
73 (add-option |
|
74 (gnc:make-multichoice-option |
|
75 gnc:pagename-general optname-price-source |
|
76 "d" (N_ "The source of price information.") 'pricedb-nearest |
|
77 (list (vector 'pricedb-latest |
|
78 (N_ "Most recent") |
|
79 (N_ "The most recent recorded price.")) |
|
80 (vector 'pricedb-nearest |
|
81 (N_ "Nearest in time") |
|
82 (N_ "The price recorded nearest in time to the report date.")) |
|
83 ))) |
|
84 |
|
85 (add-option |
|
86 (gnc:make-multichoice-option |
|
87 gnc:pagename-general optname-basis-method |
|
88 "e" (N_ "Basis calculation method.") 'average-basis |
|
89 (list (vector 'average-basis |
|
90 (N_ "Average") |
|
91 (N_ "Use average cost of all shares for basis.")) |
|
92 (vector 'fifo-basis |
|
93 (N_ "FIFO") |
|
94 (N_ "Use first-in first-out method for basis.")) |
|
95 (vector 'filo-basis |
|
96 (N_ "LIFO") |
|
97 (N_ "Use last-in first-out method for basis.")) |
|
98 ))) |
|
99 |
|
100 (add-option |
|
101 (gnc:make-simple-boolean-option |
|
102 gnc:pagename-general optname-prefer-pricelist "f" |
|
103 (N_ "Prefer use of price editor pricing over transactions, where applicable.") |
|
104 #t)) |
|
105 |
|
106 (add-option |
|
107 (gnc:make-multichoice-option |
|
108 gnc:pagename-general optname-brokerage-fees |
|
109 "g" (N_ "How to report commissions and other brokerage fees.") 'include-in-basis |
|
110 (list (vector 'include-in-basis |
|
111 (N_ "Include in basis") |
|
112 (N_ "Include brokerage fees in the basis for the asset.")) |
|
113 (vector 'include-in-gain |
|
114 (N_ "Include in gain") |
|
115 (N_ "Include brokerage fees in the gain and loss but not in the basis.")) |
|
116 (vector 'ignore-brokerage |
|
117 (N_ "Ignore") |
|
118 (N_ "Ignore brokerage fees entirely.")) |
|
119 ))) |
|
120 |
|
121 (gnc:register-option |
|
122 options |
|
123 (gnc:make-simple-boolean-option |
|
124 gnc:pagename-display optname-show-symbol "a" |
|
125 (N_ "Display the ticker symbols.") |
|
126 #t)) |
|
127 |
|
128 (gnc:register-option |
|
129 options |
|
130 (gnc:make-simple-boolean-option |
|
131 gnc:pagename-display optname-show-listing "b" |
|
132 (N_ "Display exchange listings.") |
|
133 #t)) |
|
134 |
|
135 (gnc:register-option |
|
136 options |
|
137 (gnc:make-simple-boolean-option |
|
138 gnc:pagename-display optname-show-shares "c" |
|
139 (N_ "Display numbers of shares in accounts.") |
|
140 #t)) |
|
141 |
|
142 (add-option |
|
143 (gnc:make-number-range-option |
|
144 gnc:pagename-display optname-shares-digits |
|
145 "d" (N_ "The number of decimal places to use for share numbers.") 2 |
|
146 0 6 0 1)) |
|
147 |
|
148 (gnc:register-option |
|
149 options |
|
150 (gnc:make-simple-boolean-option |
|
151 gnc:pagename-display optname-show-price "e" |
|
152 (N_ "Display share prices.") |
|
153 #t)) |
|
154 |
|
155 ;; Account tab |
|
156 (add-option |
|
157 (gnc:make-account-list-option |
|
158 gnc:pagename-accounts (N_ "Accounts") |
|
159 "b" |
|
160 (N_ "Stock Accounts to report on.") |
|
161 (lambda () (filter gnc:account-is-stock? |
|
162 (gnc-account-get-descendants-sorted |
|
163 (gnc-get-current-root-account)))) |
|
164 (lambda (accounts) (list #t |
|
165 (filter gnc:account-is-stock? accounts))) |
|
166 #t)) |
|
167 |
|
168 (gnc:register-option |
|
169 options |
|
170 (gnc:make-simple-boolean-option |
|
171 gnc:pagename-accounts optname-zero-shares "e" |
|
172 (N_ "Include accounts that have a zero share balances.") |
|
173 #f)) |
|
174 |
|
175 (gnc:options-set-default-section options gnc:pagename-general) |
|
176 options)) |
|
177 |
|
178 ;; This is the rendering function. It accepts a database of options |
|
179 ;; and generates an object of type <html-document>. See the file |
|
180 ;; report-html.txt for documentation; the file report-html.scm |
|
181 ;; includes all the relevant Scheme code. The option database passed |
|
182 ;; to the function is one created by the options-generator function |
|
183 ;; defined above. |
|
184 |
|
185 (define (advanced-portfolio-renderer report-obj) |
|
186 |
|
187 (let ((work-done 0) |
|
188 (work-to-do 0) |
|
189 (warn-no-price #f) |
|
190 (warn-price-dirty #f)) |
|
191 |
|
192 ;; These are some helper functions for looking up option values. |
|
193 (define (get-op section name) |
|
194 (gnc:lookup-option (gnc:report-options report-obj) section name)) |
|
195 |
|
196 (define (get-option section name) |
|
197 (gnc:option-value (get-op section name))) |
|
198 |
|
199 (define (split-account-type? split type) |
|
200 (eq? type (xaccAccountGetType (xaccSplitGetAccount split)))) |
|
201 |
|
202 (define (same-split? s1 s2) |
|
203 (equal? (gncSplitGetGUID s1) (gncSplitGetGUID s2))) |
|
204 |
|
205 (define (same-account? a1 a2) |
|
206 (equal? (gncAccountGetGUID a1) (gncAccountGetGUID a2))) |
|
207 |
|
208 (define (same-account-code? a1 a2) |
|
209 (equal? (xaccAccountGetCode a1) (xaccAccountGetCode a2))) |
|
210 |
|
211 ;; sum up the contents of the b-list built by basis-builder below |
|
212 (define (sum-basis b-list currency-frac) |
|
213 (if (not (eqv? b-list '())) |
|
214 (gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) currency-frac GNC-RND-ROUND) |
|
215 (sum-basis (cdr b-list) currency-frac) currency-frac GNC-RND-ROUND) |
|
216 (gnc-numeric-zero) |
|
217 ) |
|
218 ) |
|
219 |
|
220 ;; sum up the total number of units in the b-list built by basis-builder below |
|
221 (define (units-basis b-list) |
|
222 (if (not (eqv? b-list '())) |
|
223 (gnc-numeric-add (caar b-list) (units-basis (cdr b-list)) |
|
224 units-denom GNC-RND-ROUND) |
|
225 (gnc-numeric-zero) |
|
226 ) |
|
227 ) |
|
228 |
|
229 ;; apply a ratio to an existing basis-list, useful for splits/mergers and spinoffs |
|
230 ;; I need to get a brain and use (map) for this. |
|
231 (define (apply-basis-ratio b-list units-ratio value-ratio) |
|
232 (if (not (eqv? b-list '())) |
|
233 (cons (cons (gnc-numeric-mul units-ratio (caar b-list) units-denom GNC-RND-ROUND) |
|
234 (gnc-numeric-mul value-ratio (cdar b-list) price-denom GNC-RND-ROUND)) |
|
235 (apply-basis-ratio (cdr b-list) units-ratio value-ratio)) |
|
236 '() |
|
237 ) |
|
238 ) |
|
239 |
|
240 ;; this builds a list for basis calculation and handles average, fifo and lifo methods |
|
241 ;; the list is cons cells of (units-of-stock . price-per-unit)... average method produces only one |
|
242 ;; cell that mutates to the new average. Need to add a date checker so that we allow for prices |
|
243 ;; coming in out of order, such as a transfer with a price adjusted to carryover the basis. |
|
244 (define (basis-builder b-list b-units b-value b-method currency-frac) |
|
245 (gnc:debug "actually in basis-builder") |
|
246 (gnc:debug "b-list is " b-list " b-units is " (gnc-numeric-to-string b-units) |
|
247 " b-value is " (gnc-numeric-to-string b-value) " b-method is " b-method) |
|
248 |
|
249 ;; if there is no b-value, then this is a split/merger and needs special handling |
|
250 (cond |
|
251 |
|
252 ;; we have value and positive units, add units to basis |
|
253 ((and (not (gnc-numeric-zero-p b-value)) |
|
254 (gnc-numeric-positive-p b-units)) |
|
255 (case b-method |
|
256 ((average-basis) |
|
257 (if (not (eqv? b-list '())) |
|
258 (list (cons (gnc-numeric-add b-units |
|
259 (caar b-list) units-denom GNC-RND-ROUND) |
|
260 (gnc-numeric-div |
|
261 (gnc-numeric-add b-value |
|
262 (gnc-numeric-mul (caar b-list) |
|
263 (cdar b-list) |
|
264 GNC-DENOM-AUTO GNC-DENOM-REDUCE) |
|
265 GNC-DENOM-AUTO GNC-DENOM-REDUCE) |
|
266 (gnc-numeric-add b-units |
|
267 (caar b-list) GNC-DENOM-AUTO GNC-DENOM-REDUCE) |
|
268 price-denom GNC-RND-ROUND))) |
|
269 (append b-list |
|
270 (list (cons b-units (gnc-numeric-div |
|
271 b-value b-units price-denom GNC-RND-ROUND)))))) |
|
272 (else (append b-list |
|
273 (list (cons b-units (gnc-numeric-div |
|
274 b-value b-units price-denom GNC-RND-ROUND))))))) |
|
275 |
|
276 ;; we have value and negative units, remove units from basis |
|
277 ((and (not (gnc-numeric-zero-p b-value)) |
|
278 (gnc-numeric-negative-p b-units)) |
|
279 (if (not (eqv? b-list '())) |
|
280 (case b-method |
|
281 ((fifo-basis) |
|
282 (case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar b-list)) |
|
283 ((-1) |
|
284 ;; Sold less than the first lot, create a new first lot from the remainder |
|
285 (let ((new-units (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND))) |
|
286 (cons (cons new-units (cdar b-list)) (cdr b-list)))) |
|
287 ((0) |
|
288 ;; Sold all of the first lot |
|
289 (cdr b-list)) |
|
290 ((1) |
|
291 ;; Sold more than the first lot, delete it and recurse |
|
292 (basis-builder (cdr b-list) (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND) |
|
293 b-value ;; Only the sign of b-value matters since the new b-units is negative |
|
294 b-method currency-frac)))) |
|
295 ((filo-basis) |
|
296 (let ((rev-b-list (reverse b-list))) |
|
297 (case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar rev-b-list)) |
|
298 ((-1) |
|
299 ;; Sold less than the last lot |
|
300 (let ((new-units (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND))) |
|
301 (reverse (cons (cons new-units (cdar rev-b-list)) (cdr rev-b-list))))) |
|
302 ((0) |
|
303 ;; Sold all of the last lot |
|
304 (reverse (cdr rev-b-list)) |
|
305 ) |
|
306 ((1) |
|
307 ;; Sold more than the last lot |
|
308 (basis-builder (reverse (cdr rev-b-list)) (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND) |
|
309 b-value b-method currency-frac) |
|
310 )))) |
|
311 ((average-basis) |
|
312 (list (cons (gnc-numeric-add |
|
313 (caar b-list) b-units units-denom GNC-RND-ROUND) |
|
314 (cdar b-list))))) |
|
315 '() |
|
316 )) |
|
317 |
|
318 ;; no value, just units, this is a split/merge... |
|
319 ((and (gnc-numeric-zero-p b-value) |
|
320 (not (gnc-numeric-zero-p b-units))) |
|
321 (let* ((current-units (units-basis b-list)) |
|
322 (units-ratio (gnc-numeric-div (gnc-numeric-add b-units current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE) |
|
323 current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)) |
|
324 ;; If the units ratio is zero the stock is worthless and the value should be zero too |
|
325 (value-ratio (if (gnc-numeric-zero-p units-ratio) |
|
326 (gnc-numeric-zero) |
|
327 (gnc-numeric-div (gnc:make-gnc-numeric 1 1) units-ratio GNC-DENOM-AUTO GNC-DENOM-REDUCE)))) |
|
328 |
|
329 (gnc:debug "blist is " b-list " current units is " |
|
330 (gnc-numeric-to-string current-units) |
|
331 " value ratio is " (gnc-numeric-to-string value-ratio) |
|
332 " units ratio is " (gnc-numeric-to-string units-ratio)) |
|
333 (apply-basis-ratio b-list units-ratio value-ratio) |
|
334 )) |
|
335 |
|
336 ;; If there are no units, just a value, then its a spin-off, |
|
337 ;; calculate a ratio for the values, but leave the units alone |
|
338 ;; with a ratio of 1 |
|
339 ((and (gnc-numeric-zero-p b-units) |
|
340 (not (gnc-numeric-zero-p b-value))) |
|
341 (let* ((current-value (sum-basis b-list GNC-DENOM-AUTO)) |
|
342 (value-ratio (gnc-numeric-div (gnc-numeric-add b-value current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE) |
|
343 current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE))) |
|
344 |
|
345 (gnc:debug "this is a spinoff") |
|
346 (gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string value-ratio)) |
|
347 (apply-basis-ratio b-list (gnc:make-gnc-numeric 1 1) value-ratio)) |
|
348 ) |
|
349 |
|
350 ;; when all else fails, just send the b-list back |
|
351 (else |
|
352 b-list) |
|
353 ) |
|
354 ) |
|
355 |
|
356 ;; Given a price list and a currency find the price for that currency on the list. |
|
357 ;; If there is none for the requested currency, return the first one. |
|
358 ;; The price list is released but the price returned is ref counted. |
|
359 (define (find-price price-list currency) |
|
360 (if (eqv? price-list '()) #f |
|
361 (let ((price (car price-list))) |
|
362 (for-each |
|
363 (lambda (p) |
|
364 (if (gnc-commodity-equiv currency (gnc-price-get-currency p)) |
|
365 (set! price p))) |
|
366 price-list) |
|
367 (gnc-price-ref price) |
|
368 (gnc-price-list-destroy price-list) |
|
369 price))) |
|
370 |
|
371 ;; Return true if either account is the parent of the other or they are siblings |
|
372 (define (parent-or-sibling? a1 a2) |
|
373 (let ((a2parent (gnc-account-get-parent a2)) |
|
374 (a1parent (gnc-account-get-parent a1))) |
|
375 (or (same-account? a2parent a1) |
|
376 (same-account? a1parent a2) |
|
377 (same-account? a1parent a2parent)))) |
|
378 |
|
379 ;; Test whether the given split is the source of a spin off transaction |
|
380 ;; This will be a no-units split with only one other split. |
|
381 ;; xaccSplitGetOtherSplit only returns on a two-split txn. It's not a spinoff |
|
382 ;; is the other split is in an income or expense account. |
|
383 (define (spin-off? split current) |
|
384 (let ((other-split (xaccSplitGetOtherSplit split))) |
|
385 (and (gnc-numeric-zero-p (xaccSplitGetAmount split)) |
|
386 (same-account? current (xaccSplitGetAccount split)) |
|
387 (not (null? other-split)) |
|
388 (not (split-account-type? other-split ACCT-TYPE-EXPENSE)) |
|
389 (not (split-account-type? other-split ACCT-TYPE-INCOME))))) |
|
390 |
|
391 |
|
392 (define (table-add-stock-rows table accounts to-date |
|
393 currency price-fn exchange-fn price-source |
|
394 include-empty show-symbol show-listing show-shares show-price |
|
395 basis-method prefer-pricelist handle-brokerage-fees |
|
396 total-basis total-value |
|
397 total-moneyin total-moneyout total-income total-gain |
|
398 total-ugain total-brokerage) |
|
399 |
|
400 (let ((share-print-info |
|
401 (gnc-share-print-info-places |
|
402 (inexact->exact (get-option gnc:pagename-display |
|
403 optname-shares-digits))))) |
|
404 |
|
405 (define (table-add-stock-rows-internal accounts odd-row?) |
|
406 (if (null? accounts) total-value |
|
407 (let* ((row-style (if odd-row? "normal-row" "alternate-row")) |
|
408 (current (car accounts)) |
|
409 (rest (cdr accounts)) |
|
410 ;; commodity is the actual stock/thing we are looking at |
|
411 (commodity (xaccAccountGetCommodity current)) |
|
412 (ticker-symbol (gnc-commodity-get-mnemonic commodity)) |
|
413 (listing (gnc-commodity-get-namespace commodity)) |
|
414 (unit-collector (gnc:account-get-comm-balance-at-date |
|
415 current to-date #f)) |
|
416 (units (cadr (unit-collector 'getpair commodity #f))) |
|
417 |
|
418 ;; Counter to keep track of stuff |
|
419 (brokeragecoll (gnc:make-commodity-collector)) |
|
420 (dividendcoll (gnc:make-commodity-collector)) |
|
421 (moneyincoll (gnc:make-commodity-collector)) |
|
422 (moneyoutcoll (gnc:make-commodity-collector)) |
|
423 (gaincoll (gnc:make-commodity-collector)) |
|
424 |
|
425 |
|
426 ;; the price of the commodity at the time of the report |
|
427 (price (price-fn commodity currency to-date)) |
|
428 ;; the value of the commodity, expressed in terms of |
|
429 ;; the report's currency. |
|
430 (value (gnc:make-gnc-monetary currency (gnc-numeric-zero))) ;; Set later |
|
431 (currency-frac (gnc-commodity-get-fraction currency)) |
|
432 |
|
433 (pricing-txn #f) |
|
434 (use-txn #f) |
|
435 (basis-list '()) |
|
436 ;; setup an alist for the splits we've already seen. |
|
437 (seen_trans '()) |
|
438 ;; Account used to hold remainders from income reinvestments and |
|
439 ;; running total of amount moved there |
|
440 (drp-holding-account #f) |
|
441 (drp-holding-amount (gnc-numeric-zero)) |
|
442 ) |
|
443 |
|
444 (define (my-exchange-fn fromunits tocurrency) |
|
445 (if (and (gnc-commodity-equiv currency tocurrency) |
|
446 (gnc-commodity-equiv (gnc:gnc-monetary-commodity fromunits) commodity)) |
|
447 ;; Have a price for this commodity, but not necessarily in the report's |
|
448 ;; currency. Get the value in the commodity's currency and convert it to |
|
449 ;; report currency. |
|
450 (exchange-fn |
|
451 ;; This currency will usually be the same as tocurrency so the |
|
452 ;; call to exchange-fn below will do nothing |
|
453 (gnc:make-gnc-monetary |
|
454 (if use-txn |
|
455 (gnc:gnc-monetary-commodity price) |
|
456 (gnc-price-get-currency price)) |
|
457 (gnc-numeric-mul (gnc:gnc-monetary-amount fromunits) |
|
458 (if use-txn |
|
459 (gnc:gnc-monetary-amount price) |
|
460 (gnc-price-get-value price)) |
|
461 currency-frac GNC-RND-ROUND)) |
|
462 tocurrency) |
|
463 (exchange-fn fromunits tocurrency))) |
|
464 |
|
465 (gnc:debug "Starting account " (xaccAccountGetName current) ", initial price: " |
|
466 (if price |
|
467 (gnc-commodity-value->string |
|
468 (list (gnc-price-get-currency price) (gnc-price-get-value price))) |
|
469 #f)) |
|
470 |
|
471 ;; If we have a price that can't be converted to the report currency |
|
472 ;; don't use it |
|
473 (if (and price (gnc-numeric-zero-p (gnc:gnc-monetary-amount |
|
474 (exchange-fn |
|
475 (gnc:make-gnc-monetary |
|
476 (gnc-price-get-currency price) |
|
477 (gnc:make-gnc-numeric 100 1)) |
|
478 currency)))) |
|
479 (set! price #f)) |
|
480 |
|
481 ;; If we are told to use a pricing transaction, or if we don't have a price |
|
482 ;; from the price DB, find a good transaction to use. |
|
483 (if (and (not use-txn) |
|
484 (or (not price) (not prefer-pricelist))) |
|
485 (let ((split-list (reverse (gnc:get-match-commodity-splits-sorted |
|
486 (list current) |
|
487 (case price-source |
|
488 ((pricedb-latest) (gnc:get-today)) |
|
489 ((pricedb-nearest) to-date) |
|
490 (else (gnc:get-today))) ;; error, but don't crash |
|
491 #f)))) ;; Any currency |
|
492 ;; Find the first (most recent) one that can be converted to report currency |
|
493 (while (and (not use-txn) (not (eqv? split-list '()))) |
|
494 (let ((split (car split-list))) |
|
495 (if (and (not (gnc-numeric-zero-p (xaccSplitGetAmount split))) |
|
496 (not (gnc-numeric-zero-p (xaccSplitGetValue split)))) |
|
497 (let* ((trans (xaccSplitGetParent split)) |
|
498 (trans-currency (xaccTransGetCurrency trans)) |
|
499 (trans-price (exchange-fn (gnc:make-gnc-monetary |
|
500 trans-currency |
|
501 (xaccSplitGetSharePrice split)) |
|
502 currency))) |
|
503 (if (not (gnc-numeric-zero-p (gnc:gnc-monetary-amount trans-price))) |
|
504 ;; We can exchange the price from this transaction into the report currency |
|
505 (begin |
|
506 (if price (gnc-price-unref price)) |
|
507 (set! pricing-txn trans) |
|
508 (set! price trans-price) |
|
509 (gnc:debug "Transaction price is " (gnc:monetary->string price)) |
|
510 (set! use-txn #t)) |
|
511 (set! split-list (cdr split-list)))) |
|
512 (set! split-list (cdr split-list))) |
|
513 )))) |
|
514 |
|
515 ;; If we still don't have a price, use a price of 1 and complain later |
|
516 (if (not price) |
|
517 (begin |
|
518 (set! price (gnc:make-gnc-monetary currency (gnc:make-gnc-numeric 1 1))) |
|
519 ;; If use-txn is set, but pricing-txn isn't set, it's a bogus price |
|
520 (set! use-txn #t) |
|
521 (set! pricing-txn #f) |
|
522 ) |
|
523 ) |
|
524 |
|
525 ;; Now that we have a pricing transaction if needed, set the value of the asset |
|
526 (set! value (my-exchange-fn (gnc:make-gnc-monetary commodity units) currency)) |
|
527 (gnc:debug "Value " (gnc:monetary->string value) |
|
528 " from " (gnc-commodity-numeric->string commodity units)) |
|
529 |
|
530 (for-each |
|
531 ;; we're looking at each split we find in the account. these splits |
|
532 ;; could refer to the same transaction, so we have to examine each |
|
533 ;; split, determine what kind of split it is and then act accordingly. |
|
534 (lambda (split) |
|
535 (set! work-done (+ 1 work-done)) |
|
536 (gnc:report-percent-done (* 100 (/ work-done work-to-do))) |
|
537 |
|
538 (let* ((parent (xaccSplitGetParent split)) |
|
539 (txn-date (gnc-transaction-get-date-posted parent)) |
|
540 (commod-currency (xaccTransGetCurrency parent)) |
|
541 (commod-currency-frac (gnc-commodity-get-fraction commod-currency))) |
|
542 |
|
543 (if (and (gnc:timepair-le txn-date to-date) |
|
544 (not (assoc-ref seen_trans (gncTransGetGUID parent)))) |
|
545 (let ((trans-income (gnc-numeric-zero)) |
|
546 (trans-brokerage (gnc-numeric-zero)) |
|
547 (trans-shares (gnc-numeric-zero)) |
|
548 (shares-bought (gnc-numeric-zero)) |
|
549 (trans-sold (gnc-numeric-zero)) |
|
550 (trans-bought (gnc-numeric-zero)) |
|
551 (trans-spinoff (gnc-numeric-zero)) |
|
552 (trans-drp-residual (gnc-numeric-zero)) |
|
553 (trans-drp-account #f)) |
|
554 |
|
555 (gnc:debug "Transaction " (xaccTransGetDescription parent)) |
|
556 ;; Add this transaction to the list of processed transactions so we don't |
|
557 ;; do it again if there is another split in it for this account |
|
558 (set! seen_trans (acons (gncTransGetGUID parent) #t seen_trans)) |
|
559 |
|
560 ;; Go through all the splits in the transaction to get an overall idea of |
|
561 ;; what it does in terms of income, money in or out, shares bought or sold, etc. |
|
562 (for-each |
|
563 (lambda (s) |
|
564 (let ((split-units (xaccSplitGetAmount s)) |
|
565 (split-value (xaccSplitGetValue s))) |
|
566 |
|
567 (cond |
|
568 ((and |
|
569 (split-account-type? s ACCT-TYPE-EXPENSE) |
|
570 (same-account-code? current (xaccSplitGetAccount s))) |
|
571 ;; Brokerage expense unless a two split transaction with other split |
|
572 ;; in the stock account in which case it's a stock donation to charity. |
|
573 (gnc:debug "Pass 1: Expense: split units " (gnc-numeric-to-string split-units) " split-value " |
|
574 (gnc-numeric-to-string split-value) " commod-currency " |
|
575 (gnc-commodity-get-printname commod-currency)) |
|
576 (if (not (same-account? current (xaccSplitGetAccount (xaccSplitGetOtherSplit s)))) |
|
577 (set! trans-brokerage |
|
578 (gnc-numeric-add trans-brokerage split-value commod-currency-frac GNC-RND-ROUND)))) |
|
579 |
|
580 ((and |
|
581 (split-account-type? s ACCT-TYPE-INCOME) |
|
582 (same-account-code? current (xaccSplitGetAccount s))) |
|
583 (gnc:debug "Pass 1: Income: split units " (gnc-numeric-to-string split-units) " split-value " |
|
584 (gnc-numeric-to-string split-value) " commod-currency " |
|
585 (gnc-commodity-get-printname commod-currency)) |
|
586 (set! trans-income |
|
587 (gnc-numeric-sub trans-income split-value |
|
588 commod-currency-frac GNC-RND-ROUND))) |
|
589 |
|
590 ((same-account? current (xaccSplitGetAccount s)) |
|
591 (gnc:debug "Pass 1: Same Account: split units " (gnc-numeric-to-string split-units) " split-value " |
|
592 (gnc-numeric-to-string split-value) " commod-currency " |
|
593 (gnc-commodity-get-printname commod-currency)) |
|
594 (set! trans-shares (gnc-numeric-add trans-shares (gnc-numeric-abs split-units) |
|
595 units-denom GNC-RND-ROUND)) |
|
596 (if (gnc-numeric-zero-p split-units) |
|
597 (if (spin-off? s current) |
|
598 ;; Count money used in a spin off as money out |
|
599 (if (gnc-numeric-negative-p split-value) |
|
600 (set! trans-spinoff (gnc-numeric-sub trans-spinoff split-value |
|
601 commod-currency-frac GNC-RND-ROUND))) |
|
602 (if (not (gnc-numeric-zero-p split-value)) |
|
603 ;; Gain/loss split (amount zero, value non-zero, and not spinoff). There will be |
|
604 ;; a corresponding income split that will incorrectly be added to trans-income |
|
605 ;; Fix that by subtracting it here |
|
606 (set! trans-income (gnc-numeric-sub trans-income split-value |
|
607 commod-currency-frac GNC-RND-ROUND)))) |
|
608 ;; Non-zero amount, add the value to the sale or purchase total. |
|
609 (if (gnc-numeric-positive-p split-value) |
|
610 (begin |
|
611 (set! trans-bought |
|
612 (gnc-numeric-add trans-bought split-value commod-currency-frac GNC-RND-ROUND)) |
|
613 (set! shares-bought |
|
614 (gnc-numeric-add shares-bought split-units units-denom GNC-RND-ROUND))) |
|
615 (set! trans-sold |
|
616 (gnc-numeric-sub trans-sold split-value commod-currency-frac GNC-RND-ROUND))))) |
|
617 |
|
618 ((and |
|
619 (split-account-type? s ACCT-TYPE-ASSET) |
|
620 (same-account-code? current (xaccSplitGetAccount s))) |
|
621 (gnc:debug "Pass 1: Assets: split units " (gnc-numeric-to-string split-units) " split-value " |
|
622 (gnc-numeric-to-string split-value) " commod-currency " |
|
623 (gnc-commodity-get-printname commod-currency)) |
|
624 ;; If all the asset accounts mentioned in the transaction are siblings of each other |
|
625 ;; keep track of the money transfered to them if it is in the correct currency |
|
626 (if (not trans-drp-account) |
|
627 (begin |
|
628 (set! trans-drp-account (xaccSplitGetAccount s)) |
|
629 (if (gnc-commodity-equiv commod-currency (xaccAccountGetCommodity trans-drp-account)) |
|
630 (set! trans-drp-residual split-value) |
|
631 (set! trans-drp-account 'none))) |
|
632 (if (not (eq? trans-drp-account 'none)) |
|
633 (if (parent-or-sibling? trans-drp-account (xaccSplitGetAccount s)) |
|
634 (set! trans-drp-residual (gnc-numeric-add trans-drp-residual split-value |
|
635 commod-currency-frac GNC-RND-ROUND)) |
|
636 (set! trans-drp-account 'none)))))) |
|
637 )) |
|
638 (xaccTransGetSplitList parent) |
|
639 ) |
|
640 |
|
641 (gnc:debug "Income: " (gnc-numeric-to-string trans-income) |
|
642 " Brokerage: " (gnc-numeric-to-string trans-brokerage) |
|
643 " Shares traded: " (gnc-numeric-to-string trans-shares) |
|
644 " Shares bought: " (gnc-numeric-to-string shares-bought)) |
|
645 (gnc:debug " Value sold: " (gnc-numeric-to-string trans-sold) |
|
646 " Value purchased: " (gnc-numeric-to-string trans-bought) |
|
647 " Spinoff value " (gnc-numeric-to-string trans-spinoff) |
|
648 " Trans DRP residual: " (gnc-numeric-to-string trans-drp-residual)) |
|
649 |
|
650 ;; We need to calculate several things for this transaction: |
|
651 ;; 1. Total income: this is already in trans-income |
|
652 ;; 2. Change in basis: calculated by loop below that looks at every |
|
653 ;; that acquires or disposes of shares |
|
654 ;; 3. Realized gain: also calculated below while calculating basis |
|
655 ;; 4. Money in to the account: this is the value of shares bought |
|
656 ;; except those purchased with reinvested income |
|
657 ;; 5. Money out: the money received by disposing of shares. This |
|
658 ;; is in trans-sold plus trans-spinoff |
|
659 ;; 6. Brokerage fees: this is in trans-brokerage |
|
660 |
|
661 ;; Income |
|
662 (dividendcoll 'add commod-currency trans-income) |
|
663 |
|
664 ;; Brokerage fees. May be either ignored or part of basis, but that |
|
665 ;; will be dealt with elsewhere. |
|
666 (brokeragecoll 'add commod-currency trans-brokerage) |
|
667 |
|
668 ;; Add brokerage fees to trans-bought if not ignoring them and there are any |
|
669 (if (and (not (eq? handle-brokerage-fees 'ignore-brokerage)) |
|
670 (gnc-numeric-positive-p trans-brokerage) |
|
671 (gnc-numeric-positive-p trans-shares)) |
|
672 (let* ((fee-frac (gnc-numeric-div shares-bought trans-shares GNC-DENOM-AUTO GNC-DENOM-REDUCE)) |
|
673 (fees (gnc-numeric-mul trans-brokerage fee-frac commod-currency-frac GNC-RND-ROUND))) |
|
674 (set! trans-bought (gnc-numeric-add trans-bought fees commod-currency-frac GNC-RND-ROUND)))) |
|
675 |
|
676 ;; Update the running total of the money in the DRP residual account. This is relevant |
|
677 ;; if this is a reinvestment transaction (both income and purchase) and there seems to |
|
678 ;; asset accounts used to hold excess income. |
|
679 (if (and trans-drp-account |
|
680 (not (eq? trans-drp-account 'none)) |
|
681 (gnc-numeric-positive-p trans-income) |
|
682 (gnc-numeric-positive-p trans-bought)) |
|
683 (if (not drp-holding-account) |
|
684 (begin |
|
685 (set! drp-holding-account trans-drp-account) |
|
686 (set! drp-holding-amount trans-drp-residual)) |
|
687 (if (and (not (eq? drp-holding-account 'none)) |
|
688 (parent-or-sibling? trans-drp-account drp-holding-account)) |
|
689 (set! drp-holding-amount (gnc-numeric-add drp-holding-amount trans-drp-residual |
|
690 commod-currency-frac GNC-RND-ROUND)) |
|
691 (begin |
|
692 ;; Wrong account (or no account), assume there isn't a DRP holding account |
|
693 (set! drp-holding-account 'none) |
|
694 (set trans-drp-residual (gnc-numeric-zero)) |
|
695 (set! drp-holding-amount (gnc-numeric-zero)))))) |
|
696 |
|
697 ;; Set trans-bought to the amount of money moved in to the account which was used to |
|
698 ;; purchase more shares. If this is not a DRP transaction then all money used to purchase |
|
699 ;; shares is money in. |
|
700 (if (and (gnc-numeric-positive-p trans-income) |
|
701 (gnc-numeric-positive-p trans-bought)) |
|
702 (begin |
|
703 (set! trans-bought (gnc-numeric-sub trans-bought trans-income |
|
704 commod-currency-frac GNC-RND-ROUND)) |
|
705 (set! trans-bought (gnc-numeric-add trans-bought trans-drp-residual |
|
706 commod-currency-frac GNC-RND-ROUND)) |
|
707 (set! trans-bought (gnc-numeric-sub trans-bought drp-holding-amount |
|
708 commod-currency-frac GNC-RND-ROUND)) |
|
709 ;; If the DRP holding account balance is negative, adjust it by the amount |
|
710 ;; used in this transaction |
|
711 (if (and (gnc-numeric-negative-p drp-holding-amount) |
|
712 (gnc-numeric-positive-p trans-bought)) |
|
713 (set! drp-holding-amount (gnc-numeric-add drp-holding-amount trans-bought |
|
714 commod-currency-frac GNC-RND-ROUND))) |
|
715 ;; Money in is never more than amount spent to purchase shares |
|
716 (if (gnc-numeric-negative-p trans-bought) |
|
717 (set! trans-bought (gnc-numeric-zero))))) |
|
718 |
|
719 (gnc:debug "Adjusted trans-bought " (gnc-numeric-to-string trans-bought) |
|
720 " DRP holding account " (gnc-numeric-to-string drp-holding-amount)) |
|
721 |
|
722 (moneyincoll 'add commod-currency trans-bought) |
|
723 (moneyoutcoll 'add commod-currency trans-sold) |
|
724 (moneyoutcoll 'add commod-currency trans-spinoff) |
|
725 |
|
726 ;; Look at splits again to handle changes in basis and realized gains |
|
727 (for-each |
|
728 (lambda (s) |
|
729 (let |
|
730 ;; get the split's units and value |
|
731 ((split-units (xaccSplitGetAmount s)) |
|
732 (split-value (xaccSplitGetValue s))) |
|
733 |
|
734 (gnc:debug "Pass 2: split units " (gnc-numeric-to-string split-units) " split-value " |
|
735 (gnc-numeric-to-string split-value) " commod-currency " |
|
736 (gnc-commodity-get-printname commod-currency)) |
|
737 |
|
738 (cond |
|
739 ((and (not (gnc-numeric-zero-p split-units)) |
|
740 (same-account? current (xaccSplitGetAccount s))) |
|
741 ;; Split into subject account with non-zero amount. This is a purchase |
|
742 ;; or a sale, adjust the basis |
|
743 (let* ((split-value-currency (gnc:gnc-monetary-amount |
|
744 (my-exchange-fn (gnc:make-gnc-monetary |
|
745 commod-currency split-value) currency))) |
|
746 (orig-basis (sum-basis basis-list currency-frac)) |
|
747 ;; proportion of the fees attributable to this split |
|
748 (fee-ratio (gnc-numeric-div (gnc-numeric-abs split-units) trans-shares |
|
749 GNC-DENOM-AUTO GNC-DENOM-REDUCE)) |
|
750 ;; Fees for this split in report currency |
|
751 (fees-currency (gnc:gnc-monetary-amount (my-exchange-fn |
|
752 (gnc:make-gnc-monetary commod-currency |
|
753 (gnc-numeric-mul fee-ratio trans-brokerage |
|
754 commod-currency-frac GNC-RND-ROUND)) |
|
755 currency))) |
|
756 (split-value-with-fees (if (eq? handle-brokerage-fees 'include-in-basis) |
|
757 ;; Include brokerage fees in basis |
|
758 (gnc-numeric-add split-value-currency fees-currency |
|
759 currency-frac GNC-RND-ROUND) |
|
760 split-value-currency))) |
|
761 (gnc:debug "going in to basis list " basis-list " " (gnc-numeric-to-string split-units) " " |
|
762 (gnc-numeric-to-string split-value-with-fees)) |
|
763 |
|
764 ;; adjust the basis |
|
765 (set! basis-list (basis-builder basis-list split-units split-value-with-fees |
|
766 basis-method currency-frac)) |
|
767 (gnc:debug "coming out of basis list " basis-list) |
|
768 |
|
769 ;; If it's a sale or the stock is worthless, calculate the gain |
|
770 (if (not (gnc-numeric-positive-p split-value)) |
|
771 ;; Split value is zero or negative. If it's zero it's either a stock split/merge |
|
772 ;; or the stock has become worthless (which looks like a merge where the number |
|
773 ;; of shares goes to zero). If the value is negative then it's a disposal of some sort. |
|
774 (let ((new-basis (sum-basis basis-list currency-frac))) |
|
775 (if (or (gnc-numeric-zero-p new-basis) |
|
776 (gnc-numeric-negative-p split-value)) |
|
777 ;; Split value is negative or new basis is zero (stock is worthless), |
|
778 ;; Capital gain is money out minus change in basis |
|
779 (let ((gain (gnc-numeric-sub (gnc-numeric-abs split-value-with-fees) |
|
780 (gnc-numeric-sub orig-basis new-basis |
|
781 currency-frac GNC-RND-ROUND) |
|
782 currency-frac GNC-RND-ROUND))) |
|
783 (gnc:debug "Old basis=" (gnc-numeric-to-string orig-basis) |
|
784 " New basis=" (gnc-numeric-to-string new-basis) |
|
785 " Gain=" (gnc-numeric-to-string gain)) |
|
786 (gaincoll 'add currency gain))))))) |
|
787 |
|
788 ;; here is where we handle a spin-off txn. This will be a no-units |
|
789 ;; split with only one other split. xaccSplitGetOtherSplit only |
|
790 ;; returns on a two-split txn. It's not a spinoff is the other split is |
|
791 ;; in an income or expense account. |
|
792 ((spin-off? s current) |
|
793 (gnc:debug "before spin-off basis list " basis-list) |
|
794 (set! basis-list (basis-builder basis-list split-units (gnc:gnc-monetary-amount |
|
795 (my-exchange-fn (gnc:make-gnc-monetary |
|
796 commod-currency split-value) |
|
797 currency)) |
|
798 basis-method |
|
799 currency-frac)) |
|
800 (gnc:debug "after spin-off basis list " basis-list)) |
|
801 ) |
|
802 )) |
|
803 (xaccTransGetSplitList parent) |
|
804 ) |
|
805 ) |
|
806 ) |
|
807 ) |
|
808 ) |
|
809 (xaccAccountGetSplitList current) |
|
810 ) |
|
811 |
|
812 ;; Look for income and expense transactions that don't have a split in the |
|
813 ;; the account we're processing. We do this as follow |
|
814 ;; 1. Make sure the parent account is a currency-valued asset or bank account |
|
815 ;; 2. If so go through all the splits in that account |
|
816 ;; 3. If a split is part of a two split transaction where the other split is |
|
817 ;; to an income or expense account and the leaf name of that account is the |
|
818 ;; same as the leaf name of the account we're processing, add it to the |
|
819 ;; income or expense accumulator |
|
820 ;; |
|
821 ;; In other words with an account structure like |
|
822 ;; |
|
823 ;; Assets (type ASSET) |
|
824 ;; Broker (type ASSET) |
|
825 ;; Widget Stock (type STOCK) |
|
826 ;; Income (type INCOME) |
|
827 ;; Dividends (type INCOME) |
|
828 ;; Widget Stock (type INCOME) |
|
829 ;; |
|
830 ;; If you are producing a report on "Assets:Broker:Widget Stock" a |
|
831 ;; transaction that debits the Assets:Broker account and credits the |
|
832 ;; "Income:Dividends:Widget Stock" account will count as income in |
|
833 ;; the report even though it doesn't have a split in the account |
|
834 ;; being reported on. |
|
835 |
|
836 (let ((parent-account (gnc-account-get-parent current)) |
|
837 (account-name (xaccAccountGetName current))) |
|
838 (if (and (not (null? parent-account)) |
|
839 (member (xaccAccountGetType parent-account) (list ACCT-TYPE-ASSET ACCT-TYPE-BANK)) |
|
840 (gnc-commodity-is-currency (xaccAccountGetCommodity parent-account))) |
|
841 (for-each |
|
842 (lambda (split) |
|
843 (let* ((other-split (xaccSplitGetOtherSplit split)) |
|
844 ;; This is safe because xaccSplitGetAccount returns null for a null split |
|
845 (other-acct (xaccSplitGetAccount other-split)) |
|
846 (parent (xaccSplitGetParent split)) |
|
847 (txn-date (gnc-transaction-get-date-posted parent))) |
|
848 (if (and (not (null? other-acct)) |
|
849 (gnc:timepair-le txn-date to-date) |
|
850 (string=? (xaccAccountGetName other-acct) account-name) |
|
851 (gnc-commodity-is-currency (xaccAccountGetCommodity other-acct))) |
|
852 ;; This is a two split transaction where the other split is to an |
|
853 ;; account with the same name as the current account. If it's an |
|
854 ;; income or expense account accumulate the value of the transaction |
|
855 (let ((val (xaccSplitGetValue split)) |
|
856 (curr (xaccAccountGetCommodity other-acct))) |
|
857 (cond ((split-account-type? other-split ACCT-TYPE-INCOME) |
|
858 (gnc:debug "More income " (gnc-numeric-to-string val)) |
|
859 (dividendcoll 'add curr val)) |
|
860 ((split-account-type? other-split ACCT-TYPE-EXPENSE) |
|
861 (gnc:debug "More expense " (gnc-numeric-to-string |
|
862 (gnc-numeric-neg val))) |
|
863 (brokeragecoll 'add curr (gnc-numeric-neg val))) |
|
864 ) |
|
865 ) |
|
866 ) |
|
867 ) |
|
868 ) |
|
869 (xaccAccountGetSplitList parent-account) |
|
870 ) |
|
871 ) |
|
872 ) |
|
873 |
|
874 (gnc:debug "pricing txn is " pricing-txn) |
|
875 (gnc:debug "use txn is " use-txn) |
|
876 (gnc:debug "prefer-pricelist is " prefer-pricelist) |
|
877 (gnc:debug "price is " price) |
|
878 |
|
879 (gnc:debug "basis we're using to build rows is " (gnc-numeric-to-string (sum-basis basis-list |
|
880 currency-frac))) |
|
881 (gnc:debug "but the actual basis list is " basis-list) |
|
882 |
|
883 (if (eq? handle-brokerage-fees 'include-in-gain) |
|
884 (gaincoll 'minusmerge brokeragecoll #f)) |
|
885 |
|
886 (if (or include-empty (not (gnc-numeric-zero-p units))) |
|
887 (let* ((moneyin (gnc:sum-collector-commodity moneyincoll currency my-exchange-fn)) |
|
888 (moneyout (gnc:sum-collector-commodity moneyoutcoll currency my-exchange-fn)) |
|
889 (brokerage (gnc:sum-collector-commodity brokeragecoll currency my-exchange-fn)) |
|
890 (income (gnc:sum-collector-commodity dividendcoll currency my-exchange-fn)) |
|
891 ;; just so you know, gain == realized gain, ugain == un-realized gain, bothgain, well.. |
|
892 (gain (gnc:sum-collector-commodity gaincoll currency my-exchange-fn)) |
|
893 (ugain (gnc:make-gnc-monetary currency |
|
894 (gnc-numeric-sub (gnc:gnc-monetary-amount (my-exchange-fn value currency)) |
|
895 (sum-basis basis-list (gnc-commodity-get-fraction currency)) |
|
896 currency-frac GNC-RND-ROUND))) |
|
897 (bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount gain) |
|
898 (gnc:gnc-monetary-amount ugain) |
|
899 currency-frac GNC-RND-ROUND))) |
|
900 (totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount bothgain) |
|
901 (gnc:gnc-monetary-amount income) |
|
902 currency-frac GNC-RND-ROUND))) |
|
903 |
|
904 (activecols (list (gnc:html-account-anchor current))) |
|
905 ) |
|
906 |
|
907 ;; If we're using the txn, warn the user |
|
908 (if use-txn |
|
909 (if pricing-txn |
|
910 (set! warn-price-dirty #t) |
|
911 (set! warn-no-price #t) |
|
912 )) |
|
913 |
|
914 (total-value 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value)) |
|
915 (total-moneyin 'merge moneyincoll #f) |
|
916 (total-moneyout 'merge moneyoutcoll #f) |
|
917 (total-brokerage 'merge brokeragecoll #f) |
|
918 (total-income 'merge dividendcoll #f) |
|
919 (total-gain 'merge gaincoll #f) |
|
920 (total-ugain 'add (gnc:gnc-monetary-commodity ugain) (gnc:gnc-monetary-amount ugain)) |
|
921 (total-basis 'add currency (sum-basis basis-list currency-frac)) |
|
922 |
|
923 ;; build a list for the row based on user selections |
|
924 (if show-symbol (append! activecols (list (gnc:make-html-table-header-cell/markup "text-cell" ticker-symbol)))) |
|
925 (if show-listing (append! activecols (list (gnc:make-html-table-header-cell/markup "text-cell" listing)))) |
|
926 (if show-shares (append! activecols (list (gnc:make-html-table-header-cell/markup |
|
927 "number-cell" (xaccPrintAmount units share-print-info))))) |
|
928 (if show-price (append! activecols (list (gnc:make-html-table-header-cell/markup |
|
929 "number-cell" |
|
930 (if use-txn |
|
931 (if pricing-txn |
|
932 (gnc:html-transaction-anchor |
|
933 pricing-txn |
|
934 price |
|
935 ) |
|
936 price |
|
937 ) |
|
938 (gnc:html-price-anchor |
|
939 price |
|
940 (gnc:make-gnc-monetary |
|
941 (gnc-price-get-currency price) |
|
942 (gnc-price-get-value price))) |
|
943 ))))) |
|
944 (append! activecols (list (if use-txn (if pricing-txn "*" "**") " ") |
|
945 (gnc:make-html-table-header-cell/markup |
|
946 "number-cell" (gnc:make-gnc-monetary currency (sum-basis basis-list |
|
947 currency-frac))) |
|
948 (gnc:make-html-table-header-cell/markup "number-cell" value) |
|
949 (gnc:make-html-table-header-cell/markup "number-cell" moneyin) |
|
950 (gnc:make-html-table-header-cell/markup "number-cell" moneyout) |
|
951 (gnc:make-html-table-header-cell/markup "number-cell" gain) |
|
952 (gnc:make-html-table-header-cell/markup "number-cell" ugain) |
|
953 (gnc:make-html-table-header-cell/markup "number-cell" bothgain) |
|
954 (gnc:make-html-table-header-cell/markup "number-cell" |
|
955 (let* ((moneyinvalue (gnc-numeric-to-double |
|
956 (gnc:gnc-monetary-amount moneyin))) |
|
957 (bothgainvalue (gnc-numeric-to-double |
|
958 (gnc:gnc-monetary-amount bothgain))) |
|
959 ) |
|
960 (if (= 0.0 moneyinvalue) |
|
961 "" |
|
962 (sprintf #f "%.2f%%" (* 100 (/ bothgainvalue moneyinvalue))))) |
|
963 ) |
|
964 (gnc:make-html-table-header-cell/markup "number-cell" income))) |
|
965 (if (not (eq? handle-brokerage-fees 'ignore-brokerage)) |
|
966 (append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" brokerage)))) |
|
967 (append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" totalreturn) |
|
968 (gnc:make-html-table-header-cell/markup "number-cell" |
|
969 (let* ((moneyinvalue (gnc-numeric-to-double |
|
970 (gnc:gnc-monetary-amount moneyin))) |
|
971 (totalreturnvalue (gnc-numeric-to-double |
|
972 (gnc:gnc-monetary-amount totalreturn))) |
|
973 ) |
|
974 (if (= 0.0 moneyinvalue) |
|
975 "" |
|
976 (sprintf #f "%.2f%%" (* 100 (/ totalreturnvalue moneyinvalue)))))) |
|
977 ) |
|
978 ) |
|
979 |
|
980 (gnc:html-table-append-row/markup! |
|
981 table |
|
982 row-style |
|
983 activecols) |
|
984 |
|
985 (if (and (not use-txn) price) (gnc-price-unref price)) |
|
986 (table-add-stock-rows-internal rest (not odd-row?)) |
|
987 ) |
|
988 (begin |
|
989 (if (and (not use-txn) price) (gnc-price-unref price)) |
|
990 (table-add-stock-rows-internal rest odd-row?) |
|
991 ) |
|
992 ) |
|
993 ))) |
|
994 |
|
995 (set! work-to-do (gnc:accounts-count-splits accounts)) |
|
996 (table-add-stock-rows-internal accounts #t))) |
|
997 |
|
998 ;; Tell the user that we're starting. |
|
999 (gnc:report-starting reportname) |
|
1000 |
|
1001 ;; The first thing we do is make local variables for all the specific |
|
1002 ;; options in the set of options given to the function. This set will |
|
1003 ;; be generated by the options generator above. |
|
1004 (let ((to-date (gnc:date-option-absolute-time |
|
1005 (get-option gnc:pagename-general "Date"))) |
|
1006 (accounts (get-option gnc:pagename-accounts "Accounts")) |
|
1007 (currency (get-option gnc:pagename-general "Report's currency")) |
|
1008 (price-source (get-option gnc:pagename-general |
|
1009 optname-price-source)) |
|
1010 (report-title (get-option gnc:pagename-general |
|
1011 gnc:optname-reportname)) |
|
1012 (include-empty (get-option gnc:pagename-accounts |
|
1013 optname-zero-shares)) |
|
1014 (show-symbol (get-option gnc:pagename-display |
|
1015 optname-show-symbol)) |
|
1016 (show-listing (get-option gnc:pagename-display |
|
1017 optname-show-listing)) |
|
1018 (show-shares (get-option gnc:pagename-display |
|
1019 optname-show-shares)) |
|
1020 (show-price (get-option gnc:pagename-display |
|
1021 optname-show-price)) |
|
1022 (basis-method (get-option gnc:pagename-general |
|
1023 optname-basis-method)) |
|
1024 (prefer-pricelist (get-option gnc:pagename-general |
|
1025 optname-prefer-pricelist)) |
|
1026 (handle-brokerage-fees (get-option gnc:pagename-general |
|
1027 optname-brokerage-fees)) |
|
1028 |
|
1029 (total-basis (gnc:make-commodity-collector)) |
|
1030 (total-value (gnc:make-commodity-collector)) |
|
1031 (total-moneyin (gnc:make-commodity-collector)) |
|
1032 (total-moneyout (gnc:make-commodity-collector)) |
|
1033 (total-income (gnc:make-commodity-collector)) |
|
1034 (total-gain (gnc:make-commodity-collector)) ;; realized gain |
|
1035 (total-ugain (gnc:make-commodity-collector)) ;; unrealized gain |
|
1036 (total-brokerage (gnc:make-commodity-collector)) |
|
1037 ;;document will be the HTML document that we return. |
|
1038 (table (gnc:make-html-table)) |
|
1039 (document (gnc:make-html-document))) |
|
1040 |
|
1041 (gnc:html-document-set-title! |
|
1042 document (string-append |
|
1043 report-title |
|
1044 (sprintf #f " %s" (gnc-print-date to-date)))) |
|
1045 |
|
1046 (if (not (null? accounts)) |
|
1047 ; at least 1 account selected |
|
1048 (let* ((exchange-fn (gnc:case-exchange-fn price-source currency to-date)) |
|
1049 (pricedb (gnc-pricedb-get-db (gnc-get-current-book))) |
|
1050 (price-fn |
|
1051 (case price-source |
|
1052 ((pricedb-latest) |
|
1053 (lambda (foreign domestic date) |
|
1054 (find-price (gnc-pricedb-lookup-latest-any-currency pricedb foreign) |
|
1055 domestic))) |
|
1056 ((pricedb-nearest) |
|
1057 (lambda (foreign domestic date) |
|
1058 (find-price (gnc-pricedb-lookup-nearest-in-time-any-currency |
|
1059 pricedb foreign (timespecCanonicalDayTime date)) domestic))))) |
|
1060 (headercols (list (_ "Account"))) |
|
1061 (totalscols (list (gnc:make-html-table-cell/markup "total-label-cell" (_ "Total")))) |
|
1062 (sum-total-moneyin (gnc-numeric-zero)) |
|
1063 (sum-total-income (gnc-numeric-zero)) |
|
1064 (sum-total-both-gains (gnc-numeric-zero)) |
|
1065 (sum-total-gain (gnc-numeric-zero)) |
|
1066 (sum-total-ugain (gnc-numeric-zero)) |
|
1067 (sum-total-brokerage (gnc-numeric-zero)) |
|
1068 (sum-total-totalreturn (gnc-numeric-zero))) |
|
1069 |
|
1070 ;;begin building lists for which columns to display |
|
1071 (if show-symbol |
|
1072 (begin (append! headercols (list (_ "Symbol"))) |
|
1073 (append! totalscols (list " ")))) |
|
1074 |
|
1075 (if show-listing |
|
1076 (begin (append! headercols (list (_ "Listing"))) |
|
1077 (append! totalscols (list " ")))) |
|
1078 |
|
1079 (if show-shares |
|
1080 (begin (append! headercols (list (_ "Shares"))) |
|
1081 (append! totalscols (list " ")))) |
|
1082 |
|
1083 (if show-price |
|
1084 (begin (append! headercols (list (_ "Price"))) |
|
1085 (append! totalscols (list " ")))) |
|
1086 |
|
1087 (append! headercols (list " " |
|
1088 (_ "Basis") |
|
1089 (_ "Value") |
|
1090 (_ "Money In") |
|
1091 (_ "Money Out") |
|
1092 (_ "Realized Gain") |
|
1093 (_ "Unrealized Gain") |
|
1094 (_ "Total Gain") |
|
1095 (_ "Rate of Gain") |
|
1096 (_ "Income"))) |
|
1097 |
|
1098 (if (not (eq? handle-brokerage-fees 'ignore-brokerage)) |
|
1099 (append! headercols (list (_ "Brokerage Fees")))) |
|
1100 |
|
1101 (append! headercols (list (_ "Total Return") |
|
1102 (_ "Rate of Return"))) |
|
1103 |
|
1104 (append! totalscols (list " ")) |
|
1105 |
|
1106 (gnc:html-table-set-col-headers! |
|
1107 table |
|
1108 headercols) |
|
1109 |
|
1110 (table-add-stock-rows |
|
1111 table accounts to-date currency price-fn exchange-fn price-source |
|
1112 include-empty show-symbol show-listing show-shares show-price basis-method |
|
1113 prefer-pricelist handle-brokerage-fees |
|
1114 total-basis total-value total-moneyin total-moneyout |
|
1115 total-income total-gain total-ugain total-brokerage) |
|
1116 |
|
1117 |
|
1118 (set! sum-total-moneyin (gnc:sum-collector-commodity total-moneyin currency exchange-fn)) |
|
1119 (set! sum-total-income (gnc:sum-collector-commodity total-income currency exchange-fn)) |
|
1120 (set! sum-total-gain (gnc:sum-collector-commodity total-gain currency exchange-fn)) |
|
1121 (set! sum-total-ugain (gnc:sum-collector-commodity total-ugain currency exchange-fn)) |
|
1122 (set! sum-total-both-gains (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount sum-total-gain) |
|
1123 (gnc:gnc-monetary-amount sum-total-ugain) |
|
1124 (gnc-commodity-get-fraction currency) GNC-RND-ROUND))) |
|
1125 (set! sum-total-brokerage (gnc:sum-collector-commodity total-brokerage currency exchange-fn)) |
|
1126 (set! sum-total-totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount sum-total-both-gains) |
|
1127 (gnc:gnc-monetary-amount sum-total-income) |
|
1128 (gnc-commodity-get-fraction currency) GNC-RND-ROUND))) |
|
1129 |
|
1130 (gnc:html-table-append-row/markup! |
|
1131 table |
|
1132 "grand-total" |
|
1133 (list |
|
1134 (gnc:make-html-table-cell/size |
|
1135 1 17 (gnc:make-html-text (gnc:html-markup-hr))))) |
|
1136 |
|
1137 ;; finish building the totals columns, now that totals are complete |
|
1138 (append! totalscols (list |
|
1139 (gnc:make-html-table-cell/markup |
|
1140 "total-number-cell" (gnc:sum-collector-commodity total-basis currency exchange-fn)) |
|
1141 (gnc:make-html-table-cell/markup |
|
1142 "total-number-cell" (gnc:sum-collector-commodity total-value currency exchange-fn)) |
|
1143 (gnc:make-html-table-cell/markup |
|
1144 "total-number-cell" sum-total-moneyin) |
|
1145 (gnc:make-html-table-cell/markup |
|
1146 "total-number-cell" (gnc:sum-collector-commodity total-moneyout currency exchange-fn)) |
|
1147 (gnc:make-html-table-cell/markup |
|
1148 "total-number-cell" sum-total-gain) |
|
1149 (gnc:make-html-table-cell/markup |
|
1150 "total-number-cell" sum-total-ugain) |
|
1151 (gnc:make-html-table-cell/markup |
|
1152 "total-number-cell" sum-total-both-gains) |
|
1153 (gnc:make-html-table-cell/markup |
|
1154 "total-number-cell" |
|
1155 (let* ((totalinvalue (gnc-numeric-to-double |
|
1156 (gnc:gnc-monetary-amount sum-total-moneyin))) |
|
1157 (totalgainvalue (gnc-numeric-to-double |
|
1158 (gnc:gnc-monetary-amount sum-total-both-gains))) |
|
1159 ) |
|
1160 (if (= 0.0 totalinvalue) |
|
1161 "" |
|
1162 (sprintf #f "%.2f%%" (* 100 (/ totalgainvalue totalinvalue)))))) |
|
1163 (gnc:make-html-table-cell/markup |
|
1164 "total-number-cell" sum-total-income))) |
|
1165 (if (not (eq? handle-brokerage-fees 'ignore-brokerage)) |
|
1166 (append! totalscols (list |
|
1167 (gnc:make-html-table-cell/markup |
|
1168 "total-number-cell" sum-total-brokerage)))) |
|
1169 (append! totalscols (list |
|
1170 (gnc:make-html-table-cell/markup |
|
1171 "total-number-cell" sum-total-totalreturn) |
|
1172 (gnc:make-html-table-cell/markup |
|
1173 "total-number-cell" |
|
1174 (let* ((totalinvalue (gnc-numeric-to-double |
|
1175 (gnc:gnc-monetary-amount sum-total-moneyin))) |
|
1176 (totalreturnvalue (gnc-numeric-to-double |
|
1177 (gnc:gnc-monetary-amount sum-total-totalreturn))) |
|
1178 ) |
|
1179 (if (= 0.0 totalinvalue) |
|
1180 "" |
|
1181 (sprintf #f "%.2f%%" (* 100 (/ totalreturnvalue totalinvalue)))))) |
|
1182 )) |
|
1183 |
|
1184 |
|
1185 (gnc:html-table-append-row/markup! |
|
1186 table |
|
1187 "grand-total" |
|
1188 totalscols |
|
1189 ) |
|
1190 |
|
1191 (gnc:html-document-add-object! document table) |
|
1192 (if warn-price-dirty |
|
1193 (gnc:html-document-append-objects! document |
|
1194 (list (gnc:make-html-text (_ "* this commodity data was built using transaction pricing instead of the price list.")) |
|
1195 (gnc:make-html-text (gnc:html-markup-br)) |
|
1196 (gnc:make-html-text (_ "If you are in a multi-currency situation, the exchanges may not be correct."))))) |
|
1197 |
|
1198 (if warn-no-price |
|
1199 (gnc:html-document-append-objects! document |
|
1200 (list (gnc:make-html-text (if warn-price-dirty (gnc:html-markup-br) "")) |
|
1201 (gnc:make-html-text (_ "** this commodity has no price and a price of 1 has been used."))))) |
|
1202 ) |
|
1203 |
|
1204 ;if no accounts selected. |
|
1205 (gnc:html-document-add-object! |
|
1206 document |
|
1207 (gnc:html-make-no-account-warning |
|
1208 report-title (gnc:report-id report-obj)))) |
|
1209 |
|
1210 (gnc:report-finished) |
|
1211 document))) |
|
1212 |
|
1213 (gnc:define-report |
|
1214 'version 1 |
|
1215 'report-guid "2d82e4152af845f2be434f71f8535b85" |
|
1216 'name reportname |
|
1217 'menu-path (list gnc:menuname-asset-liability) |
|
1218 'options-generator options-generator |
|
1219 'renderer advanced-portfolio-renderer) |