;; -*-scheme-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; advanced-portfolio.scm ;; by Martijn van Oosterhout (kleptog@svana.org) Feb 2002 ;; ;; Heavily based on portfolio.scm ;; by Robert Merkel (rgmerk@mira.net) ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as ;; published by the Free Software Foundation; either version 2 of ;; the License, or (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, contact: ;; ;; Free Software Foundation Voice: +1-617-542-5942 ;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652 ;; Boston, MA 02111-1307, USA gnu@gnu.org ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; depends must be outside module scope -- and should eventually go away. (gnc:depend "report-html.scm") (define-module (gnucash report advanced-portfolio)) (use-modules (srfi srfi-1)) (use-modules (ice-9 slib)) (require 'printf) (define optname-price-source (N_ "Price Source")) (define (options-generator) (let* ((options (gnc:new-options)) ;; This is just a helper function for making options. ;; See gnucash/src/scm/options.scm for details. (add-option (lambda (new-option) (gnc:register-option options new-option)))) ;; General Tab ;; date at which to report balance (gnc:options-add-report-date! options gnc:pagename-general (N_ "Date") "a") (gnc:options-add-currency! options gnc:pagename-general (N_ "Report Currency") "c") (gnc:options-add-price-source! options gnc:pagename-general optname-price-source "d" 'pricedb-latest) ;; Account tab (add-option (gnc:make-account-list-option gnc:pagename-accounts (N_ "Accounts") "b" (N_ "Stock Accounts to report on") (lambda () (filter gnc:account-is-stock? (gnc:group-get-subaccounts (gnc:get-current-group)))) (lambda (accounts) (list #t (filter gnc:account-is-stock? accounts))) #t)) (gnc:options-set-default-section options gnc:pagename-general) options)) ;; This is the rendering function. It accepts a database of options ;; and generates an object of type . See the file ;; report-html.txt for documentation; the file report-html.scm ;; includes all the relevant Scheme code. The option database passed ;; to the function is one created by the options-generator function ;; defined above. (define (advanced-portfolio-renderer report-obj) ;; These are some helper functions for looking up option values. (define (get-op section name) (gnc:lookup-option (gnc:report-options report-obj) section name)) (define (get-option section name) (gnc:option-value (get-op section name))) (define (split-account-type? split type) (eq? type (gw:enum--val->sym (gnc:account-get-type (gnc:split-get-account split)) #f))) (define (same-split? s1 s2) (string=? (gnc:split-get-guid s1) (gnc:split-get-guid s2))) (define (table-add-stock-rows table accounts to-date currency price-fn total-moneyin total-dividends total-brokerage total-value total-moneyout) (define (table-add-stock-rows-internal accounts odd-row?) (if (null? accounts) () (let* ((row-style (if odd-row? "normal-row" "alternate-row")) (current (car accounts)) (rest (cdr accounts)) (name (gnc:account-get-name current)) (commodity (gnc:account-get-commodity current)) (ticker-symbol (gnc:commodity-get-mnemonic commodity)) (listing (gnc:commodity-get-namespace commodity)) ;; (unit-collector (gnc:account-get-comm-balance-at-date ;; current to-date #f)) ;; (units (cadr (unit-collector 'getpair commodity #f))) (totalunits 0.0) (totalunityears 0.0) ;; Counter to keep track of stuff (moneyin (gnc:make-commodity-collector)) (brokerage (gnc:make-commodity-collector)) (dividend (gnc:make-commodity-collector)) (units (gnc:make-commodity-collector)) (moneyout (gnc:make-commodity-collector)) ) ;; Note: Currently doesn't handle empty accounts: (gnc:account-get-split-list) returns #f ;; Also does not handle multiple currencies (gnc:sum-collector-commodity) (for-each (lambda (split) (let ((parent (gnc:split-get-parent split))) (for-each (lambda (s) (cond ((same-split? s split) (units 'add commodity (gnc:split-get-amount s)) ;; Is the stock transaction? (gnc:debug "amount" (gnc:numeric-to-double (gnc:split-get-amount s)) ) (if (< 0 (gnc:numeric-to-double (gnc:split-get-amount s))) (set! totalunits (+ totalunits (gnc:numeric-to-double (gnc:split-get-amount s))))) (gnc:debug "time" (current-time) "" (car (gnc:transaction-get-date-entered parent))) (set! totalunityears (+ totalunityears (* (gnc:numeric-to-double (gnc:split-get-amount s)) (gnc:date-year-delta (car (gnc:transaction-get-date-posted parent)) (current-time))))) ) ((split-account-type? s 'expense) (brokerage 'add currency (gnc:split-get-value s))) ((split-account-type? s 'income) (dividend 'add currency (gnc:split-get-value s))) ((gnc:numeric-negative-p (gnc:split-get-value s)) (moneyin 'add currency (gnc:split-get-value s))) (else (moneyout 'add currency (gnc:split-get-value s)))) ) (gnc:transaction-get-splits parent) ) ) ) (gnc:glist->list (gnc:account-get-split-list current) ) ) (gnc:debug "totalunits" totalunits) (gnc:debug "totalunityears" totalunityears) (let* ((price-value (price-fn commodity currency to-date)) (value-num (gnc:numeric-mul (cadr (units 'getpair commodity #f)) price-value (gnc:commodity-get-fraction currency) GNC-RND-ROUND)) (value (gnc:make-gnc-monetary currency value-num)) (gain (gnc:make-commodity-collector))) (gain 'merge moneyout #f) (gain 'add currency value-num) (gain 'merge moneyin #f) (total-value 'add currency value-num) (total-moneyin 'merge moneyin #f) (total-dividends 'merge dividend #f) (total-brokerage 'merge brokerage #f) (total-moneyout 'merge moneyout #f) (gnc:html-table-append-row/markup! table row-style (list name ticker-symbol listing (gnc:make-html-table-header-cell/markup "number-cell" (gnc:numeric-to-double (cadr (moneyin 'getpair currency #t)))) (gnc:make-html-table-header-cell/markup "number-cell" (gnc:numeric-to-double (cadr (brokerage 'getpair currency #f)))) (gnc:make-html-table-header-cell/markup "number-cell" (gnc:numeric-to-double (cadr (dividend 'getpair currency #t)))) (gnc:make-html-table-header-cell/markup "number-cell" (gnc:numeric-to-double (cadr (units 'getpair commodity #f)))) (gnc:make-html-table-header-cell/markup "number-cell" (gnc:numeric-to-double value-num)) (gnc:make-html-table-header-cell/markup "number-cell" (gnc:numeric-to-double (cadr (moneyout 'getpair currency #f)))) (gnc:make-html-table-header-cell/markup "number-cell" (gnc:numeric-to-double (cadr (gain 'getpair currency #f)))) (gnc:make-html-table-header-cell/markup "number-cell" (sprintf #f "%.2f%%" (* 100 (/ (gnc:numeric-to-double (cadr (gain 'getpair currency #f))) (gnc:numeric-to-double (cadr (moneyin 'getpair currency #t))))))) (gnc:make-html-table-header-cell/markup "number-cell" (sprintf #f "%.0f" (* 365 (/ totalunityears totalunits)))) )) (table-add-stock-rows-internal rest (not odd-row?)))))) (table-add-stock-rows-internal accounts #t)) ;; The first thing we do is make local variables for all the specific ;; options in the set of options given to the function. This set will ;; be generated by the options generator above. (let ((to-date (gnc:date-option-absolute-time (get-option gnc:pagename-general "Date"))) (accounts (get-option gnc:pagename-accounts "Accounts")) (currency (get-option gnc:pagename-general "Report Currency")) (report-title (get-option gnc:pagename-general gnc:optname-reportname)) (price-source (get-option gnc:pagename-general optname-price-source)) (total-moneyin (gnc:make-commodity-collector)) (total-dividends (gnc:make-commodity-collector)) (total-brokerage (gnc:make-commodity-collector)) (total-value (gnc:make-commodity-collector)) (total-moneyout (gnc:make-commodity-collector)) (total-gain (gnc:make-commodity-collector)) ;; document will be the HTML document that we return. (table (gnc:make-html-table)) (document (gnc:make-html-document))) (gnc:html-document-set-title! document (string-append report-title (sprintf #f " %s" (gnc:timepair-to-datestring to-date)))) (gnc:debug "accounts" accounts) (if (not (null? accounts)) (let* ((commodity-list (gnc:accounts-get-commodities (append (gnc:acccounts-get-all-subaccounts accounts) accounts) currency)) (pricedb (gnc:book-get-pricedb (gnc:get-current-book))) (price-fn (case price-source ('weighted-average (let ((pricealist (gnc:get-commoditylist-totalavg-prices commodity-list currency to-date))) (lambda (foreign domestic date) (gnc:pricealist-lookup-nearest-in-time pricealist foreign date)))) ('pricedb-latest (lambda (foreign domestic date) (let ((price (gnc:pricedb-lookup-latest pricedb foreign domestic))) (if price (let ((v (gnc:price-get-value price))) (gnc:price-unref price) v) (gnc:numeric-zero))))) ('pricedb-nearest (lambda (foreign domestic date) (let ((price (gnc:pricedb-lookup-nearest-in-time pricedb foreign domestic date))) (if price (let ((v (gnc:price-get-value price))) (gnc:price-unref price) v) (gnc:numeric-zero)))))))) (gnc:html-table-set-col-headers! table (list (_ "Account") (_ "Symbol") (_ "Listing") (_ "Money In") (_ "Brokerage") (_ "Dividends") (_ "Units") (_ "Current Value") (_ "Money Out") (_ "Gain") (_ "Total Return") (_ "Avg Age (days)"))) (table-add-stock-rows table accounts to-date currency price-fn total-moneyin total-dividends total-brokerage total-value total-moneyout) (total-gain 'merge total-moneyout #f) (total-gain 'merge total-value #f) (total-gain 'merge total-moneyin #f) (gnc:html-table-append-row/markup! table "grand-total" (list (gnc:make-html-table-cell/size 1 12 (gnc:make-html-text (gnc:html-markup-hr))))) (gnc:html-table-append-row/markup! table "grand-total" (list (gnc:make-html-table-cell/markup "total-label-cell" (_ "Total")) "" "" (gnc:make-html-table-cell/markup "total-number-cell" (gnc:numeric-to-double (cadr (total-moneyin 'getpair currency #t)))) (gnc:make-html-table-cell/markup "total-number-cell" (gnc:numeric-to-double (cadr (total-brokerage 'getpair currency #f)))) (gnc:make-html-table-cell/markup "total-number-cell" (gnc:numeric-to-double (cadr (total-dividends 'getpair currency #t)))) "" (gnc:make-html-table-cell/markup "total-number-cell" (gnc:numeric-to-double (cadr (total-value 'getpair currency #f)))) (gnc:make-html-table-cell/markup "total-number-cell" (gnc:numeric-to-double (cadr (total-moneyout 'getpair currency #f)))) (gnc:make-html-table-cell/markup "total-number-cell" (gnc:numeric-to-double (cadr (total-gain 'getpair currency #f)))) (gnc:make-html-table-cell/markup "total-number-cell" (sprintf #f "%.2f%%" (* 100 (/ (gnc:numeric-to-double (cadr (total-gain 'getpair currency #f))) (gnc:numeric-to-double (cadr (total-moneyin 'getpair currency #t))))))) )) ;; (total-moneyin ;; 'format ;; (lambda (currency amount) ;; (gnc:html-table-append-row/markup! ;; table ;; "grand-total" ;; (list (gnc:make-html-table-cell/markup ;; "total-label-cell" (_ "Total")) ;; (gnc:make-html-table-cell/size/markup ;; 1 5 "total-number-cell" ;; (gnc:make-gnc-monetary currency amount))))) ;; #f) (gnc:html-document-add-object! document table)) ;if no accounts selected. (gnc:html-document-add-object! document (gnc:html-make-no-account-warning report-title))) document)) (gnc:define-report 'version 1 'name (N_ "Advanced Portfolio") 'menu-path (list gnc:menuname-asset-liability) 'options-generator options-generator 'renderer advanced-portfolio-renderer)