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")
|
(gnc:depend "report-html.scm")
|
||||||
|
|
||||||
|
(define-module (gnucash report pnl))
|
||||||
|
|
||||||
;; Profit and loss report. Actually, people in finances might want
|
;; Profit and loss report. Actually, people in finances might want
|
||||||
;; something different under this name, but they are welcomed to
|
;; something different under this name, but they are welcomed to
|
||||||
;; contribute their changes :-)
|
;; contribute their changes :-)
|
||||||
|
|
||||||
;; first define all option's names so that they are properly defined
|
;; first define all option's names so that they are properly defined
|
||||||
;; in *one* place.
|
;; in *one* place.
|
||||||
(let* ((optname-from-date (N_ "From"))
|
(define optname-from-date (N_ "From"))
|
||||||
(optname-to-date (N_ "To"))
|
(define optname-to-date (N_ "To"))
|
||||||
|
|
||||||
(optname-display-depth (N_ "Account Display Depth"))
|
|
||||||
(optname-show-subaccounts (N_ "Always show sub-accounts"))
|
|
||||||
(optname-accounts (N_ "Account"))
|
|
||||||
|
|
||||||
(optname-group-accounts (N_ "Group the accounts"))
|
(define optname-display-depth (N_ "Account Display Depth"))
|
||||||
(optname-show-parent-balance (N_ "Show balances for parent accounts"))
|
(define optname-show-subaccounts (N_ "Always show sub-accounts"))
|
||||||
(optname-show-parent-total (N_ "Show subtotals"))
|
(define optname-accounts (N_ "Account"))
|
||||||
|
|
||||||
(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")
|
|
||||||
|
|
||||||
;; all about currencies
|
(define optname-group-accounts (N_ "Group the accounts"))
|
||||||
(gnc:options-add-currency!
|
(define optname-show-parent-balance (N_ "Show balances for parent accounts"))
|
||||||
options gnc:pagename-general
|
(define optname-show-parent-total (N_ "Show subtotals"))
|
||||||
optname-report-currency "b")
|
|
||||||
|
|
||||||
(gnc:options-add-price-source!
|
(define optname-show-foreign (N_ "Show Foreign Currencies"))
|
||||||
options gnc:pagename-general
|
(define optname-report-currency (N_ "Report's currency"))
|
||||||
optname-price-source "c" 'weighted-average)
|
(define optname-price-source (N_ "Price Source"))
|
||||||
|
(define optname-show-rates (N_ "Show Exchange Rates"))
|
||||||
|
|
||||||
;; accounts to work on
|
;; options generator
|
||||||
(gnc:options-add-account-selection!
|
(define (pnl-options-generator)
|
||||||
options gnc:pagename-accounts
|
(let ((options (gnc:new-options)))
|
||||||
optname-display-depth optname-show-subaccounts
|
|
||||||
optname-accounts "a" 2
|
;; date at which to report balance
|
||||||
(lambda ()
|
(gnc:options-add-date-interval!
|
||||||
(filter
|
options gnc:pagename-general
|
||||||
gnc:account-is-inc-exp?
|
optname-from-date optname-to-date "a")
|
||||||
(gnc:group-get-account-list (gnc:get-current-group)))))
|
|
||||||
|
|
||||||
;; with or without grouping
|
;; all about currencies
|
||||||
(gnc:options-add-group-accounts!
|
(gnc:options-add-currency!
|
||||||
options gnc:pagename-display optname-group-accounts "b" #t)
|
options gnc:pagename-general
|
||||||
|
optname-report-currency "b")
|
||||||
|
|
||||||
;; what to show about non-leaf accounts
|
(gnc:options-add-price-source!
|
||||||
(gnc:register-option
|
options gnc:pagename-general
|
||||||
options
|
optname-price-source "c" 'weighted-average)
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
gnc:pagename-display optname-show-parent-balance
|
|
||||||
"c" (N_ "Show balances for parent accounts") #f))
|
|
||||||
|
|
||||||
;; have a subtotal for each parent account?
|
;; accounts to work on
|
||||||
(gnc:register-option
|
(gnc:options-add-account-selection!
|
||||||
options
|
options gnc:pagename-accounts
|
||||||
(gnc:make-simple-boolean-option
|
optname-display-depth optname-show-subaccounts
|
||||||
gnc:pagename-display optname-show-parent-total
|
optname-accounts "a" 2
|
||||||
"d" (N_ "Show subtotals for parent accounts") #t))
|
(lambda ()
|
||||||
|
(filter
|
||||||
|
gnc:account-is-inc-exp?
|
||||||
|
(gnc:group-get-account-list (gnc:get-current-group)))))
|
||||||
|
|
||||||
(gnc:register-option
|
;; with or without grouping
|
||||||
options
|
(gnc:options-add-group-accounts!
|
||||||
(gnc:make-simple-boolean-option
|
options gnc:pagename-display optname-group-accounts "b" #t)
|
||||||
gnc:pagename-display optname-show-foreign
|
|
||||||
"e" (N_ "Display the account's foreign currency amount?") #f))
|
|
||||||
|
|
||||||
(gnc:register-option
|
;; what to show about non-leaf accounts
|
||||||
options
|
(gnc:register-option
|
||||||
(gnc:make-simple-boolean-option
|
options
|
||||||
gnc:pagename-display optname-show-rates
|
(gnc:make-simple-boolean-option
|
||||||
"f" (N_ "Show the exchange rates used") #t))
|
gnc:pagename-display optname-show-parent-balance
|
||||||
|
"c" (N_ "Show balances for parent accounts") #f))
|
||||||
|
|
||||||
;; Set the general page as default option tab
|
;; have a subtotal for each parent account?
|
||||||
(gnc:options-set-default-section options gnc:pagename-general)
|
(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
|
;; pnl-renderer
|
||||||
;; set up the document and add the table
|
;; set up the document and add the table
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(define (pnl-renderer report-obj)
|
(define (pnl-renderer report-obj)
|
||||||
(define (get-option pagename optname)
|
(define (get-option pagename optname)
|
||||||
(gnc:option-value
|
(gnc:option-value
|
||||||
(gnc:lookup-option
|
(gnc:lookup-option
|
||||||
(gnc:report-options report-obj) pagename optname)))
|
(gnc:report-options report-obj) pagename optname)))
|
||||||
|
|
||||||
;; get all option's values
|
;; get all option's values
|
||||||
(let* ((display-depth (get-option gnc:pagename-accounts
|
(let* ((display-depth (get-option gnc:pagename-accounts
|
||||||
optname-display-depth))
|
optname-display-depth))
|
||||||
(show-subaccts? (get-option gnc:pagename-accounts
|
(show-subaccts? (get-option gnc:pagename-accounts
|
||||||
optname-show-subaccounts))
|
optname-show-subaccounts))
|
||||||
(accounts (filter gnc:account-is-inc-exp?
|
(accounts (filter gnc:account-is-inc-exp?
|
||||||
(get-option gnc:pagename-accounts
|
(get-option gnc:pagename-accounts
|
||||||
optname-accounts)))
|
optname-accounts)))
|
||||||
(do-grouping? (get-option gnc:pagename-display
|
(do-grouping? (get-option gnc:pagename-display
|
||||||
optname-group-accounts))
|
optname-group-accounts))
|
||||||
(show-parent-balance? (get-option gnc:pagename-display
|
(show-parent-balance? (get-option gnc:pagename-display
|
||||||
optname-show-parent-balance))
|
optname-show-parent-balance))
|
||||||
(show-parent-total? (get-option gnc:pagename-display
|
(show-parent-total? (get-option gnc:pagename-display
|
||||||
optname-show-parent-total))
|
optname-show-parent-total))
|
||||||
(show-fcur? (get-option gnc:pagename-display
|
(show-fcur? (get-option gnc:pagename-display
|
||||||
optname-show-foreign))
|
optname-show-foreign))
|
||||||
(report-currency (get-option gnc:pagename-general
|
(report-currency (get-option gnc:pagename-general
|
||||||
optname-report-currency))
|
optname-report-currency))
|
||||||
(price-source (get-option gnc:pagename-general
|
(price-source (get-option gnc:pagename-general
|
||||||
optname-price-source))
|
optname-price-source))
|
||||||
(show-rates? (get-option gnc:pagename-display
|
(show-rates? (get-option gnc:pagename-display
|
||||||
optname-show-rates))
|
optname-show-rates))
|
||||||
(to-date-tp (gnc:timepair-end-day-time
|
(to-date-tp (gnc:timepair-end-day-time
|
||||||
(gnc:date-option-absolute-time
|
(gnc:date-option-absolute-time
|
||||||
(get-option gnc:pagename-general
|
(get-option gnc:pagename-general
|
||||||
optname-to-date))))
|
optname-to-date))))
|
||||||
(from-date-tp (gnc:timepair-start-day-time
|
(from-date-tp (gnc:timepair-start-day-time
|
||||||
(gnc:date-option-absolute-time
|
(gnc:date-option-absolute-time
|
||||||
(get-option gnc:pagename-general
|
(get-option gnc:pagename-general
|
||||||
optname-from-date))))
|
optname-from-date))))
|
||||||
(report-title (sprintf #f
|
(report-title (sprintf #f
|
||||||
(_ "Profit and Loss - %s to %s")
|
(_ "Profit and Loss - %s to %s")
|
||||||
(gnc:timepair-to-datestring from-date-tp)
|
(gnc:timepair-to-datestring from-date-tp)
|
||||||
(gnc:timepair-to-datestring to-date-tp)))
|
(gnc:timepair-to-datestring to-date-tp)))
|
||||||
(doc (gnc:make-html-document)))
|
(doc (gnc:make-html-document)))
|
||||||
|
|
||||||
(gnc:html-document-set-title!
|
(gnc:html-document-set-title!
|
||||||
doc report-title)
|
doc report-title)
|
||||||
(if (not (null? accounts))
|
(if (not (null? accounts))
|
||||||
;; if no max. tree depth is given we have to find the
|
;; if no max. tree depth is given we have to find the
|
||||||
;; maximum existing depth
|
;; maximum existing depth
|
||||||
(let* ((tree-depth (+ (if (equal? display-depth 'all)
|
(let* ((tree-depth (+ (if (equal? display-depth 'all)
|
||||||
(gnc:get-current-group-depth)
|
(gnc:get-current-group-depth)
|
||||||
display-depth)
|
display-depth)
|
||||||
(if do-grouping? 1 0)))
|
(if do-grouping? 1 0)))
|
||||||
;; calculate the exchange rates
|
;; calculate the exchange rates
|
||||||
(exchange-fn (gnc:case-exchange-fn
|
(exchange-fn (gnc:case-exchange-fn
|
||||||
price-source report-currency to-date-tp))
|
price-source report-currency to-date-tp))
|
||||||
;; do the processing here
|
;; do the processing here
|
||||||
(table (gnc:html-build-acct-table
|
(table (gnc:html-build-acct-table
|
||||||
from-date-tp to-date-tp
|
from-date-tp to-date-tp
|
||||||
tree-depth show-subaccts? accounts #f
|
tree-depth show-subaccts? accounts #f
|
||||||
#t gnc:accounts-get-comm-total-profit
|
#t gnc:accounts-get-comm-total-profit
|
||||||
(_ "Profit") do-grouping?
|
(_ "Profit") do-grouping?
|
||||||
show-parent-balance? show-parent-total?
|
show-parent-balance? show-parent-total?
|
||||||
show-fcur? report-currency exchange-fn)))
|
show-fcur? report-currency exchange-fn)))
|
||||||
|
|
||||||
;; add the table
|
;; add the table
|
||||||
(gnc:html-document-add-object! doc table)
|
(gnc:html-document-add-object! doc table)
|
||||||
|
|
||||||
;; add currency information
|
;; add currency information
|
||||||
(if show-rates?
|
(if show-rates?
|
||||||
(gnc:html-document-add-object!
|
(gnc:html-document-add-object!
|
||||||
doc ;;(gnc:html-markup-p
|
doc ;;(gnc:html-markup-p
|
||||||
(gnc:html-make-exchangerates
|
(gnc:html-make-exchangerates
|
||||||
report-currency exchange-fn
|
report-currency exchange-fn
|
||||||
(append-map
|
(append-map
|
||||||
(lambda (a)
|
(lambda (a)
|
||||||
(gnc:group-get-subaccounts
|
(gnc:group-get-subaccounts
|
||||||
(gnc:account-get-children a)))
|
(gnc:account-get-children a)))
|
||||||
accounts)))))
|
accounts)))))
|
||||||
|
|
||||||
;; error condition: no accounts specified
|
|
||||||
|
|
||||||
(gnc:html-document-add-object!
|
;; error condition: no accounts specified
|
||||||
doc (gnc:html-make-no-account-warning report-title)))
|
|
||||||
doc))
|
(gnc:html-document-add-object!
|
||||||
|
doc (gnc:html-make-no-account-warning report-title)))
|
||||||
|
doc))
|
||||||
|
|
||||||
(gnc:define-report
|
(gnc:define-report
|
||||||
'version 1
|
'version 1
|
||||||
'name (N_ "Profit And Loss")
|
'name (N_ "Profit And Loss")
|
||||||
'menu-path (list gnc:menuname-income-expense)
|
'menu-path (list gnc:menuname-income-expense)
|
||||||
'options-generator pnl-options-generator
|
'options-generator pnl-options-generator
|
||||||
'renderer pnl-renderer))
|
'renderer pnl-renderer)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user