|
|
|
|
@ -24,8 +24,6 @@
|
|
|
|
|
|
|
|
|
|
;; depends must be outside module scope -- and should eventually go away.
|
|
|
|
|
(define-module (gnucash report standard-reports category-barchart))
|
|
|
|
|
(use-modules (gnucash report report-system report-collectors))
|
|
|
|
|
(use-modules (gnucash report report-system collectors))
|
|
|
|
|
(use-modules (srfi srfi-1))
|
|
|
|
|
(use-modules (gnucash utilities))
|
|
|
|
|
(use-modules (gnucash gnc-module))
|
|
|
|
|
@ -263,6 +261,8 @@ developing over time"))
|
|
|
|
|
(sort-method (get-option gnc:pagename-display optname-sort-method))
|
|
|
|
|
(reverse-balance? (get-option "__report" "reverse-balance?"))
|
|
|
|
|
|
|
|
|
|
(work-done 0)
|
|
|
|
|
(work-to-do 0)
|
|
|
|
|
(show-table? (get-option gnc:pagename-display (N_ "Show table")))
|
|
|
|
|
(document (gnc:make-html-document))
|
|
|
|
|
(chart
|
|
|
|
|
@ -285,16 +285,8 @@ developing over time"))
|
|
|
|
|
(gnc:get-current-account-tree-depth)
|
|
|
|
|
account-levels))
|
|
|
|
|
|
|
|
|
|
(define the-acount-destination-alist
|
|
|
|
|
(account-destination-alist accounts account-types tree-depth))
|
|
|
|
|
|
|
|
|
|
;;(gnc:debug accounts)
|
|
|
|
|
(if (not (null? accounts))
|
|
|
|
|
(if (null? the-acount-destination-alist)
|
|
|
|
|
(gnc:html-document-add-object!
|
|
|
|
|
document
|
|
|
|
|
(gnc:html-make-empty-data-warning
|
|
|
|
|
report-title (gnc:report-id report-obj)))
|
|
|
|
|
|
|
|
|
|
;; Define more helper variables.
|
|
|
|
|
(let* ((commodity-list #f)
|
|
|
|
|
@ -404,6 +396,34 @@ developing over time"))
|
|
|
|
|
((list? data) (myor (map not-all-zeros data)))
|
|
|
|
|
(else #f)))
|
|
|
|
|
|
|
|
|
|
;; Calculates the net balance (profit or loss) of an account in
|
|
|
|
|
;; the given time interval. date-list-entry is a pair containing
|
|
|
|
|
;; the start- and end-date of that interval. If subacct?==#t,
|
|
|
|
|
;; the subaccount's balances are included as well. Returns a
|
|
|
|
|
;; double, exchanged into the report-currency by the above
|
|
|
|
|
;; conversion function, and possibly with reversed sign.
|
|
|
|
|
(define (get-balance account date-list-entry subacct?)
|
|
|
|
|
((if (reverse-balance? account)
|
|
|
|
|
gnc:monetary-neg identity)
|
|
|
|
|
(if do-intervals?
|
|
|
|
|
(collector->monetary
|
|
|
|
|
(gnc:account-get-comm-balance-interval
|
|
|
|
|
account
|
|
|
|
|
(first date-list-entry)
|
|
|
|
|
(second date-list-entry) subacct?)
|
|
|
|
|
(second date-list-entry))
|
|
|
|
|
(collector->monetary
|
|
|
|
|
(gnc:account-get-comm-balance-at-date
|
|
|
|
|
account date-list-entry subacct?)
|
|
|
|
|
date-list-entry))))
|
|
|
|
|
|
|
|
|
|
;; Creates the <balance-list> to be used in the function
|
|
|
|
|
;; below.
|
|
|
|
|
(define (account->balance-list account subacct?)
|
|
|
|
|
(map
|
|
|
|
|
(lambda (d) (get-balance account d subacct?))
|
|
|
|
|
dates-list))
|
|
|
|
|
|
|
|
|
|
(define (count-accounts current-depth accts)
|
|
|
|
|
(if (< current-depth tree-depth)
|
|
|
|
|
(let ((sum 0))
|
|
|
|
|
@ -429,34 +449,33 @@ developing over time"))
|
|
|
|
|
;; show-acct? is true. This is necessary because otherwise we
|
|
|
|
|
;; would forget an account that is selected but not its
|
|
|
|
|
;; parent.
|
|
|
|
|
(define (apply-sign account x)
|
|
|
|
|
(if (reverse-balance? account) (gnc:monetary-neg x) x))
|
|
|
|
|
(define (calculate-report accounts progress-range)
|
|
|
|
|
(let* ((account-reformat
|
|
|
|
|
(if do-intervals?
|
|
|
|
|
(lambda (account result)
|
|
|
|
|
(map (lambda (collector datepair)
|
|
|
|
|
(let ((date (second datepair)))
|
|
|
|
|
(apply-sign account (collector->monetary collector date))))
|
|
|
|
|
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
|
|
|
|
|
(apply-sign account
|
|
|
|
|
(collector->monetary commodity-collector
|
|
|
|
|
date))))
|
|
|
|
|
(collector-into-list)
|
|
|
|
|
result dates-list))))))
|
|
|
|
|
|
|
|
|
|
(the-work (category-by-account-report-work do-intervals?
|
|
|
|
|
dates-list the-acount-destination-alist
|
|
|
|
|
(lambda (account date)
|
|
|
|
|
(make-gnc-collector-collector))
|
|
|
|
|
account-reformat))
|
|
|
|
|
(the-report (category-by-account-report-do-work the-work progress-range)))
|
|
|
|
|
the-report))
|
|
|
|
|
(define (traverse-accounts current-depth accts)
|
|
|
|
|
(if (< current-depth tree-depth)
|
|
|
|
|
(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
|
|
|
|
|
(+ 1 current-depth)
|
|
|
|
|
(gnc-account-get-children a))
|
|
|
|
|
res))))
|
|
|
|
|
accts)
|
|
|
|
|
res)
|
|
|
|
|
;; else (i.e. current-depth == tree-depth)
|
|
|
|
|
(map
|
|
|
|
|
(lambda (a)
|
|
|
|
|
(set! work-done (1+ work-done))
|
|
|
|
|
(gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do))))
|
|
|
|
|
(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
|
|
|
|
|
@ -476,12 +495,15 @@ developing over time"))
|
|
|
|
|
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 (sort
|
|
|
|
|
(filter (lambda (l)
|
|
|
|
|
(not (gnc-numeric-equal (gnc-numeric-zero)
|
|
|
|
|
(gnc:gnc-monetary-amount (apply monetary+ (cadr l))))))
|
|
|
|
|
(calculate-report accounts (cons 0 90)))
|
|
|
|
|
(set! all-data (sort
|
|
|
|
|
(filter (lambda (l)
|
|
|
|
|
(not (zero?
|
|
|
|
|
(gnc:gnc-monetary-amount
|
|
|
|
|
(apply monetary+ (cadr l))))))
|
|
|
|
|
(traverse-accounts 1 topl-accounts))
|
|
|
|
|
(cond
|
|
|
|
|
((eq? sort-method 'acct-code)
|
|
|
|
|
(lambda (a b)
|
|
|
|
|
@ -783,7 +805,7 @@ developing over time"))
|
|
|
|
|
(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 if no accounts selected
|
|
|
|
|
(gnc:html-document-add-object!
|
|
|
|
|
|
Christopher Lam
8 years ago