[GNC] GnuCash 3.7 and Portfolio Report
NOSTOP
nostop at tutanota.com
Sun Oct 6 09:00:38 EDT 2019
Hello John.
I'm on ver 3.7, Flatpak, Linux Mint 18.3
My file : portfolio.scm is different. There is no "report-currency" to
change into "currency" at line 199 or anywhere else in the file.
*
portfolio.scm :*
(define-module (gnucash report standard-reports portfolio))
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
(use-modules (srfi srfi-1))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
(use-modules (gnucash printf))
(gnc:module-load "gnucash/report/report-system" 0)
(define reportname (N_ "Investment 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 (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's currency") "c")
(gnc:options-add-price-source!
options gnc:pagename-general
optname-price-source "d" 'pricedb-latest)
(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))
;; 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-account-get-descendants-sorted
(gnc-get-current-root-account))))
(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 (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 (table-add-stock-rows table accounts to-date currency
exchange-fn price-fn include-empty
collector)
(let ((share-print-info
(gnc-share-print-info-places
(inexact->exact (get-option gnc:pagename-general
optname-shares-digits)))))
(define (table-add-stock-rows-internal accounts odd-row?)
(if (null? accounts) collector
(let* ((row-style (if odd-row? "normal-row" "alternate-row"))
(current (car accounts))
(rest (cdr accounts))
(commodity (xaccAccountGetCommodity 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)))
(price-info (price-fn commodity to-date))
(price (car price-info))
(price-monetary (if price
(gnc:make-gnc-monetary
(gnc-price-get-currency price)
(gnc-price-get-value price))
(gnc:make-gnc-monetary
currency
(cdr price-info))))
(value (exchange-fn (gnc:make-gnc-monetary commodity units)
currency)))
(set! work-done (+ 1 work-done))
(gnc:report-percent-done (* 100 (/ work-done work-to-do)))
(if (or include-empty (not (gnc-numeric-zero-p units)))
(begin (collector 'add currency (gnc:gnc-monetary-amount value))
(gnc:html-table-append-row/markup!
table
row-style
(list (gnc:html-account-anchor current)
(gnc:make-html-table-header-cell/markup "text-cell" ticker-symbol)
(gnc:make-html-table-header-cell/markup "text-cell" listing)
(gnc:make-html-table-header-cell/markup
"number-cell"
(xaccPrintAmount units share-print-info))
(gnc:make-html-table-header-cell/markup
"number-cell"
(gnc:html-price-anchor price price-monetary))
(gnc:make-html-table-header-cell/markup
"number-cell" value)))
;;(display (sprintf #f "Shares: %6.6d " (gnc-numeric-to-double
units)))
;;(display units) (newline)
(if price (gnc-price-unref price))
(table-add-stock-rows-internal rest (not odd-row?)))
(begin (if price (gnc-price-unref price))
(table-add-stock-rows-internal rest odd-row?))))))
(set! work-to-do (length 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's currency"))
(report-title (get-option gnc:pagename-general
gnc:optname-reportname))
(price-source (get-option gnc:pagename-general
optname-price-source))
(include-empty (get-option gnc:pagename-accounts
optname-zero-shares))
(collector (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))
(let* ((commodity-list (gnc:accounts-get-commodities
(append
(gnc:acccounts-get-all-subaccounts
accounts) accounts) currency))
(pricedb (gnc-pricedb-get-db (gnc-get-current-book)))
(exchange-fn (gnc:case-exchange-fn price-source currency to-date))
(price-fn
(case price-source
((weighted-average average-cost)
(lambda (foreign date)
(cons #f (gnc-numeric-div
(gnc:gnc-monetary-amount
(exchange-fn (gnc:make-gnc-monetary
foreign
(gnc-numeric-create 10000
1))
currency))
(gnc-numeric-create 10000 1)
GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 5)
GNC-RND-ROUND)))))
((pricedb-latest)
(lambda (foreign date)
(let* ((price
(gnc-pricedb-lookup-latest-any-currency
pricedb foreign))
(fn (if (and price (> (length price) 0))
(let ((v (gnc-price-get-value (car
price))))
(gnc-price-ref (car price))
(cons (car price) v))
(cons #f (gnc-numeric-zero)))))
(if price (gnc-price-list-destroy price))
fn)))
((pricedb-nearest)
(lambda (foreign date)
(let* ((price
(gnc-pricedb-lookup-nearest-in-time-any-currency
pricedb foreign (timespecCanonicalDayTime
date)))
(fn (if (and price (> (length price) 0))
(let ((v (gnc-price-get-value (car
price))))
(gnc-price-ref (car price))
(cons (car price) v))
(cons #f (gnc-numeric-zero)))))
(if price (gnc-price-list-destroy price))
fn))))))
(gnc:html-table-set-col-headers!
table
(list (_ "Account")
(_ "Symbol")
(_ "Listing")
(_ "Units")
(_ "Price")
(_ "Value")))
(table-add-stock-rows
table accounts to-date currency
exchange-fn price-fn include-empty collector)
(gnc:html-table-append-row/markup!
table
"grand-total"
(list
(gnc:make-html-table-cell/size
1 6 (gnc:make-html-text (gnc:html-markup-hr)))))
(collector
'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
'report-guid "4a6b82e8678c4f3d9e85d9f09634ca89"
'menu-path (list gnc:menuname-asset-liability)
'options-generator options-generator
'renderer portfolio-renderer)
--
Sent from: http://gnucash.1415818.n4.nabble.com/GnuCash-User-f1415819.html
More information about the gnucash-user
mailing list