scheme help - keeping the 1.8 advanced-portfolio.scm working?
Derek Atkins
warlord at MIT.EDU
Tue Nov 6 09:27:56 EST 2007
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.
>
>
--
Derek Atkins, SB '93 MIT EE, SM '95 MIT Media Laboratory
Member, MIT Student Information Processing Board (SIPB)
URL: http://web.mit.edu/warlord/ PP-ASEL-IA N1NWH
warlord at MIT.EDU PGP key available
More information about the gnucash-user
mailing list