mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
* src/scm/report/pnl.scm: convert to guile module.
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@4743 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Rob Browning
parent
1514fcd828
commit
f375b0c95a
@ -22,186 +22,188 @@
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(gnc:support "report/pnl.scm")
|
||||
;; depends must be outside module scope -- and should eventually go away.
|
||||
(gnc:depend "report-html.scm")
|
||||
|
||||
(define-module (gnucash report pnl))
|
||||
|
||||
;; Profit and loss report. Actually, people in finances might want
|
||||
;; something different under this name, but they are welcomed to
|
||||
;; contribute their changes :-)
|
||||
|
||||
;; first define all option's names so that they are properly defined
|
||||
;; in *one* place.
|
||||
(let* ((optname-from-date (N_ "From"))
|
||||
(optname-to-date (N_ "To"))
|
||||
|
||||
(optname-display-depth (N_ "Account Display Depth"))
|
||||
(optname-show-subaccounts (N_ "Always show sub-accounts"))
|
||||
(optname-accounts (N_ "Account"))
|
||||
(define optname-from-date (N_ "From"))
|
||||
(define optname-to-date (N_ "To"))
|
||||
|
||||
(optname-group-accounts (N_ "Group the accounts"))
|
||||
(optname-show-parent-balance (N_ "Show balances for parent accounts"))
|
||||
(optname-show-parent-total (N_ "Show subtotals"))
|
||||
|
||||
(optname-show-foreign (N_ "Show Foreign Currencies"))
|
||||
(optname-report-currency (N_ "Report's currency"))
|
||||
(optname-price-source (N_ "Price Source"))
|
||||
(optname-show-rates (N_ "Show Exchange Rates")))
|
||||
|
||||
;; options generator
|
||||
(define (pnl-options-generator)
|
||||
(let ((options (gnc:new-options)))
|
||||
|
||||
;; date at which to report balance
|
||||
(gnc:options-add-date-interval!
|
||||
options gnc:pagename-general
|
||||
optname-from-date optname-to-date "a")
|
||||
(define optname-display-depth (N_ "Account Display Depth"))
|
||||
(define optname-show-subaccounts (N_ "Always show sub-accounts"))
|
||||
(define optname-accounts (N_ "Account"))
|
||||
|
||||
;; all about currencies
|
||||
(gnc:options-add-currency!
|
||||
options gnc:pagename-general
|
||||
optname-report-currency "b")
|
||||
(define optname-group-accounts (N_ "Group the accounts"))
|
||||
(define optname-show-parent-balance (N_ "Show balances for parent accounts"))
|
||||
(define optname-show-parent-total (N_ "Show subtotals"))
|
||||
|
||||
(gnc:options-add-price-source!
|
||||
options gnc:pagename-general
|
||||
optname-price-source "c" 'weighted-average)
|
||||
(define optname-show-foreign (N_ "Show Foreign Currencies"))
|
||||
(define optname-report-currency (N_ "Report's currency"))
|
||||
(define optname-price-source (N_ "Price Source"))
|
||||
(define optname-show-rates (N_ "Show Exchange Rates"))
|
||||
|
||||
;; accounts to work on
|
||||
(gnc:options-add-account-selection!
|
||||
options gnc:pagename-accounts
|
||||
optname-display-depth optname-show-subaccounts
|
||||
optname-accounts "a" 2
|
||||
(lambda ()
|
||||
(filter
|
||||
gnc:account-is-inc-exp?
|
||||
(gnc:group-get-account-list (gnc:get-current-group)))))
|
||||
;; options generator
|
||||
(define (pnl-options-generator)
|
||||
(let ((options (gnc:new-options)))
|
||||
|
||||
;; date at which to report balance
|
||||
(gnc:options-add-date-interval!
|
||||
options gnc:pagename-general
|
||||
optname-from-date optname-to-date "a")
|
||||
|
||||
;; with or without grouping
|
||||
(gnc:options-add-group-accounts!
|
||||
options gnc:pagename-display optname-group-accounts "b" #t)
|
||||
;; all about currencies
|
||||
(gnc:options-add-currency!
|
||||
options gnc:pagename-general
|
||||
optname-report-currency "b")
|
||||
|
||||
;; what to show about non-leaf accounts
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-parent-balance
|
||||
"c" (N_ "Show balances for parent accounts") #f))
|
||||
(gnc:options-add-price-source!
|
||||
options gnc:pagename-general
|
||||
optname-price-source "c" 'weighted-average)
|
||||
|
||||
;; have a subtotal for each parent account?
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-parent-total
|
||||
"d" (N_ "Show subtotals for parent accounts") #t))
|
||||
;; accounts to work on
|
||||
(gnc:options-add-account-selection!
|
||||
options gnc:pagename-accounts
|
||||
optname-display-depth optname-show-subaccounts
|
||||
optname-accounts "a" 2
|
||||
(lambda ()
|
||||
(filter
|
||||
gnc:account-is-inc-exp?
|
||||
(gnc:group-get-account-list (gnc:get-current-group)))))
|
||||
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-foreign
|
||||
"e" (N_ "Display the account's foreign currency amount?") #f))
|
||||
;; with or without grouping
|
||||
(gnc:options-add-group-accounts!
|
||||
options gnc:pagename-display optname-group-accounts "b" #t)
|
||||
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-rates
|
||||
"f" (N_ "Show the exchange rates used") #t))
|
||||
;; what to show about non-leaf accounts
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-parent-balance
|
||||
"c" (N_ "Show balances for parent accounts") #f))
|
||||
|
||||
;; Set the general page as default option tab
|
||||
(gnc:options-set-default-section options gnc:pagename-general)
|
||||
;; have a subtotal for each parent account?
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-parent-total
|
||||
"d" (N_ "Show subtotals for parent accounts") #t))
|
||||
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-foreign
|
||||
"e" (N_ "Display the account's foreign currency amount?") #f))
|
||||
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-rates
|
||||
"f" (N_ "Show the exchange rates used") #t))
|
||||
|
||||
;; Set the general page as default option tab
|
||||
(gnc:options-set-default-section options gnc:pagename-general)
|
||||
|
||||
options))
|
||||
|
||||
options))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; pnl-renderer
|
||||
;; set up the document and add the table
|
||||
;; pnl-renderer
|
||||
;; set up the document and add the table
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (pnl-renderer report-obj)
|
||||
(define (get-option pagename optname)
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option
|
||||
(gnc:report-options report-obj) pagename optname)))
|
||||
(define (pnl-renderer report-obj)
|
||||
(define (get-option pagename optname)
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option
|
||||
(gnc:report-options report-obj) pagename optname)))
|
||||
|
||||
;; get all option's values
|
||||
(let* ((display-depth (get-option gnc:pagename-accounts
|
||||
optname-display-depth))
|
||||
(show-subaccts? (get-option gnc:pagename-accounts
|
||||
optname-show-subaccounts))
|
||||
(accounts (filter gnc:account-is-inc-exp?
|
||||
(get-option gnc:pagename-accounts
|
||||
optname-accounts)))
|
||||
(do-grouping? (get-option gnc:pagename-display
|
||||
optname-group-accounts))
|
||||
(show-parent-balance? (get-option gnc:pagename-display
|
||||
optname-show-parent-balance))
|
||||
(show-parent-total? (get-option gnc:pagename-display
|
||||
optname-show-parent-total))
|
||||
(show-fcur? (get-option gnc:pagename-display
|
||||
optname-show-foreign))
|
||||
(report-currency (get-option gnc:pagename-general
|
||||
optname-report-currency))
|
||||
(price-source (get-option gnc:pagename-general
|
||||
optname-price-source))
|
||||
(show-rates? (get-option gnc:pagename-display
|
||||
optname-show-rates))
|
||||
(to-date-tp (gnc:timepair-end-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general
|
||||
optname-to-date))))
|
||||
(from-date-tp (gnc:timepair-start-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general
|
||||
optname-from-date))))
|
||||
(report-title (sprintf #f
|
||||
(_ "Profit and Loss - %s to %s")
|
||||
(gnc:timepair-to-datestring from-date-tp)
|
||||
(gnc:timepair-to-datestring to-date-tp)))
|
||||
(doc (gnc:make-html-document)))
|
||||
|
||||
(gnc:html-document-set-title!
|
||||
doc report-title)
|
||||
(if (not (null? accounts))
|
||||
;; if no max. tree depth is given we have to find the
|
||||
;; maximum existing depth
|
||||
(let* ((tree-depth (+ (if (equal? display-depth 'all)
|
||||
(gnc:get-current-group-depth)
|
||||
display-depth)
|
||||
(if do-grouping? 1 0)))
|
||||
;; calculate the exchange rates
|
||||
(exchange-fn (gnc:case-exchange-fn
|
||||
price-source report-currency to-date-tp))
|
||||
;; do the processing here
|
||||
(table (gnc:html-build-acct-table
|
||||
from-date-tp to-date-tp
|
||||
tree-depth show-subaccts? accounts #f
|
||||
#t gnc:accounts-get-comm-total-profit
|
||||
(_ "Profit") do-grouping?
|
||||
show-parent-balance? show-parent-total?
|
||||
show-fcur? report-currency exchange-fn)))
|
||||
;; get all option's values
|
||||
(let* ((display-depth (get-option gnc:pagename-accounts
|
||||
optname-display-depth))
|
||||
(show-subaccts? (get-option gnc:pagename-accounts
|
||||
optname-show-subaccounts))
|
||||
(accounts (filter gnc:account-is-inc-exp?
|
||||
(get-option gnc:pagename-accounts
|
||||
optname-accounts)))
|
||||
(do-grouping? (get-option gnc:pagename-display
|
||||
optname-group-accounts))
|
||||
(show-parent-balance? (get-option gnc:pagename-display
|
||||
optname-show-parent-balance))
|
||||
(show-parent-total? (get-option gnc:pagename-display
|
||||
optname-show-parent-total))
|
||||
(show-fcur? (get-option gnc:pagename-display
|
||||
optname-show-foreign))
|
||||
(report-currency (get-option gnc:pagename-general
|
||||
optname-report-currency))
|
||||
(price-source (get-option gnc:pagename-general
|
||||
optname-price-source))
|
||||
(show-rates? (get-option gnc:pagename-display
|
||||
optname-show-rates))
|
||||
(to-date-tp (gnc:timepair-end-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general
|
||||
optname-to-date))))
|
||||
(from-date-tp (gnc:timepair-start-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general
|
||||
optname-from-date))))
|
||||
(report-title (sprintf #f
|
||||
(_ "Profit and Loss - %s to %s")
|
||||
(gnc:timepair-to-datestring from-date-tp)
|
||||
(gnc:timepair-to-datestring to-date-tp)))
|
||||
(doc (gnc:make-html-document)))
|
||||
|
||||
(gnc:html-document-set-title!
|
||||
doc report-title)
|
||||
(if (not (null? accounts))
|
||||
;; if no max. tree depth is given we have to find the
|
||||
;; maximum existing depth
|
||||
(let* ((tree-depth (+ (if (equal? display-depth 'all)
|
||||
(gnc:get-current-group-depth)
|
||||
display-depth)
|
||||
(if do-grouping? 1 0)))
|
||||
;; calculate the exchange rates
|
||||
(exchange-fn (gnc:case-exchange-fn
|
||||
price-source report-currency to-date-tp))
|
||||
;; do the processing here
|
||||
(table (gnc:html-build-acct-table
|
||||
from-date-tp to-date-tp
|
||||
tree-depth show-subaccts? accounts #f
|
||||
#t gnc:accounts-get-comm-total-profit
|
||||
(_ "Profit") do-grouping?
|
||||
show-parent-balance? show-parent-total?
|
||||
show-fcur? report-currency exchange-fn)))
|
||||
|
||||
;; add the table
|
||||
(gnc:html-document-add-object! doc table)
|
||||
;; add the table
|
||||
(gnc:html-document-add-object! doc table)
|
||||
|
||||
;; add currency information
|
||||
(if show-rates?
|
||||
(gnc:html-document-add-object!
|
||||
doc ;;(gnc:html-markup-p
|
||||
(gnc:html-make-exchangerates
|
||||
report-currency exchange-fn
|
||||
(append-map
|
||||
(lambda (a)
|
||||
(gnc:group-get-subaccounts
|
||||
(gnc:account-get-children a)))
|
||||
accounts)))))
|
||||
|
||||
;; error condition: no accounts specified
|
||||
;; add currency information
|
||||
(if show-rates?
|
||||
(gnc:html-document-add-object!
|
||||
doc ;;(gnc:html-markup-p
|
||||
(gnc:html-make-exchangerates
|
||||
report-currency exchange-fn
|
||||
(append-map
|
||||
(lambda (a)
|
||||
(gnc:group-get-subaccounts
|
||||
(gnc:account-get-children a)))
|
||||
accounts)))))
|
||||
|
||||
(gnc:html-document-add-object!
|
||||
doc (gnc:html-make-no-account-warning report-title)))
|
||||
doc))
|
||||
;; error condition: no accounts specified
|
||||
|
||||
(gnc:html-document-add-object!
|
||||
doc (gnc:html-make-no-account-warning report-title)))
|
||||
doc))
|
||||
|
||||
(gnc:define-report
|
||||
'version 1
|
||||
'name (N_ "Profit And Loss")
|
||||
'menu-path (list gnc:menuname-income-expense)
|
||||
'options-generator pnl-options-generator
|
||||
'renderer pnl-renderer))
|
||||
(gnc:define-report
|
||||
'version 1
|
||||
'name (N_ "Profit And Loss")
|
||||
'menu-path (list gnc:menuname-income-expense)
|
||||
'options-generator pnl-options-generator
|
||||
'renderer pnl-renderer)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user