From 785107263d24711c59e9677c05711e494cb3c061 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Mon, 18 Jun 2001 17:46:32 +0000 Subject: [PATCH] * src/scm/report/portfolio.scm: convert to guile module. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@4744 57a11ea4-9604-0410-9ed3-97b8803252fd --- src/scm/report/portfolio.scm | 392 ++++++++++++++++++----------------- 1 file changed, 197 insertions(+), 195 deletions(-) diff --git a/src/scm/report/portfolio.scm b/src/scm/report/portfolio.scm index f90864b8d5..8dc4abfbed 100644 --- a/src/scm/report/portfolio.scm +++ b/src/scm/report/portfolio.scm @@ -21,210 +21,212 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(gnc:support "report/portfolio.scm") +;; depends must be outside module scope -- and should eventually go away. (gnc:depend "report-html.scm") -(let ((optname-price-source (N_ "Price Source"))) +(define-module (gnucash report portfolio)) + +(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 (portfolio-renderer report-obj) - (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)))) + ;; 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 price-fn collector) - ;; General Tab - ;; date at which to report balance - (gnc:options-add-report-date! - options gnc:pagename-general - (N_ "Date") "a") + (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)) + (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))) - (gnc:options-add-currency! - options gnc:pagename-general (N_ "Report Currency") "c") + (price-value (price-fn commodity currency to-date)) + + (value-num (gnc:numeric-mul + units + price-value + (gnc:commodity-get-fraction currency) + GNC-RND-ROUND)) - (gnc:options-add-price-source! - options gnc:pagename-general - optname-price-source "d" 'pricedb-latest) + (value (gnc:make-gnc-monetary currency value-num))) + (collector 'add currency value-num) + (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 units)) + (gnc:make-html-table-header-cell/markup + "number-cell" (gnc:make-gnc-monetary currency + price-value)) + (gnc:make-html-table-header-cell/markup + "number-cell" value))) + (table-add-stock-rows-internal rest (not odd-row?))))) - ;; 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)) + (table-add-stock-rows-internal accounts #t)) - (gnc:options-set-default-section options gnc:pagename-general) - options)) + ;; 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)) - ;; 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 (portfolio-renderer report-obj) + (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: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") + (_ "Units") + (_ "Price") + (_ "Value"))) + + (table-add-stock-rows + table accounts to-date currency + price-fn 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))) - ;; 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 price-fn collector) + document)) - (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)) - (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))) - - (price-value (price-fn commodity currency to-date)) - - (value-num (gnc:numeric-mul - units - price-value - (gnc:commodity-get-fraction currency) - GNC-RND-ROUND)) - - (value (gnc:make-gnc-monetary currency value-num))) - (collector 'add currency value-num) - (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 units)) - (gnc:make-html-table-header-cell/markup - "number-cell" (gnc:make-gnc-monetary currency - price-value)) - (gnc:make-html-table-header-cell/markup - "number-cell" value))) - (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)) - - (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: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") - (_ "Units") - (_ "Price") - (_ "Value"))) - - (table-add-stock-rows - table accounts to-date currency - price-fn 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))) - - - document)) - - (gnc:define-report - 'version 1 - 'name (N_ "Investment Portfolio") - 'menu-path (list gnc:menuname-asset-liability) - 'options-generator options-generator - 'renderer portfolio-renderer)) +(gnc:define-report + 'version 1 + 'name (N_ "Investment Portfolio") + 'menu-path (list gnc:menuname-asset-liability) + 'options-generator options-generator + 'renderer portfolio-renderer)