scheme help - keeping the 1.8 advanced-portfolio.scm working?
Oliver Iberien
odilist at sonic.net
Tue Nov 6 10:45:07 EST 2007
I did try it out first, but for accounts with split transactions, it
gives nonsensical gain/loss figures and percentages. They are way off
and usually in the opposite direction that the account has actually
moved in. This makes it hard to track what actually is going on in the
portfolio. This is what it's done ever since the update from the Oct.
2002 version.
It would be great if someone could update the old advanced-portfolio so
that it could be used.
Thanks,
Oliver
Derek Atkins wrote:
> Have you tried the 2.2.1 version of the advanced portfolio
> report? How does it "return garbage for accounts with
> split transactions"?
>
> The Scheme API completely changed in 2.2; this error is a result
> of you using a report that uses the old scheme API.
>
> -derek
>
> Oliver Iberien <odilist at sonic.net> writes:
>
>> I've been using the version of advanced-portfolio.scm from 1.8 as the
>> subsequent ones return garbage for accounts with split transactions.
>> Having just upgraded to 2.2.1 on Ubuntu 7.10, I find that this .scm no
>> longer works -- it crashes Gnucash. The backtrace follows. I've also
>> attached the old .scm file.
>>
>> Can any of the scheme experts out there tell me if there any tweaking
>> that can be done to this to get it to continue to work?
>>
>> Thanks,
>>
>> Oliver
>>
>> Backtrace:
>> In unknown file:
>> ?: 0* [#<procedure #f (window)> #<swig-pointer GncMainWindow *
>> 81fa000>]
>> In /usr/share/gnucash/guile-modules/gnucash/report/report-gnome.scm:
>> 79: 1* (let ((report #)) (gnc-main-window-open-report report window))
>> 79: 2* [gnc:make-report "Advanced Portfolio"]
>> In /usr/share/gnucash/scm/report.scm:
>> 244: 3 (let (# #) (let # # #) (gnc:report-set-id! r #) ...)
>> 255: 4* (let ((options (if # # ...))) (gnc:report-set-options! r
>> options) ...)
>> 256: 5* (if (not (null? rest)) (car rest) ...)
>> 258: 6 [gnc:report-template-new-options #]
>> ...
>> 176: 7 (let ((options (generator))) (gnc:register-option options
>> stylesheet) ...)
>> 176: 8* [options-generator]
>> In /usr/share/gnucash/guile-modules/gnucash/report/advanced-portfolio.scm:
>> 47: 9 (let* # # # ...)
>> 90: 10* [#<procedure #f (new-option)> ...
>> 91: 11* [gnc:make-account-list-option "Accounts" "Accounts" ...]
>> In /usr/share/gnucash/scm/options.scm:
>> 594: 12 [gnc:make-account-list-limited-option "Accounts" "Accounts" ...]
>> ...
>> 625: 13 (let* (# # # # ...) (gnc:make-option section name sort-tag ...))
>> 625: 14* [map #<procedure convert-to-guid (item)> ...
>> 625: 15* [#<procedure #f ()>]
>> In /usr/share/gnucash/guile-modules/gnucash/report/advanced-portfolio.scm:
>> 95: 16 [filter #<procedure gnc:account-is-stock? (account)> ...
>> 96: 17* (gnc:group-get-subaccounts (gnc:get-current-group))
>>
>> /usr/share/gnucash/guile-modules/gnucash/report/advanced-portfolio.scm:96:26:
>> In expression (gnc:group-get-subaccounts (gnc:get-current-group)):
>> /usr/share/gnucash/guile-modules/gnucash/report/advanced-portfolio.scm:96:26:
>> Unbound variable: gnc:group-get-subaccounts
>>
>>
>> ;; -*-scheme-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
>> ;; advanced-portfolio.scm
>> ;; by Martijn van Oosterhout (kleptog at svana.org) Feb 2002
>> ;; modified for GnuCash 1.8 by Herbert Thoma (herbie at hthoma.de) Oct 2002
>> ;;
>> ;; Heavily based on portfolio.scm
>> ;; by Robert Merkel (rgmerk at 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 at gnu.org
>> ;;
>> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
>>
>> (define-module (gnucash report advanced-portfolio))
>>
>> (use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
>> (use-modules (srfi srfi-1))
>> (use-modules (ice-9 slib))
>> (use-modules (gnucash gnc-module))
>>
>> (require 'printf)
>>
>> (gnc:module-load "gnucash/report/report-system" 0)
>>
>> (define reportname (N_ "Advanced Portfolio"))
>>
>> (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 (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")
>>
>> (add-option
>> (gnc:make-multichoice-option
>> gnc:pagename-general optname-price-source
>> "d" (N_ "The source of price information") 'pricedb-nearest
>> (list (vector 'pricedb-latest
>> (N_ "Most recent")
>> (N_ "The most recent recorded price"))
>> (vector 'pricedb-nearest
>> (N_ "Nearest in time")
>> (N_ "The price recorded nearest in time to the report date"))
>> )))
>>
>>
>> (add-option
>> (gnc:make-number-range-option
>> gnc:pagename-general optname-shares-digits
>> "e" (N_ "The number of decimal places to use for share numbers") 2
>> 0 6 0 1))
>>
>> (gnc:register-option
>> options
>> (gnc:make-simple-boolean-option
>> gnc:pagename-general optname-include-gains "f"
>> (N_ "Include splits with no shares for calculating money-in and
>> money-out")
>> #f))
>>
>> ;; 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:register-option
>> options
>> (gnc:make-simple-boolean-option
>> gnc:pagename-accounts optname-zero-shares "e"
>> (N_ "Include accounts that have a zero share balances.")
>> #f))
>>
>> (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 <html-document>. 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)
>>
>> (let ((work-done 0)
>> (work-to-do 0))
>>
>> ;; 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-<gnc:AccountType>-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 exchange-fn
>> include-empty include-gains
>> total-value total-moneyin total-moneyout
>> total-gain)
>>
>> (let ((share-print-info
>> (gnc:share-print-info-places (get-option gnc:pagename-general
>> optname-shares-digits))))
>>
>> (define (table-add-stock-rows-internal accounts odd-row?)
>> (if (null? accounts) total-value
>> (let* ((row-style (if odd-row? "normal-row" "alternate-row"))
>> (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
>> (unitscoll (gnc:make-commodity-collector))
>> (brokeragecoll (gnc:make-commodity-collector))
>> (dividendcoll (gnc:make-commodity-collector))
>> (moneyincoll (gnc:make-commodity-collector))
>> (moneyoutcoll (gnc:make-commodity-collector))
>> (gaincoll (gnc:make-commodity-collector))
>>
>> (price-list (price-fn commodity to-date))
>> (price (if (> (length price-list) 0)
>> (car price-list) #f))
>>
>> (value (exchange-fn (gnc:make-gnc-monetary commodity
>> units) currency to-date))
>> )
>>
>> ;; (gnc:debug "---" name "---")
>> (for-each
>> (lambda (split)
>> (set! work-done (+ 1 work-done))
>> (gnc:report-percent-done (* 100 (/ work-done
>> work-to-do)))
>> (let ((parent (gnc:split-get-parent split)))
>> (if (gnc:timepair-le
>> (gnc:transaction-get-date-posted parent) to-date)
>> (for-each
>> (lambda (s)
>> (cond
>> ((same-split? s split)
>> ;; (gnc:debug "amount" (gnc:numeric-to-double
>> (gnc:split-get-amount s)) )
>> (cond
>> ((or include-gains (not
>> (gnc:numeric-zero-p (gnc:split-get-amount s))))
>> (unitscoll 'add commodity
>> (gnc:split-get-amount s)) ;; Is the stock transaction?
>> (if (< 0 (gnc:numeric-to-double
>> (gnc:split-get-amount s)))
>> (set! totalunits
>> (+ totalunits
>> (gnc:numeric-to-double
>> (gnc:split-get-amount s)))))
>> (set! totalunityears
>> (+ totalunityears
>> (* (gnc:numeric-to-double
>> (gnc:split-get-amount s))
>> (gnc:date-year-delta
>> (car
>> (gnc:transaction-get-date-posted parent))
>> (current-time)))))
>> (cond
>> ((gnc:numeric-negative-p
>> (gnc:split-get-value s))
>> (moneyoutcoll
>> 'add currency
>> (gnc:numeric-neg
>> (gnc:split-get-value s))))
>> (else (moneyincoll
>> 'add currency
>> (gnc:numeric-neg
>> (gnc:split-get-value s))))))))
>>
>> ((split-account-type? s 'expense)
>> (brokeragecoll 'add currency (gnc:split-get-value s)))
>>
>> ((split-account-type? s 'income)
>> (dividendcoll 'add currency (gnc:split-get-value s)))
>> )
>> )
>> (gnc:transaction-get-splits parent)
>> )
>> )
>> )
>> )
>> (gnc:account-get-split-list current)
>> )
>> ;; (gnc:debug "totalunits" totalunits)
>> ;; (gnc:debug "totalunityears" totalunityears)
>>
>> (gaincoll 'merge moneyoutcoll #f)
>> (gaincoll 'add (gnc:gnc-monetary-commodity value)
>> (gnc:gnc-monetary-amount value))
>> (gaincoll 'merge moneyincoll #f)
>>
>> (if (or include-empty (not (gnc:numeric-zero-p units)))
>> (begin (total-value 'add (gnc:gnc-monetary-commodity value)
>> (gnc:gnc-monetary-amount value))
>> (total-moneyin 'merge moneyincoll #f)
>> (total-moneyout 'merge moneyoutcoll #f)
>> (total-gain 'merge gaincoll #f)
>> (gnc:html-table-append-row/markup!
>> table
>> row-style
>> (list (gnc:html-account-anchor current)
>> ticker-symbol
>> listing
>> (gnc:make-html-table-header-cell/markup
>> "number-cell" (gnc:amount->string units share-print-info))
>> (gnc:make-html-table-header-cell/markup
>> "number-cell"
>> (if price
>> (gnc:html-price-anchor
>> price
>> (gnc:make-gnc-monetary
>> (gnc:price-get-currency price)
>> (gnc:price-get-value price)))
>> #f))
>> (gnc:make-html-table-header-cell/markup
>> "number-cell" value)
>> (gnc:make-html-table-header-cell/markup
>> "number-cell" (gnc:monetary-neg
>> (gnc:sum-collector-commodity moneyincoll currency exchange-fn)))
>> (gnc:make-html-table-header-cell/markup
>> "number-cell"
>> (gnc:sum-collector-commodity moneyoutcoll currency exchange-fn))
>> (gnc:make-html-table-header-cell/markup
>> "number-cell"
>> (gnc:sum-collector-commodity gaincoll currency exchange-fn))
>> (gnc:make-html-table-header-cell/markup
>> "number-cell" (sprintf #f "%.2f%%" (*
>> 100 (/ (gnc:numeric-to-double (cadr (gaincoll 'getpair currency #f)))
>>
>> (gnc:numeric-to-double (cadr (moneyincoll 'getpair currency #t)))))))
>> )
>> )
>> (table-add-stock-rows-internal rest (not odd-row?))
>> )
>> (table-add-stock-rows-internal rest odd-row?)
>> )
>> (gnc:price-list-destroy price-list)
>> )))
>>
>> (set! work-to-do (gnc:accounts-count-splits accounts))
>> (table-add-stock-rows-internal accounts #t)))
>>
>> ;; Tell the user that we're starting.
>> (gnc:report-starting reportname)
>>
>> ;; 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"))
>> (price-source (get-option gnc:pagename-general
>> optname-price-source))
>> (report-title (get-option gnc:pagename-general
>> gnc:optname-reportname))
>> (include-empty (get-option gnc:pagename-accounts
>> optname-zero-shares))
>> (include-gains (get-option gnc:pagename-general
>> optname-include-gains))
>>
>> (total-value (gnc:make-commodity-collector))
>> (total-moneyin (gnc:make-commodity-collector))
>> (total-moneyout (gnc:make-commodity-collector))
>> (total-gain (gnc:make-commodity-collector))
>> ;; document will be the HTML document that we return.
>> (table (gnc:make-html-table))
>> (document (gnc:make-html-document)))
>>
>> (gnc:html-document-set-title!
>> document (string-append
>> report-title
>> (sprintf #f " %s" (gnc:print-date to-date))))
>>
>> ;; (gnc:debug "accounts" accounts)
>> (if (not (null? accounts))
>> ; at least 1 account selected
>> (let* ((exchange-fn
>> (case price-source
>> ('pricedb-latest
>> (lambda (foreign domestic date)
>> (gnc:exchange-by-pricedb-latest foreign domestic)))
>> ('pricedb-nearest gnc:exchange-by-pricedb-nearest)))
>> (pricedb (gnc:book-get-pricedb (gnc:get-current-book)))
>> (price-fn
>> (case price-source
>> ('pricedb-latest
>> (lambda (foreign date)
>> (gnc:pricedb-lookup-latest-any-currency pricedb
>> foreign)))
>> ('pricedb-nearest
>> (lambda (foreign date)
>> (gnc:pricedb-lookup-nearest-in-time-any-currency
>> pricedb foreign date))))))
>>
>> (gnc:html-table-set-col-headers!
>> table
>> (list (_ "Account")
>> (_ "Symbol")
>> (_ "Listing")
>> (_ "Shares")
>> (_ "Price")
>> (_ "Value")
>> (_ "Money In")
>> (_ "Money Out")
>> (_ "Gain")
>> (_ "Total Return")))
>>
>> (table-add-stock-rows
>> table accounts to-date currency price-fn exchange-fn
>> include-empty include-gains total-value total-moneyin
>> total-moneyout total-gain)
>>
>> (gnc:html-table-append-row/markup!
>> table
>> "grand-total"
>> (list
>> (gnc:make-html-table-cell/size
>> 1 10 (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:sum-collector-commodity
>> total-value currency exchange-fn))
>> (gnc:make-html-table-cell/markup
>> "total-number-cell" (gnc:monetary-neg
>> (gnc:sum-collector-commodity total-moneyin currency exchange-fn)))
>> (gnc:make-html-table-cell/markup
>> "total-number-cell" (gnc:sum-collector-commodity
>> total-moneyout currency exchange-fn))
>> (gnc:make-html-table-cell/markup
>> "total-number-cell" (gnc:sum-collector-commodity
>> total-gain currency exchange-fn))
>> (gnc:make-html-table-cell/markup
>> "total-number-cell" (sprintf #f "%.2f%%" (* 100 (/
>> (gnc:numeric-to-double (cadr (total-gain 'getpair currency #f)))
>>
>> (gnc:numeric-to-double (cadr (total-moneyin 'getpair currency #t)))))))
>> ))
>>
>> ;; (total-value
>> ;; 'format
>> ;; (lambda (currency amount)
>> ;; (gnc:html-table-append-row/markup!
>> ;; table
>> ;; "grand-total"
>> ;; (list (gnc:make-html-table-cell/markup
>> ;; "total-label-cell" (_ "Total"))
>> ;; (gnc:make-html-table-cell/size/markup
>> ;; 1 5 "total-number-cell"
>> ;; (gnc:make-gnc-monetary currency amount)))))
>> ;; #f)
>>
>> (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 (gnc:report-id report-obj))))
>>
>> (gnc:report-finished)
>> document)))
>>
>> (gnc:define-report
>> 'version 1
>> 'name reportname
>> 'menu-path (list gnc:menuname-asset-liability)
>> 'options-generator options-generator
>> 'renderer advanced-portfolio-renderer)
>> _______________________________________________
>> gnucash-user mailing list
>> gnucash-user at gnucash.org
>> https://lists.gnucash.org/mailman/listinfo/gnucash-user
>> -----
>> Please remember to CC this list on all your replies.
>> You can do this by using Reply-To-List or Reply-All.
>>
>>
>
More information about the gnucash-user
mailing list