mirror of https://github.com/Gnucash/gnucash
* src/scm/html-style-info.scm: Fix bug. * src/scm/gnc-numeric.scm: Add more functions on gnc-monetary. * src/scm/html-utilities.scm: Add balance sign reversal conditioned on gnc:account-reverse-balance? for the account table. Add function to print exchange rates. * src/scm/report-utilities.scm: Modify commodity-collector to enable more sign reversals and usage of gnc-monetary. Add option creation functions common to several reports. * src/scm/report/account-summary.scm: Removed function now in report-utilities.scm. Added variables for option names. * src/scm/report/pnl.scm: New Profit And Loss report, based on account-summary report. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3622 57a11ea4-9604-0410-9ed3-97b8803252fdzzzoldreleases/1.6
Dave Peticolas
26 years ago
parent
3afbeae315
commit
c1dbc8ef7b
@ -0,0 +1,170 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; pnl.scm : profit-and-loss report
|
||||
;;
|
||||
;; By Christian Stimming <stimming@tu-harburg.de>
|
||||
;;
|
||||
;; 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@gnu.org
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(gnc:support "report/pnl.scm")
|
||||
(gnc:depend "report-html.scm")
|
||||
|
||||
;; 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* ((pagename-general (_ "General"))
|
||||
(optname-from-date (_ "From"))
|
||||
(optname-to-date (_ "To"))
|
||||
|
||||
(pagename-accounts (_ "Accounts"))
|
||||
(optname-display-depth (_ "Account Display Depth"))
|
||||
(optname-show-subaccounts (_ "Always show sub-accounts"))
|
||||
(optname-accounts (_ "Account"))
|
||||
(optname-include-subbalances (_ "Include Sub-Account balances"))
|
||||
|
||||
;; (pagename-currencies (_ "Currencies")) too little options :)
|
||||
(pagename-currencies pagename-general)
|
||||
(optname-show-foreign (_ "Show Foreign Currencies"))
|
||||
(optname-report-currency (_ "Report's currency")))
|
||||
|
||||
;; options generator
|
||||
(define (pnl-options-generator)
|
||||
(let ((options (gnc:new-options)))
|
||||
|
||||
;; date at which to report balance
|
||||
(gnc:options-add-date-interval!
|
||||
options pagename-general
|
||||
optname-from-date optname-to-date "a")
|
||||
|
||||
;; accounts to work on
|
||||
(gnc:options-add-account-selection!
|
||||
options pagename-accounts
|
||||
optname-display-depth optname-show-subaccounts
|
||||
optname-accounts "b" 2
|
||||
;; FIXME: get income/expense accounts
|
||||
(lambda ()
|
||||
(filter
|
||||
gnc:account-is-inc-exp?
|
||||
(gnc:group-get-account-list (gnc:get-current-group)))))
|
||||
|
||||
;; with or without subaccounts
|
||||
(gnc:options-add-include-subaccounts!
|
||||
options pagename-accounts optname-include-subbalances "c")
|
||||
|
||||
;; all about currencies
|
||||
(gnc:options-add-currency-selection!
|
||||
options pagename-currencies
|
||||
optname-show-foreign optname-report-currency
|
||||
"d")
|
||||
|
||||
;; Set the general page as default option tab
|
||||
(gnc:options-set-default-section options pagename-general)
|
||||
|
||||
options))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; 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)))
|
||||
|
||||
;; get all option's values
|
||||
(let ((display-depth (get-option pagename-accounts
|
||||
optname-display-depth))
|
||||
(show-subaccts? (get-option pagename-accounts
|
||||
optname-show-subaccounts))
|
||||
(accounts (get-option pagename-accounts
|
||||
optname-accounts))
|
||||
(do-subtotals? (get-option pagename-accounts
|
||||
optname-include-subbalances))
|
||||
(show-fcur? (get-option pagename-currencies
|
||||
optname-show-foreign))
|
||||
(report-currency (get-option pagename-currencies
|
||||
optname-report-currency))
|
||||
(to-date-tp (gnc:timepair-end-day-time
|
||||
(vector-ref (get-option pagename-general
|
||||
optname-to-date) 1)))
|
||||
(from-date-tp (gnc:timepair-start-day-time
|
||||
(vector-ref (get-option pagename-general
|
||||
optname-from-date) 1)))
|
||||
(doc (gnc:make-html-document))
|
||||
(txt (gnc:make-html-text)))
|
||||
|
||||
(gnc:html-document-set-title! doc "Profit And Loss")
|
||||
(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))
|
||||
;; calculate the exchange rates
|
||||
(exchange-alist (gnc:make-exchange-alist
|
||||
report-currency to-date-tp))
|
||||
(exchange-fn (gnc:make-exchange-function exchange-alist))
|
||||
;; do the processing here
|
||||
(table (gnc:html-build-acct-table
|
||||
from-date-tp to-date-tp
|
||||
tree-depth show-subaccts? accounts
|
||||
#t do-subtotals?
|
||||
show-fcur? report-currency exchange-fn)))
|
||||
|
||||
;; set some column headers
|
||||
(gnc:html-table-set-col-headers!
|
||||
table
|
||||
(list (gnc:make-html-table-header-cell/size
|
||||
1 tree-depth (_ "Account name"))
|
||||
(gnc:make-html-table-header-cell/size
|
||||
1 (if show-fcur?
|
||||
(* 2 tree-depth)
|
||||
tree-depth)
|
||||
(_ "Balance"))))
|
||||
|
||||
;; add the table
|
||||
(gnc:html-document-add-object! doc table)
|
||||
|
||||
;; add the currency information
|
||||
(gnc:html-print-exchangerates!
|
||||
txt report-currency exchange-alist)
|
||||
|
||||
;;(if show-fcur?
|
||||
(gnc:html-document-add-object! doc txt))
|
||||
|
||||
;; error condition: no accounts specified
|
||||
(let ((p (gnc:make-html-text)))
|
||||
(gnc:html-text-append!
|
||||
p
|
||||
(gnc:html-markup-h2 (_ "No accounts selected"))
|
||||
(gnc:html-markup-p
|
||||
(_ "This report requires accounts to be selected.")))
|
||||
(gnc:html-document-add-object! doc p)))
|
||||
doc))
|
||||
|
||||
(gnc:define-report
|
||||
'version 1
|
||||
'name (_ "Profit And Loss")
|
||||
'options-generator pnl-options-generator
|
||||
'renderer pnl-renderer))
|
||||
Loading…
Reference in new issue