mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[category-barchart] refactor, handling error conditions first
This commit is contained in:
Christopher Lam
parent
e6b97849a5
commit
6605a6eb66
@ -274,11 +274,21 @@ developing over time"))
|
||||
account-levels))
|
||||
|
||||
;;(gnc:debug accounts)
|
||||
(if (not (null? accounts))
|
||||
(cond
|
||||
((null? accounts)
|
||||
(gnc:html-document-add-object!
|
||||
document
|
||||
(gnc:html-make-no-account-warning
|
||||
report-title (gnc:report-id report-obj))))
|
||||
|
||||
;; Define more helper variables.
|
||||
(let* ((commodity-list #f)
|
||||
(exchange-fn #f)
|
||||
(else
|
||||
(let* ((commodity-list (gnc:accounts-get-commodities
|
||||
(gnc:accounts-and-all-descendants accounts)
|
||||
report-currency))
|
||||
(exchange-fn (gnc:case-exchange-time-fn
|
||||
price-source report-currency
|
||||
commodity-list to-date-t64
|
||||
5 15))
|
||||
(averaging-fraction-func (gnc:date-get-fraction-func averaging-selection))
|
||||
(interval-fraction-func (gnc:date-get-fraction-func interval))
|
||||
(averaging-multiplier
|
||||
@ -288,7 +298,9 @@ developing over time"))
|
||||
(let* ((start-frac-avg (averaging-fraction-func from-date-t64))
|
||||
(end-frac-avg (averaging-fraction-func (1+ to-date-t64)))
|
||||
(diff-avg (- end-frac-avg start-frac-avg))
|
||||
(diff-avg-numeric (/ (inexact->exact (round (* diff-avg 1000000))) ; 6 decimals precision
|
||||
(diff-avg-numeric
|
||||
(/ (inexact->exact (round (* diff-avg 1000000)))
|
||||
;; 6 decimals precision
|
||||
1000000))
|
||||
(start-frac-int (interval-fraction-func from-date-t64))
|
||||
(end-frac-int (interval-fraction-func (1+ to-date-t64)))
|
||||
@ -317,8 +329,7 @@ developing over time"))
|
||||
(gnc:deltasym-to-delta interval)))
|
||||
;; Here the date strings for the x-axis labels are
|
||||
;; created.
|
||||
(other-anchor "")
|
||||
(all-data '()))
|
||||
(other-anchor ""))
|
||||
|
||||
;; Converts a commodity-collector into gnc-monetary in the report's
|
||||
;; currency using the exchange-fn calculated above. Returns a gnc-monetary
|
||||
@ -334,11 +345,11 @@ developing over time"))
|
||||
c report-currency
|
||||
(lambda (a b) (exchange-fn a b date)))))))
|
||||
|
||||
;; copy of gnc:not-all-zeros using gnc-monetary
|
||||
(define (not-all-zeros data)
|
||||
(cond ((gnc:gnc-monetary? data) (not (zero? (gnc:gnc-monetary-amount data))))
|
||||
((list? data) (or-map not-all-zeros data))
|
||||
(else #f)))
|
||||
(define (all-zeros data)
|
||||
(cond
|
||||
((gnc:gnc-monetary? data) (zero? (gnc:gnc-monetary-amount data)))
|
||||
((pair? data) (every all-zeros data))
|
||||
(else (error 'huh))))
|
||||
|
||||
;; this is an alist of account-balances
|
||||
;; (list (list acc0 bal0 bal1 bal2 ...)
|
||||
@ -402,12 +413,15 @@ developing over time"))
|
||||
(let ((sum 0))
|
||||
(for-each
|
||||
(lambda (a)
|
||||
(set! sum (+ sum (1+ (count-accounts (1+ current-depth)
|
||||
(set! sum
|
||||
(+ sum (1+ (count-accounts (1+ current-depth)
|
||||
(gnc-account-get-children a))))))
|
||||
accts)
|
||||
sum)
|
||||
(length (filter show-acct? accts))))
|
||||
|
||||
(set! work-to-do (count-accounts 1 topl-accounts))
|
||||
|
||||
;; Calculates all account's balances. Returns a list of pairs:
|
||||
;; (<account> <balance-list>), like '((Earnings (10.0 11.2))
|
||||
;; (Gifts (12.3 14.5))), where each element of <balance-list>
|
||||
@ -427,18 +441,17 @@ developing over time"))
|
||||
(let ((res '()))
|
||||
(for-each
|
||||
(lambda (a)
|
||||
(begin
|
||||
(set! work-done (1+ work-done))
|
||||
(gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do))))
|
||||
(if (show-acct? a)
|
||||
(set! res
|
||||
(cons (list a (account->balance-list a #f))
|
||||
res)))
|
||||
(set! res (append
|
||||
(traverse-accounts
|
||||
(set! res
|
||||
(append (traverse-accounts
|
||||
(1+ current-depth)
|
||||
(gnc-account-get-children a))
|
||||
res))))
|
||||
res)))
|
||||
accts)
|
||||
res)
|
||||
;; else (i.e. current-depth == tree-depth)
|
||||
@ -449,27 +462,8 @@ developing over time"))
|
||||
(list a (account->balance-list a #t)))
|
||||
(filter show-acct? accts))))
|
||||
|
||||
|
||||
;; The percentage done numbers here are a hack so that
|
||||
;; something gets displayed. On my system the
|
||||
;; gnc:case-exchange-time-fn takes about 20% of the time
|
||||
;; building up a list of prices for later use. Either this
|
||||
;; routine needs to send progress reports, or the price
|
||||
;; lookup should be distributed and done when actually
|
||||
;; needed so as to amortize the cpu time properly.
|
||||
(gnc:report-percent-done 1)
|
||||
(set! commodity-list (gnc:accounts-get-commodities
|
||||
(gnc:accounts-and-all-descendants accounts)
|
||||
report-currency))
|
||||
(set! exchange-fn (gnc:case-exchange-time-fn
|
||||
price-source report-currency
|
||||
commodity-list to-date-t64
|
||||
5 15))
|
||||
|
||||
(set! work-to-do (count-accounts 1 topl-accounts))
|
||||
|
||||
;; Sort the account list according to the account code field.
|
||||
(set! all-data
|
||||
(define all-data
|
||||
(sort
|
||||
(filter (lambda (l)
|
||||
(not (zero? (gnc:gnc-monetary-amount
|
||||
@ -492,18 +486,20 @@ developing over time"))
|
||||
(> (gnc:gnc-monetary-amount (apply gnc:monetary+ (cadr a)))
|
||||
(gnc:gnc-monetary-amount (apply gnc:monetary+ (cadr b)))))))))
|
||||
|
||||
;; Proceed if the data is non-zeros
|
||||
(if
|
||||
(and (not (null? all-data))
|
||||
(not-all-zeros (map cadr all-data)))
|
||||
(cond
|
||||
((or (null? all-data) (all-zeros (map cadr all-data)))
|
||||
(gnc:html-document-add-object!
|
||||
document
|
||||
(gnc:html-make-empty-data-warning
|
||||
report-title (gnc:report-id report-obj))))
|
||||
|
||||
(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)))
|
||||
|
||||
;; Set chart title, subtitle etc.
|
||||
|
||||
(gnc:html-chart-set-type!
|
||||
chart (if (eq? chart-type 'barchart) 'bar 'line))
|
||||
|
||||
@ -555,28 +551,21 @@ developing over time"))
|
||||
(lambda (series color stack)
|
||||
(let* ((acct (car series))
|
||||
(label (cond
|
||||
((string? acct)
|
||||
(car series))
|
||||
(show-fullname?
|
||||
(gnc-account-get-full-name acct))
|
||||
((string? acct) (car series))
|
||||
(show-fullname? (gnc-account-get-full-name acct))
|
||||
(else (xaccAccountGetName acct))))
|
||||
(amounts (map gnc:gnc-monetary-amount (cadr series)))
|
||||
(stack (if stacked?
|
||||
"default"
|
||||
(number->string stack)))
|
||||
(stack (if stacked? "default" (number->string stack)))
|
||||
(fill (eq? chart-type 'barchart))
|
||||
(urls (cond
|
||||
((string? acct)
|
||||
other-anchor)
|
||||
|
||||
((string? acct) other-anchor)
|
||||
((null? (gnc-account-get-children acct))
|
||||
(gnc:account-anchor-text acct))
|
||||
|
||||
;; because the tree-depth option for
|
||||
;; accounts/levels goes up to 6. FIXME:
|
||||
;; magic number.
|
||||
((>= tree-depth 6)
|
||||
(gnc:account-anchor-text acct))
|
||||
((>= tree-depth 6) (gnc:account-anchor-text acct))
|
||||
|
||||
(else
|
||||
(gnc:make-report-anchor
|
||||
@ -672,19 +661,7 @@ developing over time"))
|
||||
(list (apply gnc:monetary+ row))
|
||||
'())))
|
||||
(map (cut gnc-print-time64 <> iso-date) dates-list)
|
||||
(apply zip (map cadr all-data))))))))))
|
||||
|
||||
;; else if empty data
|
||||
(gnc:html-document-add-object!
|
||||
document
|
||||
(gnc:html-make-empty-data-warning
|
||||
report-title (gnc:report-id report-obj)))))
|
||||
|
||||
;; else if no accounts selected
|
||||
(gnc:html-document-add-object!
|
||||
document
|
||||
(gnc:html-make-no-account-warning
|
||||
report-title (gnc:report-id report-obj))))
|
||||
(apply zip (map cadr all-data)))))))))))))))
|
||||
|
||||
(unless (gnc:html-document-export-string document)
|
||||
(gnc:html-document-set-export-error document (G_ "No exportable data")))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user