mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Merge branch 'exxus-category-barchart-patch' into maint #1274
This commit is contained in:
Christopher Lam
commit
b93a034ba8
@ -51,6 +51,8 @@
|
||||
(export gnc:html-chart-set-currency-iso!)
|
||||
(export gnc:html-chart-currency-symbol)
|
||||
(export gnc:html-chart-set-currency-symbol!)
|
||||
(export gnc:html-chart-format-style)
|
||||
(export gnc:html-chart-set-format-style!)
|
||||
(export gnc:html-chart-render)
|
||||
(export gnc:html-chart-set-custom-x-axis-ticks?!)
|
||||
(export gnc:html-chart-set-title!)
|
||||
@ -144,13 +146,14 @@
|
||||
|
||||
(define-record-type <html-chart>
|
||||
(make-html-chart width height chart-options currency-iso
|
||||
currency-symbol custom-x-axis-ticks? custom-y-axis-ticks?)
|
||||
currency-symbol format-style custom-x-axis-ticks? custom-y-axis-ticks?)
|
||||
html-chart?
|
||||
(width html-chart-width html-chart-set-width)
|
||||
(height html-chart-height html-chart-set-height)
|
||||
(chart-options html-chart-chart-options html-chart-set-chart-options)
|
||||
(currency-iso html-chart-currency-iso html-chart-set-currency-iso)
|
||||
(currency-symbol html-chart-currency-symbol html-chart-set-currency-symbol)
|
||||
(format-style html-chart-format-style html-chart-set-format-style)
|
||||
(custom-x-axis-ticks? html-chart-custom-x-axis-ticks?
|
||||
html-chart-set-custom-x-axis-ticks?)
|
||||
(custom-y-axis-ticks? html-chart-custom-y-axis-ticks?
|
||||
@ -166,6 +169,8 @@
|
||||
(define gnc:html-chart-set-currency-iso! html-chart-set-currency-iso)
|
||||
(define gnc:html-chart-currency-symbol html-chart-currency-symbol)
|
||||
(define gnc:html-chart-set-currency-symbol! html-chart-set-currency-symbol)
|
||||
(define gnc:html-chart-format-style html-chart-format-style)
|
||||
(define gnc:html-chart-set-format-style! html-chart-set-format-style)
|
||||
(define gnc:html-chart-custom-x-axis-ticks? html-chart-custom-x-axis-ticks?)
|
||||
(define gnc:html-chart-set-custom-x-axis-ticks?! html-chart-set-custom-x-axis-ticks?)
|
||||
(define gnc:html-chart-custom-y-axis-ticks? html-chart-custom-y-axis-ticks?)
|
||||
@ -254,6 +259,7 @@
|
||||
(cons 'text ""))))))
|
||||
"XXX" ;currency-iso
|
||||
"\u00A4" ;currency-symbol
|
||||
"currency";format-style
|
||||
#t ;custom x-axis ticks?
|
||||
#t ;custom y-axis ticks?
|
||||
))
|
||||
@ -341,10 +347,10 @@
|
||||
// https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Number/toLocaleString
|
||||
var toLocaleStringSupportsOptions = (typeof Intl == 'object' && Intl && typeof Intl.NumberFormat == 'function');
|
||||
|
||||
// format a number e.g. 2.5 into monetary e.g. \"$2.50\"
|
||||
// format a number e.g. 2.5 into monetary e.g. \"$2.50\" or other style formsty
|
||||
function numformat(amount) {
|
||||
if (toLocaleStringSupportsOptions) {
|
||||
return amount.toLocaleString(undefined, {style:'currency', currency:curriso});
|
||||
return amount.toLocaleString(undefined, {style:formsty, currency:curriso});
|
||||
} else {
|
||||
return currsym + amount.toLocaleString();
|
||||
}
|
||||
@ -457,6 +463,7 @@ document.getElementById(chartid).onclick = function(evt) {
|
||||
(push (format #f "<script id='script-~a'>\n" id))
|
||||
(push (format #f "var curriso = ~s;\n" (gnc:html-chart-currency-iso chart)))
|
||||
(push (format #f "var currsym = ~s;\n" (gnc:html-chart-currency-symbol chart)))
|
||||
(push (format #f "var formsty = ~s;\n" (gnc:html-chart-format-style chart)))
|
||||
(push (format #f "var chartid = ~s;\n" id))
|
||||
(push (format #f "var jumpid = 'jump-~a';\n" id))
|
||||
(push (format #f "var loadstring = ~s;\n" (G_ "Load")))
|
||||
|
||||
@ -34,6 +34,10 @@
|
||||
(use-modules (gnucash app-utils))
|
||||
(use-modules (gnucash report))
|
||||
|
||||
;; useful functions
|
||||
(define (safe-/ x y)
|
||||
(if (zero? y) 0 (/ x y)))
|
||||
|
||||
;; The option names are defined here to 1. save typing and 2. avoid
|
||||
;; spelling errors. The *reportnames* are defined here (and not only
|
||||
;; once at the very end) because I need them to define the "other"
|
||||
@ -176,6 +180,15 @@ developing over time"))
|
||||
"e" (N_ "Display a table of the selected data.")
|
||||
#f))
|
||||
|
||||
;; contributed by https://github.com/exxus
|
||||
;; https://github.com/Gnucash/gnucash/pull/1272
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display
|
||||
(N_ "Percentage chart")
|
||||
"e1" (N_ "Display account contributions as a percentage of the total value for the period.")
|
||||
#f))
|
||||
|
||||
(gnc:options-add-plot-size!
|
||||
options gnc:pagename-display
|
||||
optname-plot-width optname-plot-height "f" (cons 'percent 100.0) (cons 'percent 100.0))
|
||||
@ -246,6 +259,7 @@ developing over time"))
|
||||
(work-to-do 0)
|
||||
(all-data #f)
|
||||
(show-table? (get-option gnc:pagename-display (N_ "Show table")))
|
||||
(ratio-chart? (get-option gnc:pagename-display (N_ "Percentage chart")))
|
||||
(document (gnc:make-html-document))
|
||||
(chart (gnc:make-html-chart))
|
||||
(topl-accounts (gnc:filter-accountlist-type
|
||||
@ -340,12 +354,23 @@ developing over time"))
|
||||
c report-currency
|
||||
(lambda (a b) (exchange-fn a b date))))))
|
||||
|
||||
(define acct->name
|
||||
(if show-fullname? gnc-account-get-full-name xaccAccountGetName))
|
||||
|
||||
(define (all-zeros data)
|
||||
(cond
|
||||
((number? data) (zero? data))
|
||||
((pair? data) (every all-zeros data))
|
||||
(else (error 'huh))))
|
||||
|
||||
(define (get-negative-accounts data)
|
||||
(let lp ((data data) (retval #f))
|
||||
(match data
|
||||
(() retval)
|
||||
(((acc (? (cut any negative? <>))) . rest)
|
||||
(lp rest (cons (acct->name acc) (or retval '()))))
|
||||
((_ . rest) (lp rest retval)))))
|
||||
|
||||
;; this is an alist of account-balances
|
||||
;; (list (list acc0 bal0 bal1 bal2 ...)
|
||||
;; (list acc1 bal0 bal1 bal2 ...)
|
||||
@ -465,11 +490,8 @@ developing over time"))
|
||||
(case sort-method
|
||||
((alphabetical)
|
||||
(lambda (a b)
|
||||
(if show-fullname?
|
||||
(gnc:string-locale<? (gnc-account-get-full-name (car a))
|
||||
(gnc-account-get-full-name (car b)))
|
||||
(gnc:string-locale<? (xaccAccountGetName (car a))
|
||||
(xaccAccountGetName (car b))))))
|
||||
(gnc:string-locale<? (acct->name (car a))
|
||||
(acct->name (car b)))))
|
||||
((acct-code)
|
||||
(lambda (a b)
|
||||
(gnc:string-locale<? (xaccAccountGetCode (car a))
|
||||
@ -486,12 +508,28 @@ developing over time"))
|
||||
(gnc:html-make-empty-data-warning
|
||||
report-title (gnc:report-id report-obj))))
|
||||
|
||||
((and ratio-chart? (get-negative-accounts all-data)) =>
|
||||
(lambda (neg-accounts)
|
||||
(gnc:html-document-add-object!
|
||||
document
|
||||
(gnc:html-make-generic-warning
|
||||
report-title (gnc:report-id report-obj)
|
||||
"Negative amounts detected"
|
||||
"Charting ratios cannot occur on accounts with negative balances. \
|
||||
Please deselect the accounts with negative balances."))
|
||||
|
||||
(gnc:html-document-add-object!
|
||||
document (gnc:make-html-text (gnc:html-markup-ul neg-accounts)))))
|
||||
|
||||
(else
|
||||
(let* ((dates-list (if do-intervals?
|
||||
(list-head dates-list (1- (length dates-list)))
|
||||
dates-list))
|
||||
(date-string-list (map qof-print-date dates-list))
|
||||
(list-of-rows (apply zip (map cadr all-data))))
|
||||
(list-of-rows (apply zip (map cadr all-data)))
|
||||
|
||||
;; total amounts
|
||||
(row-totals (map (cut fold + 0 <>) list-of-rows)))
|
||||
|
||||
;; Set chart title, subtitle etc.
|
||||
(gnc:html-chart-set-type!
|
||||
@ -511,7 +549,8 @@ developing over time"))
|
||||
|
||||
(gnc:html-chart-set-data-labels! chart date-string-list)
|
||||
(gnc:html-chart-set-y-axis-label!
|
||||
chart (gnc-commodity-get-mnemonic report-currency))
|
||||
chart (if ratio-chart? "Ratio"
|
||||
(gnc-commodity-get-mnemonic report-currency)))
|
||||
|
||||
;; If we have too many categories, we sum them into a new
|
||||
;; 'other' category and add a link to a new report with just
|
||||
@ -546,8 +585,7 @@ developing over time"))
|
||||
(let* ((acct (car series))
|
||||
(label (cond
|
||||
((string? acct) (car series))
|
||||
(show-fullname? (gnc-account-get-full-name acct))
|
||||
(else (xaccAccountGetName acct))))
|
||||
(else (acct->name acct))))
|
||||
(amounts (cadr series))
|
||||
(stack (if stacked? "default" (number->string stack)))
|
||||
(fill (eq? chart-type 'barchart))
|
||||
@ -571,12 +609,10 @@ developing over time"))
|
||||
(1+ tree-depth))
|
||||
(list gnc:pagename-general
|
||||
gnc:optname-reportname
|
||||
(if show-fullname?
|
||||
(gnc-account-get-full-name acct)
|
||||
(xaccAccountGetName acct)))))))))
|
||||
(acct->name acct))))))))
|
||||
(gnc:html-chart-add-data-series!
|
||||
chart label amounts color
|
||||
'stack stack 'fill fill 'urls urls)))
|
||||
chart label (if ratio-chart? (map safe-/ amounts row-totals) amounts)
|
||||
color 'stack stack 'fill fill 'urls urls)))
|
||||
all-data
|
||||
(gnc:assign-colors (length all-data))
|
||||
(iota (length all-data)))
|
||||
@ -586,6 +622,8 @@ developing over time"))
|
||||
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-format-style!
|
||||
chart (if ratio-chart? "percent" "currency"))
|
||||
|
||||
(gnc:report-percent-done 98)
|
||||
(gnc:html-document-add-object! document chart)
|
||||
@ -598,20 +636,27 @@ developing over time"))
|
||||
(define (make-cell contents)
|
||||
(gnc:make-html-table-cell/markup "number-cell" contents))
|
||||
|
||||
(define (make-cell-percent amt grandt)
|
||||
(gnc:make-html-table-cell/markup "number-cell" (* (safe-/ amt grandt) 100) " %"))
|
||||
|
||||
(define (make-monetary-cell amount)
|
||||
(make-cell (gnc:make-gnc-monetary report-currency amount)))
|
||||
|
||||
(for-each
|
||||
(lambda (date row)
|
||||
(lambda (date row row-total)
|
||||
(gnc:html-table-append-row!
|
||||
table
|
||||
(append (list (make-cell date))
|
||||
(map make-monetary-cell row)
|
||||
(map (if ratio-chart?
|
||||
(cut make-cell-percent <> row-total)
|
||||
make-monetary-cell)
|
||||
row)
|
||||
(if cols>1?
|
||||
(list (make-monetary-cell (apply + row)))
|
||||
'()))))
|
||||
date-string-list
|
||||
list-of-rows)
|
||||
list-of-rows
|
||||
row-totals)
|
||||
|
||||
(gnc:html-table-set-col-headers!
|
||||
table
|
||||
@ -621,8 +666,7 @@ developing over time"))
|
||||
(lambda (col)
|
||||
(cond
|
||||
((string? col) col)
|
||||
(show-fullname? (gnc-account-get-full-name col))
|
||||
(else (xaccAccountGetName col))))
|
||||
(else (acct->name col))))
|
||||
(map car all-data))
|
||||
(if cols>1?
|
||||
(list (G_ "Grand Total"))
|
||||
@ -642,8 +686,7 @@ developing over time"))
|
||||
(lambda (col)
|
||||
(cond
|
||||
((string? col) col)
|
||||
(show-fullname? (gnc-account-get-full-name col))
|
||||
(else (xaccAccountGetName col))))
|
||||
(else (acct->name col))))
|
||||
(map car all-data))
|
||||
(if (pair? (cdr all-data))
|
||||
(list (G_ "Grand Total"))
|
||||
|
||||
@ -243,6 +243,16 @@
|
||||
(test-equal "auto"
|
||||
'("Auto")
|
||||
(sxml->table-row-col sxml 1 0 2))
|
||||
|
||||
;; test ratios
|
||||
(set-option expense-options gnc:pagename-display "Percentage chart" #t)
|
||||
(let ((sxml (gnc:options->sxml expense-report-uuid expense-options
|
||||
"test-standard-category-report"
|
||||
"ratios"
|
||||
#:strip-tag "script")))
|
||||
(test-equal "multi-acct ratios"
|
||||
'("57.14 %" "14.29 %" "14.29 %" "14.29 %" "$14.00")
|
||||
(cdr (sxml->table-row-col sxml 1 2 #f))))
|
||||
(test-end "multi-acct-test"))))
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user