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

[account-piecharts] upgraded

Browse Source
This commit is contained in:
Christopher Lam 2019-01-19 23:03:21 +08:00
parent aa175e0a93
commit 280b745927
1 changed files with 84 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

142
gnucash/report/reports/standard/account-piecharts.scm
View File

@ -190,43 +190,6 @@ balance at a given time"))
options)) options))
;; Set slice URLs for the depth-based chart types.
(define (set-slice-urls!
report-obj uuid show-fullname? tree-depth other-anchor accts chart)
(let
((urls
(map
(lambda (pair)
(if (string? (cadr pair))
other-anchor
(let* ((acct (cadr pair))
(subaccts (gnc-account-get-children acct)))
(if (null? subaccts)
;; if leaf-account, make this an anchor
;; to the register.
(gnc:account-anchor-text (cadr pair))
;; if non-leaf account, make this a link
;; to another report which is run on the
;; immediate subaccounts of this account
;; (and including this account).
(gnc:make-report-anchor
uuid
report-obj
(list
(list gnc:pagename-accounts optname-accounts
(cons acct subaccts))
(list gnc:pagename-accounts optname-levels
(+ 1 tree-depth))
(list gnc:pagename-general
gnc:optname-reportname
((if show-fullname?
gnc-account-get-full-name
xaccAccountGetName) acct))))))))
accts)))
(gnc:html-piechart-set-button-1-slice-urls!
chart urls)
(gnc:html-piechart-set-button-1-legend-urls!
chart urls)))
;; Get display name for account-based reports. ;; Get display name for account-based reports.
(define (display-name-accounts show-fullname? acc) (define (display-name-accounts show-fullname? acc)
@ -400,7 +363,7 @@ balance at a given time"))
(reverse-balance? (get-option "__report" "reverse-balance?")) (reverse-balance? (get-option "__report" "reverse-balance?"))
(document (gnc:make-html-document)) (document (gnc:make-html-document))
(chart (gnc:make-html-piechart)) (chart (gnc:make-html-chart))
(topl-accounts (gnc:filter-accountlist-type (topl-accounts (gnc:filter-accountlist-type
account-types account-types
(gnc-account-get-children-sorted (gnc-account-get-children-sorted
@ -469,11 +432,10 @@ balance at a given time"))
;; (gnc:sum-collector-commodity) based on the average ;; (gnc:sum-collector-commodity) based on the average
;; cost of all holdings. ;; cost of all holdings.
(* (*
(gnc-numeric-to-double
(gnc:gnc-monetary-amount (gnc:gnc-monetary-amount
(gnc:sum-collector-commodity (gnc:sum-collector-commodity
c report-currency c report-currency
exchange-fn))) exchange-fn))
averaging-multiplier)) averaging-multiplier))
;; Get balance of an account as double number, already converted ;; Get balance of an account as double number, already converted
@ -542,24 +504,41 @@ balance at a given time"))
;; set the URL. ;; set the URL.
(set! other-anchor (gnc:report-anchor-text id)))))) (set! other-anchor (gnc:report-anchor-text id))))))
;; set the URLs; the slices are links to other reports
(if depth-based?
(set-slice-urls! report-obj report-guid show-fullname?
tree-depth other-anchor combined chart))
(if (if
(not (null? combined)) (not (null? combined))
(begin (let ((urls (and depth-based?
(gnc:html-piechart-set-title! (map
chart report-title) (lambda (series)
(gnc:html-piechart-set-width! chart width) (if (string? (cadr series))
(gnc:html-piechart-set-height! chart height) other-anchor
(gnc:html-piechart-set-data! chart (unzip1 combined)) (let* ((acct (cadr series))
(gnc:html-piechart-set-colors! (subaccts (gnc-account-get-children acct)))
chart (gnc:assign-colors (length combined))) (if (null? subaccts)
(gnc:account-anchor-text (cadr series))
(gnc:make-report-anchor
report-guid
report-obj
(list
(list gnc:pagename-accounts optname-accounts
(cons acct subaccts))
(list gnc:pagename-accounts optname-levels
(+ 1 tree-depth))
(list gnc:pagename-general
gnc:optname-reportname
((if show-fullname?
gnc-account-get-full-name
xaccAccountGetName) acct))))))))
combined))))
(gnc:html-chart-set-type! chart 'pie)
(gnc:html-piechart-set-subtitle! (gnc:html-chart-set-currency-iso!
chart (string-append 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-title!
chart (list report-title
(string-append
(if do-intervals? (if do-intervals?
(format #f (format #f
(_ "~a to ~a") (_ "~a to ~a")
@ -572,40 +551,41 @@ balance at a given time"))
(let ((total (apply + (unzip1 combined)))) (let ((total (apply + (unzip1 combined))))
(format (format
#f ": ~a" #f ": ~a"
(xaccPrintAmount (gnc:monetary->string
(double-to-gnc-numeric (gnc:make-gnc-monetary
total report-currency total))))
(gnc-commodity-get-fraction report-currency) ""))))
GNC-RND-ROUND) (gnc:html-chart-set-width! chart width)
print-info))) (gnc:html-chart-set-height! chart height)
""))) (gnc:html-chart-add-data-series! chart
"Accounts"
(unzip1 combined)
(gnc:assign-colors (length combined))
'urls urls)
(gnc:html-chart-set-axes-display! chart #f)
(let ((legend-labels (gnc:html-chart-set-data-labels!
chart
(map (map
(lambda (pair) (lambda (series)
(string-append (string-append
(if (string? (cadr pair)) (if (string? (cadr series))
(cadr pair) (cadr series)
(display-name show-fullname? (cadr pair))) (display-name show-fullname? (cadr series)))
(if show-total? (if show-total?
(string-append (string-append
" - " " - "
(xaccPrintAmount (gnc:monetary->string
(double-to-gnc-numeric (gnc:make-gnc-monetary
(car pair) report-currency
(gnc-commodity-get-fraction report-currency) (car series))))
GNC-RND-ROUND)
print-info)
)
"") "")
(if show-percent? (if show-percent?
(format (format #f " (~2,1f%)"
#f " (~2,2f %)" (* 100 (/ (car series)
(* 100.0 (/ (car pair) (apply + (unzip1 combined))))) (apply + (unzip1 combined)))))
"") "")))
)) combined))
combined)))
(gnc:html-piechart-set-labels! chart legend-labels))
(gnc:html-document-add-object! document chart)) (gnc:html-document-add-object! document chart))