mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[category-barchart] upgraded
This commit is contained in:
Christopher Lam
parent
36d5dfe2f7
commit
535ddf0d47
@ -259,9 +259,7 @@ developing over time"))
|
|||||||
(work-to-do 0)
|
(work-to-do 0)
|
||||||
(show-table? (get-option gnc:pagename-display (N_ "Show table")))
|
(show-table? (get-option gnc:pagename-display (N_ "Show table")))
|
||||||
(document (gnc:make-html-document))
|
(document (gnc:make-html-document))
|
||||||
(chart (if (eqv? chart-type 'barchart)
|
(chart (gnc:make-html-chart))
|
||||||
(gnc:make-html-barchart)
|
|
||||||
(gnc:make-html-linechart)))
|
|
||||||
(table (gnc:make-html-table))
|
(table (gnc:make-html-table))
|
||||||
(topl-accounts (gnc:filter-accountlist-type
|
(topl-accounts (gnc:filter-accountlist-type
|
||||||
account-types
|
account-types
|
||||||
@ -321,9 +319,6 @@ developing over time"))
|
|||||||
(gnc:deltasym-to-delta interval)))
|
(gnc:deltasym-to-delta interval)))
|
||||||
;; Here the date strings for the x-axis labels are
|
;; Here the date strings for the x-axis labels are
|
||||||
;; created.
|
;; created.
|
||||||
(date-string-list '())
|
|
||||||
(date-iso-string-list '())
|
|
||||||
(save-fmt (qof-date-format-get))
|
|
||||||
(other-anchor "")
|
(other-anchor "")
|
||||||
(all-data '()))
|
(all-data '()))
|
||||||
|
|
||||||
@ -518,68 +513,31 @@ developing over time"))
|
|||||||
(if
|
(if
|
||||||
(and (not (null? all-data))
|
(and (not (null? all-data))
|
||||||
(not-all-zeros (map cadr all-data)))
|
(not-all-zeros (map cadr all-data)))
|
||||||
|
|
||||||
(let ((dates-list (if do-intervals?
|
(let ((dates-list (if do-intervals?
|
||||||
(list-head dates-list (1- (length dates-list)))
|
(list-head dates-list (1- (length dates-list)))
|
||||||
dates-list)))
|
dates-list))
|
||||||
(set! date-string-list (map qof-print-date dates-list))
|
(date-string-list (map qof-print-date dates-list)))
|
||||||
(qof-date-format-set QOF-DATE-FORMAT-ISO)
|
|
||||||
(set! date-iso-string-list (map qof-print-date dates-list))
|
|
||||||
(qof-date-format-set save-fmt)
|
|
||||||
;; Set chart title, subtitle etc.
|
;; Set chart title, subtitle etc.
|
||||||
(if (eq? chart-type 'barchart)
|
|
||||||
(begin
|
|
||||||
(gnc:html-barchart-set-title! chart report-title)
|
|
||||||
(gnc:html-barchart-set-subtitle!
|
|
||||||
chart (format #f
|
|
||||||
(if do-intervals?
|
|
||||||
(_ "~a to ~a")
|
|
||||||
(_ "Balances ~a to ~a"))
|
|
||||||
(qof-print-date from-date-t64)
|
|
||||||
(qof-print-date to-date-t64)))
|
|
||||||
|
|
||||||
(gnc:html-barchart-set-width! chart width)
|
(gnc:html-chart-set-type!
|
||||||
(gnc:html-barchart-set-height! chart height)
|
chart (if (eq? chart-type 'barchart) 'bar 'line))
|
||||||
|
|
||||||
;; row labels etc.
|
(gnc:html-chart-set-title!
|
||||||
(gnc:html-barchart-set-row-labels! chart date-string-list)
|
chart (list report-title
|
||||||
;; FIXME: axis labels are not yet supported by
|
(format #f
|
||||||
;; libguppitank.
|
(if do-intervals?
|
||||||
(gnc:html-barchart-set-y-axis-label!
|
(_ "~a to ~a")
|
||||||
chart (gnc-commodity-get-mnemonic report-currency))
|
(_ "Balances ~a to ~a"))
|
||||||
(gnc:html-barchart-set-row-labels-rotated?! chart #t)
|
(qof-print-date from-date-t64)
|
||||||
(gnc:html-barchart-set-stacked?! chart stacked?)
|
(qof-print-date to-date-t64))))
|
||||||
;; If this is a stacked barchart, then reverse the legend.
|
|
||||||
;; Doesn't do what you'd expect. - DRH
|
|
||||||
;; It does work, but needs Guppi 0.40.4. - cstim
|
|
||||||
(gnc:html-barchart-set-legend-reversed?! chart stacked?)
|
|
||||||
)
|
|
||||||
(begin
|
|
||||||
(gnc:html-linechart-set-title! chart report-title)
|
|
||||||
(gnc:html-linechart-set-subtitle!
|
|
||||||
chart (format #f
|
|
||||||
(if do-intervals?
|
|
||||||
(_ "~a to ~a")
|
|
||||||
(_ "Balances ~a to ~a"))
|
|
||||||
(qof-print-date from-date-t64)
|
|
||||||
(qof-print-date to-date-t64)))
|
|
||||||
|
|
||||||
(gnc:html-linechart-set-width! chart width)
|
(gnc:html-chart-set-width! chart width)
|
||||||
(gnc:html-linechart-set-height! chart height)
|
(gnc:html-chart-set-height! chart height)
|
||||||
|
|
||||||
;; row labels etc.
|
(gnc:html-chart-set-data-labels! chart date-string-list)
|
||||||
(gnc:html-linechart-set-row-labels! chart date-iso-string-list)
|
(gnc:html-chart-set-y-axis-label!
|
||||||
;; FIXME: axis labels are not yet supported by
|
chart (gnc-commodity-get-mnemonic report-currency))
|
||||||
;; libguppitank.
|
|
||||||
(gnc:html-linechart-set-y-axis-label!
|
|
||||||
chart (gnc-commodity-get-mnemonic report-currency))
|
|
||||||
(gnc:html-linechart-set-row-labels-rotated?! chart #t)
|
|
||||||
(gnc:html-linechart-set-stacked?! chart stacked?)
|
|
||||||
;; If this is a stacked linechart, then reverse the legend.
|
|
||||||
;; Doesn't do what you'd expect. - DRH
|
|
||||||
;; It does work, but needs Guppi 0.40.4. - cstim
|
|
||||||
(gnc:html-linechart-set-legend-reversed?! chart stacked?)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
;; If we have too many categories, we sum them into a new
|
;; If we have too many categories, we sum them into a new
|
||||||
;; 'other' category and add a link to a new report with just
|
;; 'other' category and add a link to a new report with just
|
||||||
@ -593,8 +551,7 @@ developing over time"))
|
|||||||
(set! all-data
|
(set! all-data
|
||||||
(append start
|
(append start
|
||||||
(list (list (_ "Other") other-sum))))
|
(list (list (_ "Other") other-sum))))
|
||||||
(let* ((options (gnc:make-report-options reportguid))
|
(let* ((options (gnc:make-report-options reportguid)))
|
||||||
(id #f))
|
|
||||||
;; now copy all the options
|
;; now copy all the options
|
||||||
(gnc:options-copy-values
|
(gnc:options-copy-values
|
||||||
(gnc:report-options report-obj) options)
|
(gnc:report-options report-obj) options)
|
||||||
@ -604,109 +561,58 @@ developing over time"))
|
|||||||
optname-accounts)
|
optname-accounts)
|
||||||
(map car finish))
|
(map car finish))
|
||||||
;; Set the URL to point to this report.
|
;; Set the URL to point to this report.
|
||||||
(set! id (gnc:make-report reportguid options))
|
(set! other-anchor
|
||||||
(set! other-anchor (gnc:report-anchor-text id)))))
|
(gnc:report-anchor-text
|
||||||
|
(gnc:make-report reportguid options))))))
|
||||||
|
|
||||||
|
|
||||||
;; This adds the data. Note the apply-zip stuff: This
|
|
||||||
;; transposes the data, i.e. swaps rows and columns. Pretty
|
|
||||||
;; cool, eh? Courtesy of dave_p.
|
|
||||||
(gnc:report-percent-done 92)
|
(gnc:report-percent-done 92)
|
||||||
(if (eq? chart-type 'barchart)
|
|
||||||
(begin ;; bar chart
|
|
||||||
(if (not (null? all-data))
|
|
||||||
(gnc:html-barchart-set-data!
|
|
||||||
chart
|
|
||||||
(apply zip (map (lambda (mlist)
|
|
||||||
(map gnc:gnc-monetary-amount mlist))
|
|
||||||
(map cadr all-data)))))
|
|
||||||
|
|
||||||
;; Labels and colors
|
(for-each
|
||||||
(gnc:report-percent-done 94)
|
(lambda (series color stack)
|
||||||
(gnc:html-barchart-set-col-labels!
|
(let* ((acct (car series))
|
||||||
chart (map (lambda (pair)
|
(label (cond
|
||||||
(if (string? (car pair))
|
((string? acct)
|
||||||
(car pair)
|
(car series))
|
||||||
((if show-fullname?
|
(show-fullname?
|
||||||
gnc-account-get-full-name
|
(gnc-account-get-full-name acct))
|
||||||
xaccAccountGetName) (car pair))))
|
(else (xaccAccountGetName acct))))
|
||||||
all-data))
|
(amounts (map gnc:gnc-monetary-amount (cadr series)))
|
||||||
(gnc:html-barchart-set-col-colors!
|
(stack (if stacked?
|
||||||
chart
|
"default"
|
||||||
(gnc:assign-colors (length all-data))))
|
(number->string stack)))
|
||||||
(begin ;; line chart
|
(fill (eq? chart-type 'barchart))
|
||||||
(if (not (null? all-data))
|
(urls (cond
|
||||||
(gnc:html-linechart-set-data!
|
((string? acct)
|
||||||
chart
|
other-anchor)
|
||||||
(apply zip (map (lambda (mlist)
|
|
||||||
(map gnc:gnc-monetary-amount mlist))
|
|
||||||
(map cadr all-data)))))
|
|
||||||
|
|
||||||
;; Labels and colors
|
((null? (gnc-account-get-children acct))
|
||||||
(gnc:report-percent-done 94)
|
(gnc:account-anchor-text acct))
|
||||||
(gnc:html-linechart-set-col-labels!
|
|
||||||
chart (map (lambda (pair)
|
|
||||||
(if (string? (car pair))
|
|
||||||
(car pair)
|
|
||||||
((if show-fullname?
|
|
||||||
gnc-account-get-full-name
|
|
||||||
xaccAccountGetName) (car pair))))
|
|
||||||
all-data))
|
|
||||||
(gnc:html-linechart-set-col-colors!
|
|
||||||
chart
|
|
||||||
(gnc:assign-colors (length all-data)))))
|
|
||||||
|
|
||||||
;; set the URLs; the slices are links to other reports
|
(else
|
||||||
;; (gnc:report-percent-done 96)
|
(gnc:make-report-anchor
|
||||||
;; (let
|
reportguid report-obj
|
||||||
;; ((urls
|
(list
|
||||||
;; (map
|
(list gnc:pagename-accounts optname-accounts
|
||||||
;; (lambda (pair)
|
(cons acct (gnc-account-get-children acct)))
|
||||||
;; (if
|
(list gnc:pagename-accounts optname-levels
|
||||||
;; (string? (car pair))
|
(1+ tree-depth))
|
||||||
;; other-anchor
|
(list gnc:pagename-general
|
||||||
;; (let* ((acct (car pair))
|
gnc:optname-reportname
|
||||||
;; (subaccts
|
(if show-fullname?
|
||||||
;; (gnc-account-get-children acct)))
|
(gnc-account-get-full-name acct)
|
||||||
;; (if (null? subaccts)
|
(xaccAccountGetName acct)))))))))
|
||||||
;; ;; if leaf-account, make this an anchor
|
(gnc:html-chart-add-data-series!
|
||||||
;; ;; to the register.
|
chart label amounts color
|
||||||
;; (gnc:account-anchor-text acct)
|
'stack stack 'fill fill 'urls urls)))
|
||||||
;; ;; if non-leaf account, make this a link
|
all-data
|
||||||
;; ;; to another report which is run on the
|
(gnc:assign-colors (length all-data))
|
||||||
;; ;; immediate subaccounts of this account
|
(iota (length all-data)))
|
||||||
;; ;; (and including this account).
|
|
||||||
;; (gnc:make-report-anchor
|
(gnc:html-chart-set-stacking?! chart stacked?)
|
||||||
;; reportguid
|
(gnc:html-chart-set-currency-iso!
|
||||||
;; report-obj
|
chart (gnc-commodity-get-mnemonic report-currency))
|
||||||
;; (list
|
(gnc:html-chart-set-currency-symbol!
|
||||||
;; (list gnc:pagename-accounts optname-accounts
|
chart (gnc-commodity-get-nice-symbol report-currency))
|
||||||
;; (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))))))))
|
|
||||||
;; all-data)))
|
|
||||||
;; (if (eq? chart-type 'barchart)
|
|
||||||
;; (begin ;; bar chart
|
|
||||||
;; (gnc:html-barchart-set-button-1-bar-urls!
|
|
||||||
;; chart (append urls urls))
|
|
||||||
;; ;; The legend urls do the same thing.
|
|
||||||
;; (gnc:html-barchart-set-button-1-legend-urls!
|
|
||||||
;; chart (append urls urls))
|
|
||||||
;; )
|
|
||||||
;; (begin ;; line chart
|
|
||||||
;; (gnc:html-linechart-set-button-1-line-urls!
|
|
||||||
;; chart (append urls urls))
|
|
||||||
;; ;; The legend urls do the same thing.
|
|
||||||
;; (gnc:html-linechart-set-button-1-legend-urls!
|
|
||||||
;; chart (append urls urls))
|
|
||||||
;; )
|
|
||||||
;; )
|
|
||||||
;; )
|
|
||||||
|
|
||||||
(gnc:report-percent-done 98)
|
(gnc:report-percent-done 98)
|
||||||
(gnc:html-document-add-object! document chart)
|
(gnc:html-document-add-object! document chart)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user