IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity
Files
d28ff20ff7e4ed3e50ec7bb45b2649ac8ecea185
gnucash/gnucash/report/reports/standard/net-charts.scm
Christopher Lam 114758190e Bugfix: export-code for category-barchart reports would fail. 
This stems from trying to handle file-name when calling export code.

Export code no longer require file-name, The export-code returns a
string in the html-document object instead. Remove all file-name
handling in reports. No backward compatibility issues because most
users would not copy a GnuCash >=4.6 report code onto a <4.5
installation.
2021-03-29 16:41:47 +08:00

529 lines
20 KiB
Scheme
Raw Blame History

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; net-charts.scm : Display a time series line or bar chart for
;; either net worth or net profit.
;;
;; By Robert Merkel <rgmerk@mira.net>
;; and Christian Stimming <stimming@tu-harburg.de>
;; and Mike Evans <mikee@saxicooa.co.uk>
;; and Christopher Lam to combine with net-barchart.scm
;;
;; 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
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash reports standard net-charts))
(use-modules (gnucash engine))
(use-modules (gnucash utilities))
(use-modules (gnucash core-utils))
(use-modules (gnucash app-utils))
(use-modules (gnucash report))
(use-modules (srfi srfi-1))
(use-modules (srfi srfi-26))
(define optname-from-date (N_ "Start Date"))
(define optname-to-date (N_ "End Date"))
(define optname-stepsize (N_ "Step Size"))
(define optname-report-currency (N_ "Report's currency"))
(define optname-price-source (N_ "Price Source"))
(define optname-accounts (N_ "Accounts"))
(define optname-inc-exp (N_ "Show Income/Expense"))
(define optname-show-profit (N_ "Show Net Profit"))
(define optname-sep-bars (N_ "Show Asset & Liability"))
(define optname-net-bars (N_ "Show Net Worth"))
(define optname-plot-width (N_ "Plot Width"))
(define optname-plot-height (N_ "Plot Height"))
(define optname-line-width (N_ "Line Width"))
(define opthelp-line-width (N_ "Set line width in pixels."))
(define optname-markers (N_ "Data markers?"))
;;(define optname-x-grid (N_ "X grid"))
(define optname-y-grid (N_ "Grid"))
(define (options-generator inc-exp? linechart?)
(let* ((options (gnc:new-options))
;; This is just a helper function for making options.
;; See libgnucash/scm/options.scm for details.
(add-option
(lambda (new-option)
(gnc:register-option options new-option))))
;; General tab
(gnc:options-add-date-interval!
options gnc:pagename-general
optname-from-date optname-to-date "a")
(gnc:options-add-interval-choice!
options gnc:pagename-general optname-stepsize "b" 'MonthDelta)
(gnc:options-add-currency!
options gnc:pagename-general optname-report-currency "c")
(gnc:options-add-price-source!
options gnc:pagename-general
optname-price-source "d" 'weighted-average)
;; Account tab
(add-option
(gnc:make-account-list-option
gnc:pagename-accounts optname-accounts
"a"
(N_ "Report on these accounts, if chosen account level allows.")
(lambda ()
(filter
(if inc-exp?
gnc:account-is-inc-exp?
(lambda (account) (not (gnc:account-is-inc-exp? account))))
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
(lambda (accounts)
(list #t
(filter
(if inc-exp?
gnc:account-is-inc-exp?
(lambda (account)
(not (gnc:account-is-inc-exp? account))))
accounts)))
#t))
;; Display tab
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display
(if inc-exp? optname-inc-exp optname-sep-bars)
"a"
(if inc-exp?
(N_ "Show Income and Expenses?")
(N_ "Show the Asset and the Liability bars?"))
#t))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display
(if inc-exp? optname-show-profit optname-net-bars)
"b"
(if inc-exp?
(N_ "Show the net profit?")
(N_ "Show a Net Worth bar?"))
#t))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display
(N_ "Show table")
"c" (N_ "Display a table of the selected data.")
#f))
(gnc:options-add-plot-size!
options gnc:pagename-display
optname-plot-width optname-plot-height "d" (cons 'percent 100.0) (cons 'percent 100.0))
(if linechart?
(begin
(add-option
(gnc:make-number-range-option
gnc:pagename-display optname-line-width
"e" opthelp-line-width
1.5 0.5 5 1 0.1 ))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-y-grid
"f" (N_ "Add grid lines.")
#t))
;;(add-option
;; (gnc:make-simple-boolean-option
;; gnc:pagename-display optname-x-grid
;; "g" (N_ "Add vertical grid lines.")
;; #f))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-markers
"g" (N_ "Display a mark for each data point.")
#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 <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 (net-renderer report-obj inc-exp? linechart? export-type)
;; This is a helper function for looking up option values.
(define (get-option section name)
(gnc:option-value
(gnc:lookup-option (gnc:report-options report-obj) section name)))
(gnc:report-starting "INC/EXP & A/L Charts")
(let* ((to-date-t64 (gnc:time64-end-day-time
(gnc:date-option-absolute-time
(get-option gnc:pagename-general
optname-to-date))))
(from-date-t64 (gnc:time64-start-day-time
(gnc:date-option-absolute-time
(get-option gnc:pagename-general
optname-from-date))))
(interval (get-option gnc:pagename-general optname-stepsize))
(report-currency (get-option gnc:pagename-general optname-report-currency))
(price-source (get-option gnc:pagename-general optname-price-source))
(accounts (get-option gnc:pagename-accounts optname-accounts))
(show-sep? (get-option gnc:pagename-display (if inc-exp?
optname-inc-exp
optname-sep-bars)))
(show-net? (get-option gnc:pagename-display (if inc-exp?
optname-show-profit
optname-net-bars)))
(height (get-option gnc:pagename-display optname-plot-height))
(width (get-option gnc:pagename-display optname-plot-width))
(markers (and linechart?
(if (get-option gnc:pagename-display optname-markers) 3 0)))
(line-width (and linechart?
(get-option gnc:pagename-display optname-line-width)))
(y-grid (or (not linechart?) (get-option gnc:pagename-display optname-y-grid)))
;;(x-grid (if linechart? (get-option gnc:pagename-display optname-x-grid)))
(commodity-list #f)
(exchange-fn #f)
(dates-list (gnc:make-date-list
((if inc-exp?
gnc:time64-start-day-time
gnc:time64-end-day-time)
from-date-t64)
(gnc:time64-end-day-time to-date-t64)
(gnc:deltasym-to-delta interval)))
(report-title (get-option gnc:pagename-general gnc:optname-reportname))
(classified-accounts (gnc:decompose-accountlist accounts))
(show-table? (get-option gnc:pagename-display (N_ "Show table")))
(document (gnc:make-html-document))
(chart (gnc:make-html-chart)))
;; This exchanges the commodity-collector 'c' to one single
;; 'report-currency' according to the exchange-fn. Returns a gnc:monetary
(define (collector->monetary c date)
(gnc:sum-collector-commodity c report-currency (cut exchange-fn <> <> date)))
;; gets an account alist balances
;; output: (list acc bal0 bal1 bal2 ...)
(define (account->balancelist account)
(let ((comm (xaccAccountGetCommodity account)))
(cons account
(gnc:account-accumulate-at-dates
account dates-list
#:split->elt (lambda (s)
(gnc:make-gnc-monetary
comm (xaccSplitGetNoclosingBalance s)))
#:nosplit->elt (gnc:make-gnc-monetary comm 0)))))
;; This calculates the balances for all the 'account-balances' for
;; each element of the list 'dates'. Uses the collector->monetary
;; conversion function above. Returns a list of gnc-monetary.
(define (process-datelist account-balances dates left-col?)
(define accountlist
(if inc-exp?
(if left-col?
(assoc-ref classified-accounts ACCT-TYPE-INCOME)
(assoc-ref classified-accounts ACCT-TYPE-EXPENSE))
(if left-col?
(assoc-ref classified-accounts ACCT-TYPE-ASSET)
(assoc-ref classified-accounts ACCT-TYPE-LIABILITY))))
(define filtered-account-balances
(filter
(lambda (a)
(member (car a) accountlist))
account-balances))
(define (acc-balances->list-of-balances lst)
;; input: (list (list acc1 bal0 bal1 bal2 ...)
;; (list acc2 bal0 bal1 bal2 ...) ...)
;; whereby list of balances are gnc-monetary objects
;; output: (list <mon-coll0> <mon-coll1> <mon-coll2>)
(define (call thunk) (thunk))
(if (null? lst)
(map call (make-list (length dates) gnc:make-commodity-collector))
(apply map gnc:monetaries-add (map cdr lst))))
(let loop ((dates dates)
(acct-balances (acc-balances->list-of-balances filtered-account-balances))
(result '()))
(if (if inc-exp?
(null? (cdr dates))
(null? dates))
(reverse result)
(loop (cdr dates)
(cdr acct-balances)
(cons
(collector->monetary
(if inc-exp?
(gnc:collector- (car acct-balances) (cadr acct-balances))
(car acct-balances))
(if inc-exp? (cadr dates) (car dates)))
result)))))
(gnc:report-percent-done 1)
(set! commodity-list (gnc:accounts-get-commodities
(gnc:accounts-and-all-descendants accounts)
report-currency))
(gnc:report-percent-done 10)
(set! exchange-fn (gnc:case-exchange-time-fn
price-source report-currency
commodity-list to-date-t64
10 40))
(gnc:report-percent-done 50)
(if
(not (null? accounts))
(let* ((account-balancelist (map account->balancelist accounts))
(dummy (gnc:report-percent-done 60))
(minuend-balances (process-datelist account-balancelist dates-list #t))
(dummy (gnc:report-percent-done 70))
(subtrahend-balances (process-datelist account-balancelist dates-list #f))
(dummy (gnc:report-percent-done 80))
(difference-balances (map gnc:monetary+ minuend-balances subtrahend-balances))
(dates-list (if inc-exp?
(list-head dates-list (1- (length dates-list)))
dates-list))
(date-string-list (map qof-print-date dates-list)))
(gnc:report-percent-done 90)
(gnc:html-chart-set-type! chart (if linechart? 'line 'bar))
(gnc:html-chart-set-width! chart width)
(gnc:html-chart-set-height! chart height)
(gnc:html-chart-set-title!
chart (list report-title
(format #f (G_ "~a to ~a")
(qof-print-date from-date-t64)
(qof-print-date to-date-t64))))
(gnc:html-chart-set-y-axis-label!
chart (gnc-commodity-get-mnemonic report-currency))
(gnc:html-chart-set-grid?! chart y-grid)
(gnc:html-chart-set-currency-iso!
chart (gnc-commodity-get-mnemonic report-currency))
(gnc:html-chart-set-currency-symbol!
chart (gnc-commodity-get-nice-symbol report-currency))
(gnc:html-chart-set-data-labels! chart date-string-list)
(when show-sep?
(gnc:html-chart-add-data-series!
chart
(if inc-exp? (G_ "Income") (G_ "Assets"))
(map gnc:gnc-monetary-amount minuend-balances)
"#0074D9"
'fill (not linechart?)
'pointRadius markers
'borderWidth line-width
'urls (gnc:make-report-anchor
(if inc-exp?
category-barchart-income-uuid
category-barchart-asset-uuid)
report-obj
(list
(list gnc:pagename-display "Use Stacked Charts" #t)
(list gnc:pagename-general
gnc:optname-reportname
(if inc-exp?
(G_ "Income Chart")
(G_ "Asset Chart"))))))
(gnc:html-chart-add-data-series!
chart
(if inc-exp? (G_ "Expense") (G_ "Liabilities"))
(map - (map gnc:gnc-monetary-amount subtrahend-balances))
"#FF4136"
'fill (not linechart?)
'pointRadius markers
'borderWidth line-width
'urls (gnc:make-report-anchor
(if inc-exp?
category-barchart-expense-uuid
category-barchart-liability-uuid)
report-obj
(list
(list gnc:pagename-display "Use Stacked Charts" #t)
(list gnc:pagename-general
gnc:optname-reportname
(if inc-exp?
(G_ "Expense Chart")
(G_ "Liability Chart")))))))
(when show-net?
(gnc:html-chart-add-data-series!
chart
(if inc-exp? (G_ "Net Profit") (G_ "Net Worth"))
(map gnc:gnc-monetary-amount difference-balances)
"#2ECC40"
'fill (not linechart?)
'pointRadius markers
'borderWidth line-width))
;; Test for all-zero data here.
(if (gnc:not-all-zeros (map gnc:gnc-monetary-amount
(append minuend-balances
subtrahend-balances
difference-balances)))
(begin
(gnc:html-document-add-object! document chart)
(if show-table?
(let ((table (gnc:make-html-table)))
(gnc:html-table-set-style!
table "table"
'attribute (list "border" 0)
'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 4))
(gnc:html-table-set-col-headers!
table
(append
(list (G_ "Date"))
(if show-sep?
(if inc-exp?
(list (G_ "Income") (G_ "Expense"))
(list (G_ "Assets") (G_ "Liabilities")))
'())
(if show-net?
(if inc-exp?
(list (G_ "Net Profit"))
(list (G_ "Net Worth")))
'())))
(for-each
(lambda (date minuend subtrahend difference)
(gnc:html-table-append-row!
table
(cons date
(map
(cut gnc:make-html-table-cell/markup "number-cell" <>)
(append (if show-sep? (list minuend subtrahend) '())
(if show-net? (list difference) '()))))))
date-string-list
minuend-balances
subtrahend-balances
difference-balances)
(gnc:html-document-add-object! document table)))
(cond
((eq? export-type 'csv)
(let ((iso-date (qof-date-format-get-string QOF-DATE-FORMAT-ISO)))
(gnc:html-document-set-export-string
document
(gnc:lists->csv
(cons (if inc-exp?
(map G_ '("Date" "Income" "Expense" "Net Profit"))
(map G_ '("Date" "Assets" "Liabilities" "Net Worth")))
(map list
(map (cut gnc-print-time64 <> iso-date) dates-list)
minuend-balances
subtrahend-balances difference-balances))))))))
(gnc:html-document-add-object!
document
(gnc:html-make-empty-data-warning
report-title (gnc:report-id report-obj)))))
;; else no accounts selected
(gnc:html-document-add-object!
document
(gnc:html-make-no-account-warning
report-title (gnc:report-id report-obj))))
(unless (gnc:html-document-export-string document)
(gnc:html-document-set-export-error document (G_ "No exportable data")))
(gnc:report-finished)
document))
;; Export reports
(export net-worth-barchart-uuid)
(export net-worth-linechart-uuid)
(export income-expense-barchart-uuid)
(define net-worth-linechart-uuid "d8b63264186b11e19038001558291366")
(define net-worth-barchart-uuid "cbba1696c8c24744848062c7f1cf4a72")
(define income-expense-barchart-uuid "80769921e87943adade887b9835a7685")
;; Here we define the actual report
(gnc:define-report
'version 1
'name (N_ "Net Worth Barchart")
'report-guid net-worth-barchart-uuid
'menu-path (list gnc:menuname-asset-liability)
'options-generator (lambda () (options-generator #f #f))
'renderer (lambda (report-obj) (net-renderer report-obj #f #f #f))
'export-types '(("CSV" . csv))
'export-thunk (lambda (report-obj export-type)
(net-renderer report-obj #f #f export-type)))
(gnc:define-report
'version 1
'name (N_ "Income/Expense Chart")
'report-guid income-expense-barchart-uuid
'menu-name (N_ "Income & Expense Barchart")
'menu-path (list gnc:menuname-income-expense)
'options-generator (lambda () (options-generator #t #f))
'renderer (lambda (report-obj) (net-renderer report-obj #t #f #f))
'export-types '(("CSV" . csv))
'export-thunk (lambda (report-obj export-type)
(net-renderer report-obj #t #f export-type)))
(gnc:define-report
'version 1
'name (N_ "Net Worth Linechart")
'report-guid net-worth-linechart-uuid
'menu-path (list gnc:menuname-asset-liability)
'options-generator (lambda () (options-generator #f #t))
'renderer (lambda (report-obj) (net-renderer report-obj #f #t #f))
'export-types '(("CSV" . csv))
'export-thunk (lambda (report-obj export-type)
(net-renderer report-obj #f #t export-type)))
;; Not sure if a line chart makes sense for Income & Expense
;; Feel free to uncomment and try it though
(gnc:define-report
'version 1
'name (N_ "Income & Expense Linechart")
'report-guid "e533c998186b11e1b2e2001558291366"
'menu-name (N_ "Income & Expense Linechart")
'menu-path (list gnc:menuname-income-expense)
'options-generator (lambda () (options-generator #t #t))
'renderer (lambda (report-obj) (net-renderer report-obj #t #t #f))
'export-types '(("CSV" . csv))
'export-thunk (lambda (report-obj export-type)
(net-renderer report-obj #t #t export-type)))
Reference in New Issue View Git Blame Copy Permalink