gnucash maint: Multiple changes pushed
John Ralls
jralls at code.gnucash.org
Thu Jun 14 13:58:23 EDT 2018
Updated via https://github.com/Gnucash/gnucash/commit/55400160 (commit)
via https://github.com/Gnucash/gnucash/commit/0efe32ea (commit)
via https://github.com/Gnucash/gnucash/commit/754c0478 (commit)
via https://github.com/Gnucash/gnucash/commit/be1ebb9d (commit)
via https://github.com/Gnucash/gnucash/commit/66488bbb (commit)
via https://github.com/Gnucash/gnucash/commit/ffd20b2e (commit)
via https://github.com/Gnucash/gnucash/commit/2e4e18e2 (commit)
via https://github.com/Gnucash/gnucash/commit/7de68cef (commit)
via https://github.com/Gnucash/gnucash/commit/1fc5634c (commit)
from https://github.com/Gnucash/gnucash/commit/8cae602e (commit)
commit 554001604ad653926c53dff8e9f7170bd865c84e
Merge: 0efe32e 754c047
Author: John Ralls <jralls at ceridwen.us>
Date: Thu Jun 14 10:52:42 2018 -0700
Merge Chris Lam's 'maint-chartjs-part-1' into maint.
commit 0efe32ea73197162a1bb5ee75338ee3d7ecdac1d
Merge: 8cae602 2e4e18e
Author: John Ralls <jralls at ceridwen.us>
Date: Thu Jun 14 09:52:19 2018 -0700
Merge Chris Lam's 'maint-test-net-charts' into maint.
commit 754c047892dd387b07ea35b2c3356f886e7b27dc
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Jan 4 20:25:31 2018 +1100
[net-charts] styling table for all charts
diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm
index 6758826..9e1e885 100644
--- a/gnucash/report/standard-reports/net-charts.scm
+++ b/gnucash/report/standard-reports/net-charts.scm
@@ -499,12 +499,11 @@
(gnc:html-document-add-object! document chart)
(if show-table?
(let ((table (gnc:make-html-table)))
- (if linechart?
- (gnc:html-table-set-style!
- table "table"
- 'attribute (list "border" 0)
- 'attribute (list "cellspacing" 0)
- 'attribute (list "cellpadding" 4)))
+ (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
commit be1ebb9d32246b18f3c5cab77d43e06db46c4625
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Jan 4 20:24:43 2018 +1100
[net-charts] use scheme rationals directly
diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm
index 5c55fe4..6758826 100644
--- a/gnucash/report/standard-reports/net-charts.scm
+++ b/gnucash/report/standard-reports/net-charts.scm
@@ -256,7 +256,7 @@
(define (monetary+ a b)
(if (and (gnc:gnc-monetary? a) (gnc:gnc-monetary? b))
(let ((same-currency? (gnc-commodity-equal (gnc:gnc-monetary-commodity a) (gnc:gnc-monetary-commodity b)))
- (amount (gnc-numeric-add (gnc:gnc-monetary-amount a) (gnc:gnc-monetary-amount b) GNC-DENOM-AUTO GNC-RND-ROUND)))
+ (amount (+ (gnc:gnc-monetary-amount a) (gnc:gnc-monetary-amount b))))
(if same-currency?
(gnc:make-gnc-monetary (gnc:gnc-monetary-commodity a) amount)
(warn "incompatible currencies in monetary+: " a b)))
commit 66488bbb1acf902c7304904f210240c9b43786dc
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Jan 4 19:38:59 2018 +1100
[net-charts] *reindent/whitespace*
diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm
index 65a4997..5c55fe4 100644
--- a/gnucash/report/standard-reports/net-charts.scm
+++ b/gnucash/report/standard-reports/net-charts.scm
@@ -64,8 +64,6 @@
;;(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.
@@ -139,39 +137,38 @@
"c" (N_ "Display a table of the selected data.")
#f))
- (gnc:options-add-plot-size!
- options gnc:pagename-display
+ (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-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-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-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))
+ (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)
@@ -190,29 +187,25 @@
(gnc:option-value
(gnc:lookup-option (gnc:report-options report-obj) section name)))
- (gnc:report-starting "reportname")
+ (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))))
+ (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))))
+ (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))
-
+ (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)))
+ (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 (if linechart?
@@ -220,11 +213,9 @@
(line-width (if linechart?
(get-option gnc:pagename-display optname-line-width)))
(y-grid (if linechart? (get-option gnc:pagename-display optname-y-grid)))
- ;;(x-grid (get-option gnc:pagename-display optname-x-grid))
-
+ ;;(x-grid (if linechart? (get-option gnc:pagename-display optname-x-grid)))
(commodity-list #f)
(exchange-fn #f)
-
(dates-list ((if inc-exp?
gnc:make-date-interval-list
gnc:make-date-list)
@@ -234,8 +225,7 @@
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))
+ (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))
@@ -248,7 +238,8 @@
(begin
((if linechart?
gnc:html-linechart-append-column!
- gnc:html-barchart-append-column!) chart data-list)
+ gnc:html-barchart-append-column!)
+ chart data-list)
(if (gnc:not-all-zeros data-list) (set! non-zeros #t))
#f))
@@ -256,7 +247,7 @@
;; 'report-currency' according to the exchange-fn. Returns a gnc:monetary
(define (collector->monetary c date)
(if (not (number? date))
- (throw 'wrong))
+ (throw 'wrong))
(gnc:sum-collector-commodity
c report-currency
(lambda (a b) (exchange-fn a b date))))
@@ -310,86 +301,83 @@
(set! exchange-fn (gnc:case-exchange-time-fn
price-source report-currency
commodity-list to-date-t64
- 10 40))
+ 10 40))
(gnc:report-percent-done 50)
(if
(not (null? accounts))
- (let* ((assets-list #f)
- (liability-list #f)
- (net-list #f)
- (progress-range (cons 50 80))
+ (let* ((the-account-destination-alist
+ (if inc-exp?
+ (append (map (lambda (account) (cons account 'asset))
+ (assoc-ref classified-accounts ACCT-TYPE-INCOME))
+ (map (lambda (account) (cons account 'liability))
+ (assoc-ref classified-accounts ACCT-TYPE-EXPENSE)))
+ (append (map (lambda (account) (cons account 'asset))
+ (assoc-ref classified-accounts ACCT-TYPE-ASSET))
+ (map (lambda (account) (cons account 'liability))
+ (assoc-ref classified-accounts ACCT-TYPE-LIABILITY)))))
+ (account-reformat (if inc-exp?
+ (lambda (account result)
+ (map (lambda (collector date-interval)
+ (gnc:monetary-neg (collector->monetary collector (second date-interval))))
+ result dates-list))
+ (lambda (account result)
+ (let ((commodity-collector (gnc:make-commodity-collector)))
+ (collector-end (fold (lambda (next date list-collector)
+ (commodity-collector 'merge next #f)
+ (collector-add list-collector
+ (collector->monetary
+ commodity-collector date)))
+ (collector-into-list)
+ result
+ dates-list))))))
+ (work (category-by-account-report-work inc-exp?
+ dates-list
+ the-account-destination-alist
+ (lambda (account date)
+ (make-gnc-collector-collector))
+ account-reformat))
+ (rpt (category-by-account-report-do-work work (cons 50 90)))
+ (assets (assoc-ref rpt 'asset))
+ (liabilities (assoc-ref rpt 'liability))
+ (assets-list (if assets
+ (car assets)
+ (map (lambda (d)
+ (gnc:make-gnc-monetary report-currency 0))
+ dates-list)))
+ (liability-list (if liabilities
+ (car liabilities)
+ (map (lambda (d)
+ (gnc:make-gnc-monetary report-currency 0))
+ dates-list)))
+ (net-list (map monetary+ assets-list liability-list))
;; Here the date strings for the x-axis labels are
;; created.
- (date-iso-string-list '())
- (save-fmt (qof-date-format-get)))
-
- (define (datelist->stringlist dates-list)
- (map (lambda (date-list-item)
- (qof-print-date
- (if inc-exp?
- (car date-list-item)
- date-list-item)))
- dates-list))
-
- (define date-string-list
- (if linechart?
- (datelist->stringlist dates-list)
- (map
- (if inc-exp?
- (lambda (date-list-item)
- (qof-print-date
- (car date-list-item)))
- qof-print-date)
- dates-list)))
-
- (let* ((the-acount-destination-alist
- (if inc-exp?
- (append (map (lambda (account) (cons account 'asset))
- (assoc-ref classified-accounts ACCT-TYPE-INCOME))
- (map (lambda (account) (cons account 'liability))
- (assoc-ref classified-accounts ACCT-TYPE-EXPENSE)))
- (append (map (lambda (account) (cons account 'asset))
- (assoc-ref classified-accounts ACCT-TYPE-ASSET))
- (map (lambda (account) (cons account 'liability))
- (assoc-ref classified-accounts ACCT-TYPE-LIABILITY)))))
- (account-reformat (if inc-exp?
- (lambda (account result)
- (map (lambda (collector date-interval)
- (gnc:monetary-neg (collector->monetary collector (second date-interval))))
- result dates-list))
- (lambda (account result)
- (let ((commodity-collector (gnc:make-commodity-collector)))
- (collector-end (fold (lambda (next date list-collector)
- (commodity-collector 'merge next #f)
- (collector-add list-collector
- (collector->monetary
- commodity-collector date)))
- (collector-into-list)
- result
- dates-list))))))
- (work (category-by-account-report-work inc-exp?
- dates-list
- the-acount-destination-alist
- (lambda (account date)
- (make-gnc-collector-collector))
- account-reformat))
- (rpt (category-by-account-report-do-work work progress-range))
- (assets (assoc-ref rpt 'asset))
- (liabilities (assoc-ref rpt 'liability)))
- (set! assets-list (if assets (car assets)
- (map (lambda (d)
- (gnc:make-gnc-monetary report-currency 0))
- dates-list)))
- (set! liability-list (if liabilities (car liabilities)
- (map (lambda (d)
- (gnc:make-gnc-monetary report-currency 0))
- dates-list)))
- )
-
- (gnc:report-percent-done 80)
- (set! net-list
- (map monetary+ assets-list liability-list))
+ (datelist->stringlist (lambda (dates-list)
+ (map (lambda (date-list-item)
+ (qof-print-date
+ (if inc-exp?
+ (car date-list-item)
+ date-list-item)))
+ dates-list)))
+
+ (date-string-list (if linechart?
+ (datelist->stringlist dates-list)
+ (map
+ (if inc-exp?
+ (lambda (date-list-item)
+ (qof-print-date
+ (car date-list-item)))
+ qof-print-date)
+ dates-list)))
+
+ (date-iso-string-list (let ((save-fmt (qof-date-format-get))
+ (retlist #f))
+ (qof-date-format-set QOF-DATE-FORMAT-ISO)
+ (set! retlist (datelist->stringlist dates-list))
+ (qof-date-format-set save-fmt)
+ retlist)))
+
(gnc:report-percent-done 90)
((if linechart?
@@ -415,9 +403,6 @@
(if linechart?
(begin
- (qof-date-format-set QOF-DATE-FORMAT-ISO)
- (set! date-iso-string-list (datelist->stringlist dates-list))
- (qof-date-format-set save-fmt)
(gnc:html-linechart-set-row-labels! chart date-iso-string-list)
(gnc:html-linechart-set-major-grid?! chart y-grid))
(gnc:html-barchart-set-row-labels! chart date-string-list))
@@ -431,7 +416,7 @@
(if show-sep?
(begin
(add-column! (map monetary->double assets-list))
- (add-column! ;;(if inc-exp?
+ (add-column! ;;(if inc-exp?
(map - (map monetary->double liability-list))
;;liability-list)
)))
@@ -463,102 +448,102 @@
(if show-net?
'("#2ECC40") '())))
- ;; Set the line width and markers
+ ;; Set the line width and markers
(if linechart?
(begin
(gnc:html-linechart-set-line-width! chart line-width)
(gnc:html-linechart-set-markers?! chart markers)))
;; URLs for income/expense or asset/liabilities bars.
-;; (if show-sep?
-;; (let ((urls
-;; (list
-;; (gnc:make-report-anchor
-;; (if inc-exp?
-;; category-barchart-income-uuid
-;; category-barchart-asset-uuid)
-;; report-obj
-;; (list
-;; (list gnc:pagename-display
-;; (if linechart? "Use Stacked Lines" "Use Stacked Bars") #t)
-;; (list gnc:pagename-general
-;; gnc:optname-reportname
-;; (if inc-exp?
-;; (_ "Income Chart")
-;; (_ "Asset Chart")))))
-;; (gnc:make-report-anchor
-;; (if inc-exp?
-;; category-barchart-expense-uuid
-;; category-barchart-liability-uuid)
-;; report-obj
-;; (list
-;; (list gnc:pagename-display
-;; (if linechart? "Use Stacked Lines" "Use Stacked Bars") #t)
-;; (list gnc:pagename-general
-;; gnc:optname-reportname
-;; (if inc-exp?
-;; (_ "Expense Chart")
-;; (_ "Liability Chart"))))))))
-;; ((if linechart?
-;; gnc:html-linechart-set-button-1-line-urls!
-;; gnc:html-barchart-set-button-1-line-urls!)
-;; chart urls)
-;; ((if linechart?
-;; gnc:html-linechart-set-button-1-legend-urls!
-;; gnc:html-barchart-set-button-1-legend-urls!)
-;; chart urls)))
+ ;; (if show-sep?
+ ;; (let ((urls
+ ;; (list
+ ;; (gnc:make-report-anchor
+ ;; (if inc-exp?
+ ;; category-barchart-income-uuid
+ ;; category-barchart-asset-uuid)
+ ;; report-obj
+ ;; (list
+ ;; (list gnc:pagename-display
+ ;; (if linechart? "Use Stacked Lines" "Use Stacked Bars") #t)
+ ;; (list gnc:pagename-general
+ ;; gnc:optname-reportname
+ ;; (if inc-exp?
+ ;; (_ "Income Chart")
+ ;; (_ "Asset Chart")))))
+ ;; (gnc:make-report-anchor
+ ;; (if inc-exp?
+ ;; category-barchart-expense-uuid
+ ;; category-barchart-liability-uuid)
+ ;; report-obj
+ ;; (list
+ ;; (list gnc:pagename-display
+ ;; (if linechart? "Use Stacked Lines" "Use Stacked Bars") #t)
+ ;; (list gnc:pagename-general
+ ;; gnc:optname-reportname
+ ;; (if inc-exp?
+ ;; (_ "Expense Chart")
+ ;; (_ "Liability Chart"))))))))
+ ;; ((if linechart?
+ ;; gnc:html-linechart-set-button-1-line-urls!
+ ;; gnc:html-barchart-set-button-1-line-urls!)
+ ;; chart urls)
+ ;; ((if linechart?
+ ;; gnc:html-linechart-set-button-1-legend-urls!
+ ;; gnc:html-barchart-set-button-1-legend-urls!)
+ ;; chart urls)))
;; Test for all-zero data here.
(if non-zeros
(begin
- (gnc:html-document-add-object! document chart)
+ (gnc:html-document-add-object! document chart)
(if show-table?
- (let ((table (gnc:make-html-table)))
- (if linechart?
- (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 (_ "Date"))
- (if show-sep?
- (if inc-exp?
- (list (_ "Income") (_ "Expense"))
- (list (_ "Assets") (_ "Liabilities")))
- '())
- (if show-net?
- (if inc-exp?
- (list (_ "Net Profit"))
- (list (_ "Net Worth")))
- '()))
- )
- (gnc:html-table-append-column! table date-string-list)
- (if show-sep?
- (begin
- (gnc:html-table-append-column! table assets-list)
- (gnc:html-table-append-column! table liability-list)
+ (let ((table (gnc:make-html-table)))
+ (if linechart?
+ (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 (_ "Date"))
+ (if show-sep?
+ (if inc-exp?
+ (list (_ "Income") (_ "Expense"))
+ (list (_ "Assets") (_ "Liabilities")))
+ '())
+ (if show-net?
+ (if inc-exp?
+ (list (_ "Net Profit"))
+ (list (_ "Net Worth")))
+ '()))
)
- )
- (if show-net?
- (gnc:html-table-append-column! table net-list)
- )
- ;; set numeric columns to align right
- (for-each
- (lambda (col)
- (gnc:html-table-set-col-style!
- table col "td"
- 'attribute (list "class" "number-cell")))
- '(1 2 3))
-
- (gnc:html-document-add-object! document table))
- ))
+ (gnc:html-table-append-column! table date-string-list)
+ (if show-sep?
+ (begin
+ (gnc:html-table-append-column! table assets-list)
+ (gnc:html-table-append-column! table liability-list)
+ )
+ )
+ (if show-net?
+ (gnc:html-table-append-column! table net-list)
+ )
+ ;; set numeric columns to align right
+ (for-each
+ (lambda (col)
+ (gnc:html-table-set-col-style!
+ table col "td"
+ 'attribute (list "class" "number-cell")))
+ '(1 2 3))
+
+ (gnc:html-document-add-object! document table))
+ ))
(gnc:html-document-add-object!
document
(gnc:html-make-empty-data-warning
- report-title (gnc:report-id report-obj)))))
+ report-title (gnc:report-id report-obj)))))
;; else no accounts selected
(gnc:html-document-add-object!
commit ffd20b2e2f9a4078fb324b45d14daaff840c0b12
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Jan 4 19:19:32 2018 +1100
[net-charts] combine net-[bar|line]chart.scm into net-charts.scm
This commit combines both charts into one. This can improve ease of
maintenance.
diff --git a/gnucash/report/standard-reports/CMakeLists.txt b/gnucash/report/standard-reports/CMakeLists.txt
index fe7e8d3..adda1e4 100644
--- a/gnucash/report/standard-reports/CMakeLists.txt
+++ b/gnucash/report/standard-reports/CMakeLists.txt
@@ -23,8 +23,7 @@ set (standard_reports_SCHEME_2
general-ledger.scm
income-gst-statement.scm
income-statement.scm
- net-barchart.scm
- net-linechart.scm
+ net-charts.scm
portfolio.scm
price-scatter.scm
register.scm
diff --git a/gnucash/report/standard-reports/net-barchart.scm b/gnucash/report/standard-reports/net-barchart.scm
deleted file mode 100644
index dc3e5c2..0000000
--- a/gnucash/report/standard-reports/net-barchart.scm
+++ /dev/null
@@ -1,492 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; net-barchart.scm : Display a time series for either net worth or
-;; net profit.
-;;
-;; By Robert Merkel <rgmerk at mira.net>
-;; and Christian Stimming <stimming at 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
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-module (gnucash report standard-reports net-barchart))
-
-(use-modules (srfi srfi-1))
-(use-modules (gnucash utilities))
-(use-modules (gnucash gnc-module))
-(use-modules (gnucash gettext))
-
-(use-modules (gnucash report report-system report-collectors))
-(use-modules (gnucash report report-system collectors))
-(use-modules (gnucash report standard-reports category-barchart)) ; for guids of called reports
-
-(gnc:module-load "gnucash/report/report-system" 0)
-
-(define reportname (N_ "Income/Expense Chart"))
-
-(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 bars"))
-(define optname-net-bars (N_ "Show Net Worth bars"))
-
-(define optname-plot-width (N_ "Plot Width"))
-(define optname-plot-height (N_ "Plot Height"))
-
-(define (options-generator inc-exp?)
- (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))
-
- (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?)
-
- ;; 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 reportname)
- (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))
-
- (commodity-list #f)
- (exchange-fn #f)
-
- (dates-list ((if inc-exp?
- gnc:make-date-interval-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-barchart))
- (non-zeros #f))
-
- (define (add-column! data-list)
- (begin
- (gnc:html-barchart-append-column! chart data-list)
- (if (gnc:not-all-zeros data-list) (set! non-zeros #t))
- #f))
-
- ;; 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)
- (if (not (number? date))
- (throw 'wrong))
- (gnc:sum-collector-commodity
- c report-currency
- (lambda (a b) (exchange-fn a b date))))
-
- ;; Add two gnc-monetary objects in the same currency.
- (define (monetary+ a b)
- (if (and (gnc:gnc-monetary? a) (gnc:gnc-monetary? b))
- (let ((same-currency? (gnc-commodity-equal (gnc:gnc-monetary-commodity a) (gnc:gnc-monetary-commodity b)))
- (amount (gnc-numeric-add (gnc:gnc-monetary-amount a) (gnc:gnc-monetary-amount b) GNC-DENOM-AUTO GNC-RND-ROUND)))
- (if same-currency?
- (gnc:make-gnc-monetary (gnc:gnc-monetary-commodity a) amount)
- (warn "incompatible currencies in monetary+: " a b)))
- (warn "wrong arguments for monetary+: " a b)))
-
- (define (monetary->double monetary)
- (gnc-numeric-to-double (gnc:gnc-monetary-amount monetary)))
-
- ;; This calculates the balances for all the 'accounts' for each
- ;; element of the list 'dates'. If income?==#t, the signs get
- ;; reversed according to income-sign-reverse general option
- ;; settings. Uses the collector->monetary conversion function
- ;; above. Returns a list of gnc-monetary.
- (define (process-datelist accounts dates income?)
- (map
- (lambda (date)
- (collector->monetary
- ((if inc-exp?
- (if income?
- gnc:accounts-get-comm-total-income
- gnc:accounts-get-comm-total-expense)
- gnc:accounts-get-comm-total-assets)
- accounts
- (lambda (account)
- (if inc-exp?
- ;; for inc-exp, 'date' is a pair of time values, else
- ;; it is a time value.
- (gnc:account-get-comm-balance-interval
- account (first date) (second date) #f)
- (gnc:account-get-comm-balance-at-date
- account date #f))))
- (if inc-exp? (second date) date)))
- dates))
-
- (gnc:report-percent-done 1)
- (set! commodity-list (gnc:accounts-get-commodities
- (append
- (gnc:acccounts-get-all-subaccounts accounts)
- 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* ((assets-list #f)
- (liability-list #f)
- (net-list #f)
- (progress-range (cons 50 80))
- (date-string-list (map
- (if inc-exp?
- (lambda (date-list-item)
- (qof-print-date
- (car date-list-item)))
- qof-print-date)
- dates-list)))
- (let* ((the-acount-destination-alist
- (if inc-exp?
- (append (map (lambda (account) (cons account 'asset))
- (assoc-ref classified-accounts ACCT-TYPE-INCOME))
- (map (lambda (account) (cons account 'liability))
- (assoc-ref classified-accounts ACCT-TYPE-EXPENSE)))
- (append (map (lambda (account) (cons account 'asset))
- (assoc-ref classified-accounts ACCT-TYPE-ASSET))
- (map (lambda (account) (cons account 'liability))
- (assoc-ref classified-accounts ACCT-TYPE-LIABILITY)))))
- (account-reformat (if inc-exp?
- (lambda (account result)
- (map (lambda (collector date-interval)
- (gnc:monetary-neg (collector->monetary collector (second date-interval))))
- result dates-list))
- (lambda (account result)
- (let ((commodity-collector (gnc:make-commodity-collector)))
- (collector-end (fold (lambda (next date list-collector)
- (commodity-collector 'merge next #f)
- (collector-add list-collector
- (collector->monetary
- commodity-collector date)))
- (collector-into-list)
- result
- dates-list))))))
- (work (category-by-account-report-work inc-exp?
- dates-list
- the-acount-destination-alist
- (lambda (account date)
- (make-gnc-collector-collector))
- account-reformat))
- (rpt (category-by-account-report-do-work work progress-range))
- (assets (assoc-ref rpt 'asset))
- (liabilities (assoc-ref rpt 'liability)))
- (set! assets-list (if assets (car assets)
- (map (lambda (d)
- (gnc:make-gnc-monetary report-currency 0/1))
- dates-list)))
- (set! liability-list (if liabilities (car liabilities)
- (map (lambda (d)
- (gnc:make-gnc-monetary report-currency 0/1))
- dates-list)))
- )
-
- (gnc:report-percent-done 80)
- (set! net-list
- (map monetary+ assets-list liability-list))
- (gnc:report-percent-done 90)
-
- (gnc:html-barchart-set-title!
- chart report-title)
- (gnc:html-barchart-set-subtitle!
- chart (format #f
- (_ "~a to ~a")
- (gnc:html-string-sanitize (qof-print-date from-date-t64))
- (gnc:html-string-sanitize (qof-print-date to-date-t64))))
- (gnc:html-barchart-set-width! chart width)
- (gnc:html-barchart-set-height! chart height)
- (gnc:html-barchart-set-row-labels! chart date-string-list)
- (gnc:html-barchart-set-y-axis-label!
- chart (gnc-commodity-get-mnemonic report-currency))
- ;; Determine whether we have enough space for horizontal labels
- ;; -- kind of a hack. Assumptions: y-axis labels and legend
- ;; require 200 pixels, and each x-axes label needs 60 pixels.
- ;;(gnc:html-barchart-set-row-labels-rotated?!
- ;; chart (< (/ (- width 200)
- ;; (length date-string-list)) 60))
-
- ;; Add the data
- (if show-sep?
- (begin
- (add-column! (map monetary->double assets-list))
- (add-column! ;;(if inc-exp?
- (map - (map monetary->double liability-list))
- ;;liability-list)
- )))
- (if show-net?
- (add-column! (map monetary->double net-list)))
-
- ;; Legend labels, colors
- (gnc:html-barchart-set-col-labels!
- chart (append
- (if show-sep?
- (if inc-exp?
- (list (_ "Income") (_ "Expense"))
- (list (_ "Assets") (_ "Liabilities")))
- '())
- (if show-net?
- (if inc-exp?
- (list (_ "Net Profit"))
- (list (_ "Net Worth")))
- '())))
- (gnc:html-barchart-set-col-colors!
- chart (append
- (if show-sep?
- '("#0074D9" "#FF4136") '())
- (if show-net?
- '("#2ECC40") '())))
-
- ;; URLs for income/expense or asset/liabilities bars.
-;; (if show-sep?
-;; (let ((urls
-;; (list
-;; (gnc:make-report-anchor
-;; (if inc-exp?
-;; category-barchart-income-uuid
-;; category-barchart-asset-uuid)
-;; report-obj
-;; (list
-;; (list gnc:pagename-display
-;; "Use Stacked Bars" #t)
-;; (list gnc:pagename-general
-;; gnc:optname-reportname
-;; (if inc-exp?
-;; (_ "Income Chart")
-;; (_ "Asset Chart")))))
-;; (gnc:make-report-anchor
-;; (if inc-exp?
-;; category-barchart-expense-uuid
-;; category-barchart-liability-uuid)
-;; report-obj
-;; (list
-;; (list gnc:pagename-display
-;; "Use Stacked Bars" #t)
-;; (list gnc:pagename-general
-;; gnc:optname-reportname
-;; (if inc-exp?
-;; (_ "Expense Chart")
-;; (_ "Liability Chart"))))))))
-;; (gnc:html-barchart-set-button-1-bar-urls!
-;; chart urls)
-;; (gnc:html-barchart-set-button-1-legend-urls!
-;; chart urls)))
-
- ;; Test for all-zero data here.
- (if non-zeros
- (begin
- (gnc:html-document-add-object! document chart)
- (if show-table?
- (let ((table (gnc:make-html-table)))
- (gnc:html-table-set-col-headers!
- table
- (append
- (list (_ "Date"))
- (if show-sep?
- (if inc-exp?
- (list (_ "Income") (_ "Expense"))
- (list (_ "Assets") (_ "Liabilities")))
- '())
- (if show-net?
- (if inc-exp?
- (list (_ "Net Profit"))
- (list (_ "Net Worth")))
- '()))
- )
- (gnc:html-table-append-column! table date-string-list)
- (if show-sep?
- (begin
- (gnc:html-table-append-column! table assets-list)
- (gnc:html-table-append-column! table liability-list)
- )
- )
- (if show-net?
- (gnc:html-table-append-column! table net-list)
- )
- ;; set numeric columns to align right
- (for-each
- (lambda (col)
- (gnc:html-table-set-col-style!
- table col "td"
- 'attribute (list "class" "number-cell")))
- '(1 2 3))
-
- (gnc:html-document-add-object! document table))
- ))
- (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))))
-
- (gnc:report-finished)
- document))
-
-;; Export reports
-
-(export net-worth-barchart-uuid)
-(export income-expense-barchart-uuid)
-
-(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))
- 'renderer (lambda (report-obj) (net-renderer report-obj #f)))
-
-(gnc:define-report
- 'version 1
- 'name reportname
- '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))
- 'renderer (lambda (report-obj) (net-renderer report-obj #t)))
diff --git a/gnucash/report/standard-reports/net-linechart.scm b/gnucash/report/standard-reports/net-charts.scm
similarity index 78%
rename from gnucash/report/standard-reports/net-linechart.scm
rename to gnucash/report/standard-reports/net-charts.scm
index ec8f23a..65a4997 100644
--- a/gnucash/report/standard-reports/net-linechart.scm
+++ b/gnucash/report/standard-reports/net-charts.scm
@@ -1,10 +1,11 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; net-linechart.scm : Display a time series line chart for
+;; net-charts.scm : Display a time series line or bar chart for
;; either net worth or net profit.
;;
;; By Robert Merkel <rgmerk at mira.net>
;; and Christian Stimming <stimming at tu-harburg.de>
;; and Mike Evans <mikee at 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
@@ -25,7 +26,7 @@
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define-module (gnucash report standard-reports net-linechart))
+(define-module (gnucash report standard-reports net-charts))
(use-modules (srfi srfi-1))
(use-modules (gnucash utilities))
@@ -37,7 +38,6 @@
(use-modules (gnucash report standard-reports category-barchart)) ; for guids of called reports
(gnc:module-load "gnucash/report/report-system" 0)
-(define reportname (N_ "Income/Expense Chart"))
(define optname-from-date (N_ "Start Date"))
(define optname-to-date (N_ "End Date"))
@@ -66,7 +66,7 @@
-(define (options-generator inc-exp?)
+(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.
@@ -143,6 +143,8 @@
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
@@ -169,6 +171,8 @@
"g" (N_ "Display a mark for each data point.")
#t))
+ ))
+
(gnc:options-set-default-section options gnc:pagename-general)
options))
@@ -179,14 +183,14 @@
;; 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?)
+(define (net-renderer report-obj inc-exp? linechart?)
;; 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 reportname)
+ (gnc:report-starting "reportname")
(let* ((to-date-t64 (gnc:time64-end-day-time
(gnc:date-option-absolute-time
(get-option gnc:pagename-general
@@ -211,11 +215,12 @@
optname-net-bars)))
(height (get-option gnc:pagename-display optname-plot-height))
(width (get-option gnc:pagename-display optname-plot-width))
- (markers (get-option gnc:pagename-display optname-markers))
-
- (line-width (get-option gnc:pagename-display optname-line-width))
- (y-grid (get-option gnc:pagename-display optname-y-grid))
- ;(x-grid (get-option gnc:pagename-display optname-x-grid))
+ (markers (if linechart?
+ (get-option gnc:pagename-display optname-markers)))
+ (line-width (if linechart?
+ (get-option gnc:pagename-display optname-line-width)))
+ (y-grid (if linechart? (get-option gnc:pagename-display optname-y-grid)))
+ ;;(x-grid (get-option gnc:pagename-display optname-x-grid))
(commodity-list #f)
(exchange-fn #f)
@@ -225,7 +230,8 @@
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)
+ from-date-t64)
(gnc:time64-end-day-time to-date-t64)
(gnc:deltasym-to-delta interval)))
(report-title (get-option gnc:pagename-general
@@ -233,12 +239,16 @@
(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-linechart))
+ (chart (if linechart?
+ (gnc:make-html-linechart)
+ (gnc:make-html-barchart)))
(non-zeros #f))
(define (add-column! data-list)
(begin
- (gnc:html-linechart-append-column! chart data-list)
+ ((if linechart?
+ gnc:html-linechart-append-column!
+ gnc:html-barchart-append-column!) chart data-list)
(if (gnc:not-all-zeros data-list) (set! non-zeros #t))
#f))
@@ -311,18 +321,28 @@
(progress-range (cons 50 80))
;; Here the date strings for the x-axis labels are
;; created.
- (date-string-list '())
(date-iso-string-list '())
(save-fmt (qof-date-format-get)))
(define (datelist->stringlist dates-list)
(map (lambda (date-list-item)
- (qof-print-date
- (if inc-exp?
- (car date-list-item)
- date-list-item)))
+ (qof-print-date
+ (if inc-exp?
+ (car date-list-item)
+ date-list-item)))
dates-list))
+ (define date-string-list
+ (if linechart?
+ (datelist->stringlist dates-list)
+ (map
+ (if inc-exp?
+ (lambda (date-list-item)
+ (qof-print-date
+ (car date-list-item)))
+ qof-print-date)
+ dates-list)))
+
(let* ((the-acount-destination-alist
(if inc-exp?
(append (map (lambda (account) (cons account 'asset))
@@ -359,11 +379,11 @@
(liabilities (assoc-ref rpt 'liability)))
(set! assets-list (if assets (car assets)
(map (lambda (d)
- (gnc:make-gnc-monetary report-currency (gnc-numeric-zero)))
+ (gnc:make-gnc-monetary report-currency 0))
dates-list)))
(set! liability-list (if liabilities (car liabilities)
(map (lambda (d)
- (gnc:make-gnc-monetary report-currency (gnc-numeric-zero)))
+ (gnc:make-gnc-monetary report-currency 0))
dates-list)))
)
@@ -372,23 +392,39 @@
(map monetary+ assets-list liability-list))
(gnc:report-percent-done 90)
- (gnc:html-linechart-set-title!
+ ((if linechart?
+ gnc:html-linechart-set-title!
+ gnc:html-barchart-set-title!)
chart report-title)
- (gnc:html-linechart-set-subtitle!
+
+ ((if linechart?
+ gnc:html-linechart-set-subtitle!
+ gnc:html-barchart-set-subtitle!)
chart (format #f
(_ "~a to ~a")
(qof-print-date from-date-t64)
(qof-print-date to-date-t64)))
- (gnc:html-linechart-set-width! chart width)
- (gnc:html-linechart-set-height! chart height)
- (qof-date-format-set QOF-DATE-FORMAT-ISO)
- (set! date-iso-string-list (datelist->stringlist dates-list))
- (qof-date-format-set save-fmt)
- (gnc:html-linechart-set-row-labels! chart date-iso-string-list)
+ ((if linechart?
+ gnc:html-linechart-set-width!
+ gnc:html-barchart-set-width!) chart width)
+
+ ((if linechart?
+ gnc:html-linechart-set-height!
+ gnc:html-barchart-set-height!) chart height)
- (gnc:html-linechart-set-major-grid?! chart y-grid)
- (gnc:html-linechart-set-y-axis-label!
+ (if linechart?
+ (begin
+ (qof-date-format-set QOF-DATE-FORMAT-ISO)
+ (set! date-iso-string-list (datelist->stringlist dates-list))
+ (qof-date-format-set save-fmt)
+ (gnc:html-linechart-set-row-labels! chart date-iso-string-list)
+ (gnc:html-linechart-set-major-grid?! chart y-grid))
+ (gnc:html-barchart-set-row-labels! chart date-string-list))
+
+ ((if linechart?
+ gnc:html-linechart-set-y-axis-label!
+ gnc:html-barchart-set-y-axis-label!)
chart (gnc-commodity-get-mnemonic report-currency))
;; Add the data
@@ -403,7 +439,9 @@
(add-column! (map monetary->double net-list)))
;; Legend labels, colors
- (gnc:html-linechart-set-col-labels!
+ ((if linechart?
+ gnc:html-linechart-set-col-labels!
+ gnc:html-barchart-set-col-labels!)
chart (append
(if show-sep?
(if inc-exp?
@@ -415,7 +453,10 @@
(list (_ "Net Profit"))
(list (_ "Net Worth")))
'())))
- (gnc:html-linechart-set-col-colors!
+
+ ((if linechart?
+ gnc:html-linechart-set-col-colors!
+ gnc:html-barchart-set-col-colors!)
chart (append
(if show-sep?
'("#0074D9" "#FF4136") '())
@@ -423,10 +464,10 @@
'("#2ECC40") '())))
;; Set the line width and markers
- (gnc:html-linechart-set-line-width!
- chart line-width)
- (gnc:html-linechart-set-markers?!
- chart markers)
+ (if linechart?
+ (begin
+ (gnc:html-linechart-set-line-width! chart line-width)
+ (gnc:html-linechart-set-markers?! chart markers)))
;; URLs for income/expense or asset/liabilities bars.
;; (if show-sep?
@@ -439,7 +480,7 @@
;; report-obj
;; (list
;; (list gnc:pagename-display
-;; "Use Stacked Lines" #t)
+;; (if linechart? "Use Stacked Lines" "Use Stacked Bars") #t)
;; (list gnc:pagename-general
;; gnc:optname-reportname
;; (if inc-exp?
@@ -452,15 +493,19 @@
;; report-obj
;; (list
;; (list gnc:pagename-display
-;; "Use Stacked Lines" #t)
+;; (if linechart? "Use Stacked Lines" "Use Stacked Bars") #t)
;; (list gnc:pagename-general
;; gnc:optname-reportname
;; (if inc-exp?
;; (_ "Expense Chart")
;; (_ "Liability Chart"))))))))
-;; (gnc:html-linechart-set-button-1-line-urls!
+;; ((if linechart?
+;; gnc:html-linechart-set-button-1-line-urls!
+;; gnc:html-barchart-set-button-1-line-urls!)
;; chart urls)
-;; (gnc:html-linechart-set-button-1-legend-urls!
+;; ((if linechart?
+;; gnc:html-linechart-set-button-1-legend-urls!
+;; gnc:html-barchart-set-button-1-legend-urls!)
;; chart urls)))
;; Test for all-zero data here.
@@ -469,11 +514,12 @@
(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))
+ (if linechart?
+ (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
@@ -489,7 +535,6 @@
(list (_ "Net Worth")))
'()))
)
- (set! date-string-list (datelist->stringlist dates-list))
(gnc:html-table-append-column! table date-string-list)
(if show-sep?
(begin
@@ -526,25 +571,47 @@
;; 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)))
+
+(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)))
+
+(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))
- 'renderer (lambda (report-obj) (net-renderer report-obj #f)))
+ 'options-generator (lambda () (options-generator #f #t))
+ 'renderer (lambda (report-obj) (net-renderer report-obj #f #t)))
;; 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 reportname
+ '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))
- 'renderer (lambda (report-obj) (net-renderer report-obj #t)))
+ 'options-generator (lambda () (options-generator #t #t))
+ 'renderer (lambda (report-obj) (net-renderer report-obj #t #t)))
diff --git a/gnucash/report/standard-reports/test/test-net-charts.scm b/gnucash/report/standard-reports/test/test-net-charts.scm
index 32e7578..74e8466 100644
--- a/gnucash/report/standard-reports/test/test-net-charts.scm
+++ b/gnucash/report/standard-reports/test/test-net-charts.scm
@@ -1,8 +1,7 @@
(use-modules (gnucash gnc-module))
(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
(use-modules (gnucash engine test test-extras))
-(use-modules (gnucash report standard-reports net-barchart))
-(use-modules (gnucash report standard-reports net-linechart))
+(use-modules (gnucash report standard-reports net-charts))
(use-modules (gnucash report stylesheets))
(use-modules (gnucash report report-system))
(use-modules (gnucash report report-system test test-extras))
diff --git a/gnucash/report/standard-reports/test/test-standard-category-report.scm b/gnucash/report/standard-reports/test/test-standard-category-report.scm
index 32c9fda..cdb2641 100644
--- a/gnucash/report/standard-reports/test/test-standard-category-report.scm
+++ b/gnucash/report/standard-reports/test/test-standard-category-report.scm
@@ -35,7 +35,7 @@
(use-modules (gnucash app-utils))
(use-modules (gnucash engine))
(use-modules (sw_engine))
-(use-modules (gnucash report standard-reports net-barchart))
+(use-modules (gnucash report standard-reports net-charts))
(use-modules (gnucash report report-system test test-extras))
diff --git a/gnucash/report/standard-reports/test/test-standard-net-barchart.scm b/gnucash/report/standard-reports/test/test-standard-net-barchart.scm
index 825c92c..0ef9fd5 100644
--- a/gnucash/report/standard-reports/test/test-standard-net-barchart.scm
+++ b/gnucash/report/standard-reports/test/test-standard-net-barchart.scm
@@ -30,7 +30,7 @@
(use-modules (gnucash report report-system test test-extras))
(use-modules (gnucash report standard-reports test test-generic-net-barchart))
-(use-modules (gnucash report standard-reports net-barchart))
+(use-modules (gnucash report standard-reports net-charts))
;; Explicitly set locale to make the report output predictable
(setlocale LC_ALL "C")
diff --git a/gnucash/report/standard-reports/test/test-standard-net-linechart.scm b/gnucash/report/standard-reports/test/test-standard-net-linechart.scm
index d74387b..1270c69 100644
--- a/gnucash/report/standard-reports/test/test-standard-net-linechart.scm
+++ b/gnucash/report/standard-reports/test/test-standard-net-linechart.scm
@@ -36,7 +36,7 @@
(use-modules (gnucash report report-system test test-extras))
(use-modules (gnucash report standard-reports test test-generic-net-linechart))
-(use-modules (gnucash report standard-reports net-linechart))
+(use-modules (gnucash report standard-reports net-charts))
;; Explicitly set locale to make the report output predictable
(setlocale LC_ALL "C")
commit 2e4e18e21e60ffea64face767694c9e62cd625bf
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Jun 13 14:46:56 2018 +0800
[test-net-charts] initial commit test-net-charts
This just tests that the report exists. It does not do any checking
for the data generated yet.
diff --git a/gnucash/report/standard-reports/test/CMakeLists.txt b/gnucash/report/standard-reports/test/CMakeLists.txt
index f994b17..9646dfa 100644
--- a/gnucash/report/standard-reports/test/CMakeLists.txt
+++ b/gnucash/report/standard-reports/test/CMakeLists.txt
@@ -7,6 +7,7 @@ set(scm_test_standard_reports_SOURCES
)
set(scm_test_with_srfi64_SOURCES
+ test-net-charts.scm
test-transaction.scm
test-income-gst.scm
)
diff --git a/gnucash/report/standard-reports/test/test-net-charts.scm b/gnucash/report/standard-reports/test/test-net-charts.scm
new file mode 100644
index 0000000..32e7578
--- /dev/null
+++ b/gnucash/report/standard-reports/test/test-net-charts.scm
@@ -0,0 +1,101 @@
+(use-modules (gnucash gnc-module))
+(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
+(use-modules (gnucash engine test test-extras))
+(use-modules (gnucash report standard-reports net-barchart))
+(use-modules (gnucash report standard-reports net-linechart))
+(use-modules (gnucash report stylesheets))
+(use-modules (gnucash report report-system))
+(use-modules (gnucash report report-system test test-extras))
+(use-modules (srfi srfi-64))
+(use-modules (gnucash engine test srfi64-extras))
+(use-modules (sxml simple))
+(use-modules (sxml xpath))
+(use-modules (system vm coverage))
+(use-modules (system vm vm))
+
+(define variant-alist
+ (list
+ (cons 'net-worth-barchart "cbba1696c8c24744848062c7f1cf4a72")
+ (cons 'net-worth-linechart "d8b63264186b11e19038001558291366")
+ (cons 'income-expense-barchart "80769921e87943adade887b9835a7685")
+ (cons 'income-expense-linechart "e533c998186b11e1b2e2001558291366")))
+
+(define (variant->uuid variant)
+ (cdr (assq variant variant-alist)))
+
+;; Explicitly set locale to make the report output predictable
+(setlocale LC_ALL "C")
+
+(define (run-test)
+ (test-runner-factory gnc:test-runner)
+ (test-begin "net-charts.scm")
+ (for-each (lambda (variant)
+ (null-test variant))
+ (map car variant-alist))
+ (for-each (lambda (variant)
+ (net-charts-test variant))
+ (map car variant-alist))
+ (test-end "net-charts.scm"))
+
+(define (options->render variant options test-title)
+ ;; options object -> string
+ ;; It also dumps the render into /tmp/test-net-charts-XX.html where XX is the test title
+ (gnc:options->render variant options "test-net-charts-~a" test-title))
+
+(define structure
+ (list "Root" (list (cons 'type ACCT-TYPE-ASSET))
+ (list "Asset"
+ (list "Bank"))
+ (list "Income" (list (cons 'type ACCT-TYPE-INCOME)))
+ (list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
+ (list "Equity" (list (cons 'type ACCT-TYPE-EQUITY)))))
+
+(define (set-option! options section name value)
+ (let ((option (gnc:lookup-option options section name)))
+ (if option
+ (gnc:option-set-value option value)
+ (test-assert (format #f "wrong-option ~a ~a" section name) #f))))
+
+(define (null-test variant)
+ ;; This null-test tests for the presence of report.
+ (let* ((uuid (variant->uuid variant))
+ (options (gnc:make-report-options uuid)))
+ (test-assert (format #f "null-test: ~a" variant)
+ (options->render uuid options "null-test"))))
+
+
+;; the following tests are not ready yet
+;; unfortunately sxml parsing requires a very valid xhtml, which means
+;; <script>
+
+(define (net-charts-test variant)
+ (let* ((uuid (variant->uuid variant))
+ (env (create-test-env))
+ (account-alist (env-create-account-structure-alist env structure))
+ (bank (cdr (assoc "Bank" account-alist)))
+ (income (cdr (assoc "Income" account-alist)))
+ (expense (cdr (assoc "Expenses" account-alist)))
+ (equity (cdr (assoc "Equity" account-alist)))
+ (YEAR (gnc:time64-get-year (gnc:get-today))))
+
+ (define (default-testing-options)
+ (let ((options (gnc:make-report-options (variant->uuid variant))))
+ (set-option! options "Accounts" "Accounts" (list bank))
+ (set-option! options "General" "Start Date" (cons 'relative 'start-cal-year))
+ (set-option! options "General" "End Date" (cons 'relative 'end-cal-year))
+ options))
+
+ (env-transfer env 01 01 YEAR bank expense 5 #:description "desc-1" #:num "trn1" #:memo "memo-3")
+ (env-transfer env 21 02 YEAR income bank 10 #:description "desc-2" #:num "trn2" #:void-reason "void" #:notes "notes3")
+ (env-transfer env 11 02 YEAR income bank 29 #:description "desc-3" #:num "trn3"
+ #:reconcile (cons #\c (gnc-dmy2time64 01 03 YEAR)))
+ (env-transfer env 01 02 YEAR bank expense 15 #:description "desc-4" #:num "trn4" #:notes "notes2" #:memo "memo-1")
+ (env-transfer env 10 03 YEAR bank expense 10 #:description "desc-5" #:num "trn5" #:void-reason "any")
+ (env-transfer env 10 03 YEAR expense bank 11 #:description "desc-6" #:num "trn6" #:notes "notes1")
+ (env-transfer env 10 04 YEAR income bank 8 #:description "desc-7" #:num "trn7" #:notes "notes1" #:memo "memo-2"
+ #:reconcile (cons #\y (gnc-dmy2time64 01 03 YEAR)))
+
+ (let* ((options (default-testing-options)))
+ (test-assert (format #f "basic report exists: ~a" variant)
+ (options->render uuid options (format #f "net-charts-test ~a default options" variant))))))
+
commit 7de68cef887f56a5676da433217a7d88dc1c2646
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Jun 13 20:29:27 2018 +0800
[test-extras] split gnc:options->sxml into 2 functions
Creates (gnc:options->render) which outputs report as a string.
diff --git a/gnucash/report/report-system/test/test-extras.scm b/gnucash/report/report-system/test/test-extras.scm
index bdbd92b..e6e02bf 100644
--- a/gnucash/report/report-system/test/test-extras.scm
+++ b/gnucash/report/report-system/test/test-extras.scm
@@ -32,8 +32,6 @@
(export tbl-ref)
(export tbl-ref->number)
-(export gnc:options->sxml)
-
;;
;; Table parsing
;;
@@ -85,15 +83,17 @@
(define (tbl-ref->number tbl row-index column-index)
(string->number (car (tbl-ref tbl row-index column-index))))
-
-(define (gnc:options->sxml uuid options prefix test-title)
+(export gnc:options->render)
+(define (gnc:options->render uuid options prefix test-title)
;; uuid - str to locate report uuid
- ;; options object -> sxml tree
+ ;; options - gnc:options object
;; prefix - str describing tests e.g. "test-trep"
;; test-title: str describing each unit test e.g. "test disable filter"
;;
- ;; This function abstracts the report renderer. It also catches XML
- ;; parsing errors, dumping the options changed.
+ ;; outputs: string
+ ;;
+ ;; This function abstracts the report renderer, producing a string. It
+ ;; can be useful for reports which may not valid XML.
;;
;; It also dumps the render into /tmp/XX-YY.html where XX is the
;; test prefix and YY is the test title.
@@ -105,25 +105,33 @@
(document (renderer report))
(sanitize-char (lambda (c)
(if (or (char-alphabetic? c)
- (char-numeric? c)) c #\-)))
- (fileprefix (string-map sanitize-char prefix))
- (filename (string-map sanitize-char test-title)))
+ (char-numeric? c)) c #\-))))
(gnc:html-document-set-style-sheet! document (gnc:report-stylesheet report))
(if test-title
(gnc:html-document-set-title! document test-title))
- (let* ((filename (format #f "/tmp/~a-~a.html" fileprefix filename))
- (render (gnc:html-document-render document)))
- (with-output-to-file filename
+ (let ((render (gnc:html-document-render document)))
+ (with-output-to-file (format #f "/tmp/~a-~a.html"
+ (string-map sanitize-char prefix)
+ (string-map sanitize-char test-title))
(lambda ()
(display render)))
- (catch 'parser-error
- (lambda () (xml->sxml render
- #:trim-whitespace? #t
- #:entities '((nbsp . "\xa0"))))
- (lambda (k . args)
- (format #t "*** XML error. see render output at ~a\n~a"
- filename (gnc:html-render-options-changed options #t))
- (throw k args))))))
+ render)))
+
+(export gnc:options->sxml)
+(define (gnc:options->sxml uuid options prefix test-title)
+ ;; This functions calls the above gnc:options->render to render
+ ;; report. Then report is converted to SXML. It catches XML
+ ;; parsing errors, dumping the options changed.
+ (let ((render (gnc:options->render uuid options prefix test-title)))
+ (catch 'parser-error
+ (lambda () (xml->sxml render
+ #:trim-whitespace? #t
+ #:entities '((nbsp . "\xa0"))))
+ (lambda (k . args)
+ (format #t "*** XML error: ~a ~a\n~a"
+ prefix test-title
+ (gnc:html-render-options-changed options #t))
+ (throw k args)))))
(export sxml->table-row-col)
(define (sxml->table-row-col sxml tbl row col)
commit 1fc5634c7acbfe16aec273c30a54f268ec7ad4a0
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jun 10 10:37:43 2018 +0800
[html-text] [bugfix] img url was mistakenly disabled.
diff --git a/gnucash/report/report-system/html-text.scm b/gnucash/report/report-system/html-text.scm
index b68ed2c..bd586be 100644
--- a/gnucash/report/report-system/html-text.scm
+++ b/gnucash/report/report-system/html-text.scm
@@ -200,7 +200,7 @@
(lambda ()
(for-each
(lambda (kvp)
- (format #f "~a=~s " (car kvp) (cadr kvp)))
+ (format #t "~a=~s " (car kvp) (cadr kvp)))
(cons (list 'src src)
rest))))))
Summary of changes:
gnucash/report/report-system/html-text.scm | 2 +-
gnucash/report/report-system/test/test-extras.scm | 50 +-
gnucash/report/standard-reports/CMakeLists.txt | 3 +-
gnucash/report/standard-reports/net-barchart.scm | 492 -----------------
gnucash/report/standard-reports/net-charts.scm | 601 +++++++++++++++++++++
gnucash/report/standard-reports/net-linechart.scm | 550 -------------------
.../report/standard-reports/test/CMakeLists.txt | 1 +
.../standard-reports/test/test-net-charts.scm | 100 ++++
.../test/test-standard-category-report.scm | 2 +-
.../test/test-standard-net-barchart.scm | 2 +-
.../test/test-standard-net-linechart.scm | 2 +-
11 files changed, 736 insertions(+), 1069 deletions(-)
delete mode 100644 gnucash/report/standard-reports/net-barchart.scm
create mode 100644 gnucash/report/standard-reports/net-charts.scm
delete mode 100644 gnucash/report/standard-reports/net-linechart.scm
create mode 100644 gnucash/report/standard-reports/test/test-net-charts.scm
More information about the gnucash-changes
mailing list