|
|
|
|
@ -25,7 +25,7 @@
|
|
|
|
|
;; depends must be outside module scope -- and should eventually go away.
|
|
|
|
|
(define-module (gnucash report standard-reports category-barchart))
|
|
|
|
|
(use-modules (srfi srfi-1))
|
|
|
|
|
(use-modules (gnucash utilities))
|
|
|
|
|
(use-modules (gnucash utilities))
|
|
|
|
|
(use-modules (gnucash gnc-module))
|
|
|
|
|
(use-modules (gnucash gettext))
|
|
|
|
|
|
|
|
|
|
@ -42,15 +42,15 @@
|
|
|
|
|
;; The names are used in the menu
|
|
|
|
|
|
|
|
|
|
;; The menu statusbar tips.
|
|
|
|
|
(define menutip-income
|
|
|
|
|
(define menutip-income
|
|
|
|
|
(N_ "Shows a chart with the Income per interval \
|
|
|
|
|
developing over time"))
|
|
|
|
|
(define menutip-expense
|
|
|
|
|
(define menutip-expense
|
|
|
|
|
(N_ "Shows a chart with the Expenses per interval \
|
|
|
|
|
developing over time"))
|
|
|
|
|
(define menutip-assets
|
|
|
|
|
(define menutip-assets
|
|
|
|
|
(N_ "Shows a chart with the Assets developing over time"))
|
|
|
|
|
(define menutip-liabilities
|
|
|
|
|
(define menutip-liabilities
|
|
|
|
|
(N_ "Shows a chart with the Liabilities \
|
|
|
|
|
developing over time"))
|
|
|
|
|
|
|
|
|
|
@ -87,8 +87,8 @@ developing over time"))
|
|
|
|
|
(define opthelp-averaging (N_ "Select whether the amounts should be shown over the full time period or rather as the average e.g. per month."))
|
|
|
|
|
|
|
|
|
|
(define (options-generator account-types reverse-balance? do-intervals?)
|
|
|
|
|
(let* ((options (gnc:new-options))
|
|
|
|
|
(add-option
|
|
|
|
|
(let* ((options (gnc:new-options))
|
|
|
|
|
(add-option
|
|
|
|
|
(lambda (new-option)
|
|
|
|
|
(gnc:register-option options new-option))))
|
|
|
|
|
|
|
|
|
|
@ -101,13 +101,13 @@ developing over time"))
|
|
|
|
|
options gnc:pagename-general
|
|
|
|
|
optname-from-date optname-to-date "a")
|
|
|
|
|
|
|
|
|
|
(gnc:options-add-interval-choice!
|
|
|
|
|
(gnc:options-add-interval-choice!
|
|
|
|
|
options gnc:pagename-general optname-stepsize "b" 'MonthDelta)
|
|
|
|
|
|
|
|
|
|
(gnc:options-add-currency!
|
|
|
|
|
(gnc:options-add-currency!
|
|
|
|
|
options gnc:pagename-general optname-report-currency "c")
|
|
|
|
|
|
|
|
|
|
(gnc:options-add-price-source!
|
|
|
|
|
(gnc:options-add-price-source!
|
|
|
|
|
options gnc:pagename-general
|
|
|
|
|
optname-price-source "d" 'weighted-average)
|
|
|
|
|
|
|
|
|
|
@ -141,17 +141,17 @@ developing over time"))
|
|
|
|
|
"a"
|
|
|
|
|
(N_ "Report on these accounts, if chosen account level allows.")
|
|
|
|
|
(lambda ()
|
|
|
|
|
(gnc:filter-accountlist-type
|
|
|
|
|
(gnc:filter-accountlist-type
|
|
|
|
|
account-types
|
|
|
|
|
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
|
|
|
|
|
(lambda (accounts)
|
|
|
|
|
(list #t
|
|
|
|
|
(gnc:filter-accountlist-type account-types accounts)))
|
|
|
|
|
#t))
|
|
|
|
|
|
|
|
|
|
(gnc:options-add-account-levels!
|
|
|
|
|
options gnc:pagename-accounts optname-levels "c"
|
|
|
|
|
(N_ "Show accounts to this depth and not further.")
|
|
|
|
|
|
|
|
|
|
(gnc:options-add-account-levels!
|
|
|
|
|
options gnc:pagename-accounts optname-levels "c"
|
|
|
|
|
(N_ "Show accounts to this depth and not further.")
|
|
|
|
|
2)
|
|
|
|
|
|
|
|
|
|
;; Display tab
|
|
|
|
|
@ -161,19 +161,19 @@ developing over time"))
|
|
|
|
|
"a" (N_ "Show the full account name in legend?") #f))
|
|
|
|
|
|
|
|
|
|
(add-option
|
|
|
|
|
(gnc:make-multichoice-option
|
|
|
|
|
gnc:pagename-display optname-chart-type
|
|
|
|
|
"b" "Select which chart type to use"
|
|
|
|
|
'barchart
|
|
|
|
|
(list (vector 'barchart
|
|
|
|
|
(N_ "Bar Chart")
|
|
|
|
|
(N_ "Use bar charts."))
|
|
|
|
|
(vector 'linechart
|
|
|
|
|
(N_ "Line Chart")
|
|
|
|
|
(N_ "Use line charts."))
|
|
|
|
|
)
|
|
|
|
|
(gnc:make-multichoice-option
|
|
|
|
|
gnc:pagename-display optname-chart-type
|
|
|
|
|
"b" "Select which chart type to use"
|
|
|
|
|
'barchart
|
|
|
|
|
(list (vector 'barchart
|
|
|
|
|
(N_ "Bar Chart")
|
|
|
|
|
(N_ "Use bar charts."))
|
|
|
|
|
(vector 'linechart
|
|
|
|
|
(N_ "Line Chart")
|
|
|
|
|
(N_ "Use line charts."))
|
|
|
|
|
)
|
|
|
|
|
)
|
|
|
|
|
)
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
(add-option
|
|
|
|
|
(gnc:make-simple-boolean-option
|
|
|
|
|
@ -195,11 +195,11 @@ developing over time"))
|
|
|
|
|
"e" (N_ "Display a table of the selected data.")
|
|
|
|
|
#f))
|
|
|
|
|
|
|
|
|
|
(gnc:options-add-plot-size!
|
|
|
|
|
options gnc:pagename-display
|
|
|
|
|
(gnc:options-add-plot-size!
|
|
|
|
|
options gnc:pagename-display
|
|
|
|
|
optname-plot-width optname-plot-height "f" (cons 'percent 100.0) (cons 'percent 100.0))
|
|
|
|
|
|
|
|
|
|
(gnc:options-add-sort-method!
|
|
|
|
|
(gnc:options-add-sort-method!
|
|
|
|
|
options gnc:pagename-display
|
|
|
|
|
optname-sort-method "g" 'amount)
|
|
|
|
|
|
|
|
|
|
@ -219,63 +219,63 @@ developing over time"))
|
|
|
|
|
;; constant over the whole report period. Note that this might get
|
|
|
|
|
;; *really* complicated.
|
|
|
|
|
|
|
|
|
|
(define (category-barchart-renderer report-obj reportname reportguid
|
|
|
|
|
(define (category-barchart-renderer report-obj reportname reportguid
|
|
|
|
|
account-types do-intervals?)
|
|
|
|
|
;; A helper functions for looking up option values.
|
|
|
|
|
(define (get-option section name)
|
|
|
|
|
(gnc:option-value
|
|
|
|
|
(gnc:lookup-option
|
|
|
|
|
(gnc:option-value
|
|
|
|
|
(gnc:lookup-option
|
|
|
|
|
(gnc:report-options report-obj) section name)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(gnc:report-starting reportname)
|
|
|
|
|
(let* ((to-date-t64 (gnc:time64-end-day-time
|
|
|
|
|
(gnc:date-option-absolute-time
|
|
|
|
|
(get-option gnc:pagename-general
|
|
|
|
|
(get-option gnc:pagename-general
|
|
|
|
|
optname-to-date))))
|
|
|
|
|
(from-date-t64 (gnc:time64-start-day-time
|
|
|
|
|
(gnc:date-option-absolute-time
|
|
|
|
|
(get-option gnc:pagename-general
|
|
|
|
|
optname-from-date))))
|
|
|
|
|
(interval (get-option gnc:pagename-general optname-stepsize))
|
|
|
|
|
(report-currency (get-option gnc:pagename-general
|
|
|
|
|
optname-report-currency))
|
|
|
|
|
(price-source (get-option gnc:pagename-general
|
|
|
|
|
optname-price-source))
|
|
|
|
|
(report-title (get-option gnc:pagename-general
|
|
|
|
|
gnc:optname-reportname))
|
|
|
|
|
(averaging-selection (if do-intervals?
|
|
|
|
|
(get-option gnc:pagename-general
|
|
|
|
|
optname-averaging)
|
|
|
|
|
'None))
|
|
|
|
|
|
|
|
|
|
(accounts (get-option gnc:pagename-accounts optname-accounts))
|
|
|
|
|
(account-levels (get-option gnc:pagename-accounts optname-levels))
|
|
|
|
|
|
|
|
|
|
(chart-type (get-option gnc:pagename-display optname-chart-type))
|
|
|
|
|
(stacked? (get-option gnc:pagename-display optname-stacked))
|
|
|
|
|
(show-fullname? (get-option gnc:pagename-display optname-fullname))
|
|
|
|
|
(max-slices (inexact->exact
|
|
|
|
|
(get-option gnc:pagename-display optname-slices)))
|
|
|
|
|
(height (get-option gnc:pagename-display optname-plot-height))
|
|
|
|
|
(width (get-option gnc:pagename-display optname-plot-width))
|
|
|
|
|
(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
|
|
|
|
|
(if (eqv? chart-type 'barchart)
|
|
|
|
|
(from-date-t64 (gnc:time64-start-day-time
|
|
|
|
|
(gnc:date-option-absolute-time
|
|
|
|
|
(get-option gnc:pagename-general
|
|
|
|
|
optname-from-date))))
|
|
|
|
|
(interval (get-option gnc:pagename-general optname-stepsize))
|
|
|
|
|
(report-currency (get-option gnc:pagename-general
|
|
|
|
|
optname-report-currency))
|
|
|
|
|
(price-source (get-option gnc:pagename-general
|
|
|
|
|
optname-price-source))
|
|
|
|
|
(report-title (get-option gnc:pagename-general
|
|
|
|
|
gnc:optname-reportname))
|
|
|
|
|
(averaging-selection (if do-intervals?
|
|
|
|
|
(get-option gnc:pagename-general
|
|
|
|
|
optname-averaging)
|
|
|
|
|
'None))
|
|
|
|
|
|
|
|
|
|
(accounts (get-option gnc:pagename-accounts optname-accounts))
|
|
|
|
|
(account-levels (get-option gnc:pagename-accounts optname-levels))
|
|
|
|
|
|
|
|
|
|
(chart-type (get-option gnc:pagename-display optname-chart-type))
|
|
|
|
|
(stacked? (get-option gnc:pagename-display optname-stacked))
|
|
|
|
|
(show-fullname? (get-option gnc:pagename-display optname-fullname))
|
|
|
|
|
(max-slices (inexact->exact
|
|
|
|
|
(get-option gnc:pagename-display optname-slices)))
|
|
|
|
|
(height (get-option gnc:pagename-display optname-plot-height))
|
|
|
|
|
(width (get-option gnc:pagename-display optname-plot-width))
|
|
|
|
|
(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
|
|
|
|
|
(if (eqv? chart-type 'barchart)
|
|
|
|
|
(gnc:make-html-barchart)
|
|
|
|
|
(gnc:make-html-linechart)
|
|
|
|
|
))
|
|
|
|
|
(table (gnc:make-html-table))
|
|
|
|
|
(topl-accounts (gnc:filter-accountlist-type
|
|
|
|
|
account-types
|
|
|
|
|
(gnc-account-get-children-sorted
|
|
|
|
|
(gnc-get-current-root-account)))))
|
|
|
|
|
|
|
|
|
|
))
|
|
|
|
|
(table (gnc:make-html-table))
|
|
|
|
|
(topl-accounts (gnc:filter-accountlist-type
|
|
|
|
|
account-types
|
|
|
|
|
(gnc-account-get-children-sorted
|
|
|
|
|
(gnc-get-current-root-account)))))
|
|
|
|
|
|
|
|
|
|
;; Returns true if the account a was selected in the account
|
|
|
|
|
;; selection option.
|
|
|
|
|
(define (show-acct? a)
|
|
|
|
|
@ -294,43 +294,43 @@ developing over time"))
|
|
|
|
|
(averaging-fraction-func (gnc:date-get-fraction-func averaging-selection))
|
|
|
|
|
(interval-fraction-func (gnc:date-get-fraction-func interval))
|
|
|
|
|
(averaging-multiplier
|
|
|
|
|
(if averaging-fraction-func
|
|
|
|
|
;; Calculate the divisor of the amounts so that an
|
|
|
|
|
;; average is shown. Multiplier factor is a gnc-numeric
|
|
|
|
|
(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
|
|
|
|
|
1000000))
|
|
|
|
|
(start-frac-int (interval-fraction-func from-date-t64))
|
|
|
|
|
(end-frac-int (interval-fraction-func (+ 1 to-date-t64)))
|
|
|
|
|
(diff-int (- end-frac-int start-frac-int))
|
|
|
|
|
(diff-int-numeric (/
|
|
|
|
|
(inexact->exact diff-int) 1))
|
|
|
|
|
)
|
|
|
|
|
;; Extra sanity check to ensure a number smaller than 1
|
|
|
|
|
(if (> diff-avg diff-int)
|
|
|
|
|
(gnc-numeric-div diff-int-numeric diff-avg-numeric GNC-DENOM-AUTO GNC-RND-ROUND)
|
|
|
|
|
1/1))
|
|
|
|
|
1/1))
|
|
|
|
|
(if averaging-fraction-func
|
|
|
|
|
;; Calculate the divisor of the amounts so that an
|
|
|
|
|
;; average is shown. Multiplier factor is a gnc-numeric
|
|
|
|
|
(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
|
|
|
|
|
1000000))
|
|
|
|
|
(start-frac-int (interval-fraction-func from-date-t64))
|
|
|
|
|
(end-frac-int (interval-fraction-func (+ 1 to-date-t64)))
|
|
|
|
|
(diff-int (- end-frac-int start-frac-int))
|
|
|
|
|
(diff-int-numeric (/
|
|
|
|
|
(inexact->exact diff-int) 1))
|
|
|
|
|
)
|
|
|
|
|
;; Extra sanity check to ensure a number smaller than 1
|
|
|
|
|
(if (> diff-avg diff-int)
|
|
|
|
|
(gnc-numeric-div diff-int-numeric diff-avg-numeric GNC-DENOM-AUTO GNC-RND-ROUND)
|
|
|
|
|
1/1))
|
|
|
|
|
1/1))
|
|
|
|
|
;; If there is averaging, the report-title is extended
|
|
|
|
|
;; accordingly.
|
|
|
|
|
(report-title
|
|
|
|
|
(case averaging-selection
|
|
|
|
|
((MonthDelta) (string-append report-title " " (_ "Monthly Average")))
|
|
|
|
|
((WeekDelta) (string-append report-title " " (_ "Weekly Average")))
|
|
|
|
|
((DayDelta) (string-append report-title " " (_ "Daily Average")))
|
|
|
|
|
(else report-title)))
|
|
|
|
|
(case averaging-selection
|
|
|
|
|
((MonthDelta) (string-append report-title " " (_ "Monthly Average")))
|
|
|
|
|
((WeekDelta) (string-append report-title " " (_ "Weekly Average")))
|
|
|
|
|
((DayDelta) (string-append report-title " " (_ "Daily Average")))
|
|
|
|
|
(else report-title)))
|
|
|
|
|
(currency-frac (gnc-commodity-get-fraction report-currency))
|
|
|
|
|
;; This is the list of date intervals to calculate.
|
|
|
|
|
(dates-list (if do-intervals?
|
|
|
|
|
(gnc:make-date-interval-list
|
|
|
|
|
(gnc:time64-start-day-time from-date-t64)
|
|
|
|
|
(gnc:time64-start-day-time from-date-t64)
|
|
|
|
|
(gnc:time64-end-day-time to-date-t64)
|
|
|
|
|
(gnc:deltasym-to-delta interval))
|
|
|
|
|
(gnc:make-date-list
|
|
|
|
|
(gnc:time64-end-day-time from-date-t64)
|
|
|
|
|
(gnc:time64-end-day-time from-date-t64)
|
|
|
|
|
(gnc:time64-end-day-time to-date-t64)
|
|
|
|
|
(gnc:deltasym-to-delta interval))))
|
|
|
|
|
;; Here the date strings for the x-axis labels are
|
|
|
|
|
@ -343,10 +343,10 @@ developing over time"))
|
|
|
|
|
|
|
|
|
|
(define (datelist->stringlist dates-list)
|
|
|
|
|
(map (lambda (date-list-item)
|
|
|
|
|
(qof-print-date
|
|
|
|
|
(if do-intervals?
|
|
|
|
|
(car date-list-item)
|
|
|
|
|
date-list-item)))
|
|
|
|
|
(qof-print-date
|
|
|
|
|
(if do-intervals?
|
|
|
|
|
(car date-list-item)
|
|
|
|
|
date-list-item)))
|
|
|
|
|
dates-list))
|
|
|
|
|
|
|
|
|
|
;; Converts a commodity-collector into gnc-monetary in the report's
|
|
|
|
|
@ -361,11 +361,11 @@ developing over time"))
|
|
|
|
|
report-currency
|
|
|
|
|
(gnc-numeric-mul
|
|
|
|
|
(gnc:gnc-monetary-amount
|
|
|
|
|
(gnc:sum-collector-commodity
|
|
|
|
|
(gnc:sum-collector-commodity
|
|
|
|
|
c report-currency
|
|
|
|
|
(lambda (a b) (exchange-fn a b date))))
|
|
|
|
|
averaging-multiplier currency-frac GNC-RND-ROUND)
|
|
|
|
|
))
|
|
|
|
|
))
|
|
|
|
|
|
|
|
|
|
;; Add two or more gnc-monetary objects
|
|
|
|
|
(define (monetary+ a . blist)
|
|
|
|
|
@ -407,9 +407,9 @@ developing over time"))
|
|
|
|
|
gnc:monetary-neg identity)
|
|
|
|
|
(if do-intervals?
|
|
|
|
|
(collector->monetary
|
|
|
|
|
(gnc:account-get-comm-balance-interval
|
|
|
|
|
account
|
|
|
|
|
(first date-list-entry)
|
|
|
|
|
(gnc:account-get-comm-balance-interval
|
|
|
|
|
account
|
|
|
|
|
(first date-list-entry)
|
|
|
|
|
(second date-list-entry) subacct?)
|
|
|
|
|
(second date-list-entry))
|
|
|
|
|
(collector->monetary
|
|
|
|
|
@ -417,23 +417,23 @@ developing over time"))
|
|
|
|
|
account date-list-entry subacct?)
|
|
|
|
|
date-list-entry))))
|
|
|
|
|
|
|
|
|
|
;; Creates the <balance-list> to be used in the function
|
|
|
|
|
;; below.
|
|
|
|
|
;; Creates the <balance-list> to be used in the function
|
|
|
|
|
;; below.
|
|
|
|
|
(define (account->balance-list account subacct?)
|
|
|
|
|
(map
|
|
|
|
|
(map
|
|
|
|
|
(lambda (d) (get-balance account d subacct?))
|
|
|
|
|
dates-list))
|
|
|
|
|
|
|
|
|
|
(define (count-accounts current-depth accts)
|
|
|
|
|
(if (< current-depth tree-depth)
|
|
|
|
|
(let ((sum 0))
|
|
|
|
|
(for-each
|
|
|
|
|
(lambda (a)
|
|
|
|
|
(set! sum (+ sum (+ 1 (count-accounts (+ 1 current-depth)
|
|
|
|
|
(gnc-account-get-children a))))))
|
|
|
|
|
accts)
|
|
|
|
|
sum)
|
|
|
|
|
(length (filter show-acct? accts))))
|
|
|
|
|
(define (count-accounts current-depth accts)
|
|
|
|
|
(if (< current-depth tree-depth)
|
|
|
|
|
(let ((sum 0))
|
|
|
|
|
(for-each
|
|
|
|
|
(lambda (a)
|
|
|
|
|
(set! sum (+ sum (+ 1 (count-accounts (+ 1 current-depth)
|
|
|
|
|
(gnc-account-get-children a))))))
|
|
|
|
|
accts)
|
|
|
|
|
sum)
|
|
|
|
|
(length (filter show-acct? accts))))
|
|
|
|
|
|
|
|
|
|
;; Calculates all account's balances. Returns a list of pairs:
|
|
|
|
|
;; (<account> <balance-list>), like '((Earnings (10.0 11.2))
|
|
|
|
|
@ -455,10 +455,10 @@ developing over time"))
|
|
|
|
|
(for-each
|
|
|
|
|
(lambda (a)
|
|
|
|
|
(begin
|
|
|
|
|
(set! work-done (1+ work-done))
|
|
|
|
|
(gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do))))
|
|
|
|
|
(set! work-done (1+ work-done))
|
|
|
|
|
(gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do))))
|
|
|
|
|
(if (show-acct? a)
|
|
|
|
|
(set! res
|
|
|
|
|
(set! res
|
|
|
|
|
(cons (list a (account->balance-list a #f))
|
|
|
|
|
res)))
|
|
|
|
|
(set! res (append
|
|
|
|
|
@ -471,11 +471,11 @@ developing over time"))
|
|
|
|
|
;; 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))))
|
|
|
|
|
(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
|
|
|
|
|
@ -484,251 +484,251 @@ developing over time"))
|
|
|
|
|
;; 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
|
|
|
|
|
(append
|
|
|
|
|
(gnc:report-percent-done 1)
|
|
|
|
|
(set! commodity-list (gnc:accounts-get-commodities
|
|
|
|
|
(append
|
|
|
|
|
(gnc:acccounts-get-all-subaccounts accounts)
|
|
|
|
|
accounts)
|
|
|
|
|
report-currency))
|
|
|
|
|
(set! exchange-fn (gnc:case-exchange-time-fn
|
|
|
|
|
price-source report-currency
|
|
|
|
|
(set! exchange-fn (gnc:case-exchange-time-fn
|
|
|
|
|
price-source report-currency
|
|
|
|
|
commodity-list to-date-t64
|
|
|
|
|
5 15))
|
|
|
|
|
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)
|
|
|
|
|
(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)
|
|
|
|
|
(string<? (xaccAccountGetCode (car a))
|
|
|
|
|
(xaccAccountGetCode (car b)))))
|
|
|
|
|
((eq? sort-method 'alphabetical)
|
|
|
|
|
(lambda (a b)
|
|
|
|
|
(string<? ((if show-fullname?
|
|
|
|
|
gnc-account-get-full-name
|
|
|
|
|
xaccAccountGetName) (car a))
|
|
|
|
|
((if show-fullname?
|
|
|
|
|
gnc-account-get-full-name
|
|
|
|
|
xaccAccountGetName) (car b)))))
|
|
|
|
|
(else
|
|
|
|
|
(lambda (a b)
|
|
|
|
|
(cond
|
|
|
|
|
((eq? sort-method 'acct-code)
|
|
|
|
|
(lambda (a b)
|
|
|
|
|
(string<? (xaccAccountGetCode (car a))
|
|
|
|
|
(xaccAccountGetCode (car b)))))
|
|
|
|
|
((eq? sort-method 'alphabetical)
|
|
|
|
|
(lambda (a b)
|
|
|
|
|
(string<? ((if show-fullname?
|
|
|
|
|
gnc-account-get-full-name
|
|
|
|
|
xaccAccountGetName) (car a))
|
|
|
|
|
((if show-fullname?
|
|
|
|
|
gnc-account-get-full-name
|
|
|
|
|
xaccAccountGetName) (car b)))))
|
|
|
|
|
(else
|
|
|
|
|
(lambda (a b)
|
|
|
|
|
(> (gnc-numeric-compare (gnc:gnc-monetary-amount (apply monetary+ (cadr a)))
|
|
|
|
|
(gnc:gnc-monetary-amount (apply monetary+ (cadr b))))
|
|
|
|
|
0)))
|
|
|
|
|
)))
|
|
|
|
|
)))
|
|
|
|
|
;; Or rather sort by total amount?
|
|
|
|
|
;;(< (apply + (cadr a))
|
|
|
|
|
;;(< (apply + (cadr a))
|
|
|
|
|
;; (apply + (cadr b))))))
|
|
|
|
|
;; Other sort criteria: max. amount, standard deviation of amount,
|
|
|
|
|
;; min. amount; ascending, descending. FIXME: Add user options to
|
|
|
|
|
;; choose sorting.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;(gnc:warn "all-data" all-data)
|
|
|
|
|
|
|
|
|
|
;; Proceed if the data is non-zeros
|
|
|
|
|
(if
|
|
|
|
|
(if
|
|
|
|
|
(and (not (null? all-data))
|
|
|
|
|
(not-all-zeros (map cadr all-data)))
|
|
|
|
|
(begin
|
|
|
|
|
(begin
|
|
|
|
|
(set! date-string-list (datelist->stringlist dates-list))
|
|
|
|
|
(qof-date-format-set QOF-DATE-FORMAT-ISO)
|
|
|
|
|
(set! date-iso-string-list (datelist->stringlist dates-list))
|
|
|
|
|
(qof-date-format-set save-fmt)
|
|
|
|
|
;; Set chart title, subtitle etc.
|
|
|
|
|
(if (eqv? 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"))
|
|
|
|
|
(gnc:html-string-sanitize (qof-print-date from-date-t64))
|
|
|
|
|
(gnc:html-string-sanitize (qof-print-date to-date-t64))))
|
|
|
|
|
|
|
|
|
|
(gnc:html-barchart-set-width! chart width)
|
|
|
|
|
(gnc:html-barchart-set-height! chart height)
|
|
|
|
|
|
|
|
|
|
;; row labels etc.
|
|
|
|
|
(gnc:html-barchart-set-row-labels! chart date-string-list)
|
|
|
|
|
;; FIXME: axis labels are not yet supported by
|
|
|
|
|
;; libguppitank.
|
|
|
|
|
(gnc:html-barchart-set-y-axis-label!
|
|
|
|
|
chart (gnc-commodity-get-mnemonic report-currency))
|
|
|
|
|
(gnc:html-barchart-set-row-labels-rotated?! chart #t)
|
|
|
|
|
(gnc:html-barchart-set-stacked?! chart stacked?)
|
|
|
|
|
;; 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"))
|
|
|
|
|
(gnc:html-string-sanitize (qof-print-date from-date-t64))
|
|
|
|
|
(gnc:html-string-sanitize (qof-print-date to-date-t64))))
|
|
|
|
|
|
|
|
|
|
(gnc:html-linechart-set-width! chart width)
|
|
|
|
|
(gnc:html-linechart-set-height! chart height)
|
|
|
|
|
|
|
|
|
|
;; row labels etc.
|
|
|
|
|
(gnc:html-linechart-set-row-labels! chart date-iso-string-list)
|
|
|
|
|
;; FIXME: axis labels are not yet supported by
|
|
|
|
|
;; 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?)
|
|
|
|
|
)
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
(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"))
|
|
|
|
|
(gnc:html-string-sanitize (qof-print-date from-date-t64))
|
|
|
|
|
(gnc:html-string-sanitize (qof-print-date to-date-t64))))
|
|
|
|
|
|
|
|
|
|
(gnc:html-barchart-set-width! chart width)
|
|
|
|
|
(gnc:html-barchart-set-height! chart height)
|
|
|
|
|
|
|
|
|
|
;; row labels etc.
|
|
|
|
|
(gnc:html-barchart-set-row-labels! chart date-string-list)
|
|
|
|
|
;; FIXME: axis labels are not yet supported by
|
|
|
|
|
;; libguppitank.
|
|
|
|
|
(gnc:html-barchart-set-y-axis-label!
|
|
|
|
|
chart (gnc-commodity-get-mnemonic report-currency))
|
|
|
|
|
(gnc:html-barchart-set-row-labels-rotated?! chart #t)
|
|
|
|
|
(gnc:html-barchart-set-stacked?! chart stacked?)
|
|
|
|
|
;; 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"))
|
|
|
|
|
(gnc:html-string-sanitize (qof-print-date from-date-t64))
|
|
|
|
|
(gnc:html-string-sanitize (qof-print-date to-date-t64))))
|
|
|
|
|
|
|
|
|
|
(gnc:html-linechart-set-width! chart width)
|
|
|
|
|
(gnc:html-linechart-set-height! chart height)
|
|
|
|
|
|
|
|
|
|
;; row labels etc.
|
|
|
|
|
(gnc:html-linechart-set-row-labels! chart date-iso-string-list)
|
|
|
|
|
;; FIXME: axis labels are not yet supported by
|
|
|
|
|
;; 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
|
|
|
|
|
;; 'other' category and add a link to a new report with just
|
|
|
|
|
;; those accounts.
|
|
|
|
|
(if (> (length all-data) max-slices)
|
|
|
|
|
(let* ((start (take all-data (- max-slices 1)))
|
|
|
|
|
(finish (drop all-data (- max-slices 1)))
|
|
|
|
|
(other-sum (map
|
|
|
|
|
(other-sum (map
|
|
|
|
|
(lambda (l) (apply monetary+ l))
|
|
|
|
|
(apply zip (map cadr finish)))))
|
|
|
|
|
(set! all-data
|
|
|
|
|
(append start
|
|
|
|
|
(list (list (_ "Other") other-sum))))
|
|
|
|
|
(append start
|
|
|
|
|
(list (list (_ "Other") other-sum))))
|
|
|
|
|
(let* ((options (gnc:make-report-options reportguid))
|
|
|
|
|
(id #f))
|
|
|
|
|
;; now copy all the options
|
|
|
|
|
(gnc:options-copy-values
|
|
|
|
|
(gnc:options-copy-values
|
|
|
|
|
(gnc:report-options report-obj) options)
|
|
|
|
|
;; and set the destination accounts
|
|
|
|
|
(gnc:option-set-value
|
|
|
|
|
(gnc:lookup-option options gnc:pagename-accounts
|
|
|
|
|
(gnc:lookup-option options gnc:pagename-accounts
|
|
|
|
|
optname-accounts)
|
|
|
|
|
(map car finish))
|
|
|
|
|
;; Set the URL to point to this report.
|
|
|
|
|
(set! id (gnc:make-report reportguid options))
|
|
|
|
|
(set! other-anchor (gnc:report-anchor-text id)))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; 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 (eqv? chart-type 'barchart)
|
|
|
|
|
(begin ;; bar chart
|
|
|
|
|
(if (not (null? all-data))
|
|
|
|
|
(gnc:html-barchart-set-data!
|
|
|
|
|
chart
|
|
|
|
|
(apply zip (map (lambda (mlist)
|
|
|
|
|
(map monetary->double mlist))
|
|
|
|
|
(map cadr all-data)))))
|
|
|
|
|
|
|
|
|
|
;; Labels and colors
|
|
|
|
|
(gnc:report-percent-done 94)
|
|
|
|
|
(gnc:html-barchart-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-barchart-set-col-colors!
|
|
|
|
|
chart
|
|
|
|
|
(gnc:assign-colors (length all-data)))
|
|
|
|
|
)
|
|
|
|
|
(begin ;; line chart
|
|
|
|
|
(if (not (null? all-data))
|
|
|
|
|
(gnc:html-linechart-set-data!
|
|
|
|
|
chart
|
|
|
|
|
(apply zip (map (lambda (mlist)
|
|
|
|
|
(map monetary->double mlist))
|
|
|
|
|
(map cadr all-data)))))
|
|
|
|
|
|
|
|
|
|
;; Labels and colors
|
|
|
|
|
(gnc:report-percent-done 94)
|
|
|
|
|
(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)))
|
|
|
|
|
)
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
(begin ;; bar chart
|
|
|
|
|
(if (not (null? all-data))
|
|
|
|
|
(gnc:html-barchart-set-data!
|
|
|
|
|
chart
|
|
|
|
|
(apply zip (map (lambda (mlist)
|
|
|
|
|
(map monetary->double mlist))
|
|
|
|
|
(map cadr all-data)))))
|
|
|
|
|
|
|
|
|
|
;; Labels and colors
|
|
|
|
|
(gnc:report-percent-done 94)
|
|
|
|
|
(gnc:html-barchart-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-barchart-set-col-colors!
|
|
|
|
|
chart
|
|
|
|
|
(gnc:assign-colors (length all-data)))
|
|
|
|
|
)
|
|
|
|
|
(begin ;; line chart
|
|
|
|
|
(if (not (null? all-data))
|
|
|
|
|
(gnc:html-linechart-set-data!
|
|
|
|
|
chart
|
|
|
|
|
(apply zip (map (lambda (mlist)
|
|
|
|
|
(map monetary->double mlist))
|
|
|
|
|
(map cadr all-data)))))
|
|
|
|
|
|
|
|
|
|
;; Labels and colors
|
|
|
|
|
(gnc:report-percent-done 94)
|
|
|
|
|
(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
|
|
|
|
|
;; (gnc:report-percent-done 96)
|
|
|
|
|
;; (let
|
|
|
|
|
;; ((urls
|
|
|
|
|
;; (map
|
|
|
|
|
;; (lambda (pair)
|
|
|
|
|
;; (if
|
|
|
|
|
;; (string? (car pair))
|
|
|
|
|
;; other-anchor
|
|
|
|
|
;; (let* ((acct (car pair))
|
|
|
|
|
;; (subaccts
|
|
|
|
|
;; (gnc-account-get-children acct)))
|
|
|
|
|
;; (if (null? subaccts)
|
|
|
|
|
;; ;; if leaf-account, make this an anchor
|
|
|
|
|
;; ;; to the register.
|
|
|
|
|
;; (gnc:account-anchor-text acct)
|
|
|
|
|
;; ;; 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
|
|
|
|
|
;; reportguid
|
|
|
|
|
;; 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))))))))
|
|
|
|
|
;; all-data)))
|
|
|
|
|
;; (if (eqv? 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 96)
|
|
|
|
|
;; (let
|
|
|
|
|
;; ((urls
|
|
|
|
|
;; (map
|
|
|
|
|
;; (lambda (pair)
|
|
|
|
|
;; (if
|
|
|
|
|
;; (string? (car pair))
|
|
|
|
|
;; other-anchor
|
|
|
|
|
;; (let* ((acct (car pair))
|
|
|
|
|
;; (subaccts
|
|
|
|
|
;; (gnc-account-get-children acct)))
|
|
|
|
|
;; (if (null? subaccts)
|
|
|
|
|
;; ;; if leaf-account, make this an anchor
|
|
|
|
|
;; ;; to the register.
|
|
|
|
|
;; (gnc:account-anchor-text acct)
|
|
|
|
|
;; ;; 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
|
|
|
|
|
;; reportguid
|
|
|
|
|
;; 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))))))))
|
|
|
|
|
;; all-data)))
|
|
|
|
|
;; (if (eqv? 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:html-document-add-object! document chart)
|
|
|
|
|
(if show-table?
|
|
|
|
|
(begin
|
|
|
|
|
@ -753,11 +753,11 @@ developing over time"))
|
|
|
|
|
(append
|
|
|
|
|
(list (_ "Date"))
|
|
|
|
|
(map (lambda (pair)
|
|
|
|
|
(if (string? (car pair))
|
|
|
|
|
(car pair)
|
|
|
|
|
((if show-fullname?
|
|
|
|
|
gnc-account-get-full-name
|
|
|
|
|
xaccAccountGetName) (car pair))))
|
|
|
|
|
(if (string? (car pair))
|
|
|
|
|
(car pair)
|
|
|
|
|
((if show-fullname?
|
|
|
|
|
gnc-account-get-full-name
|
|
|
|
|
xaccAccountGetName) (car pair))))
|
|
|
|
|
all-data)
|
|
|
|
|
(if (> (gnc:html-table-num-columns table) 2)
|
|
|
|
|
(list (_ "Grand Total"))
|
|
|
|
|
@ -789,7 +789,7 @@ developing over time"))
|
|
|
|
|
)
|
|
|
|
|
)
|
|
|
|
|
)
|
|
|
|
|
;; set numeric columns to align right
|
|
|
|
|
;; set numeric columns to align right
|
|
|
|
|
(for-each
|
|
|
|
|
(lambda (col)
|
|
|
|
|
(gnc:html-table-set-col-style!
|
|
|
|
|
@ -805,28 +805,28 @@ developing over time"))
|
|
|
|
|
(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))))
|
|
|
|
|
|
|
|
|
|
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))))
|
|
|
|
|
|
|
|
|
|
(gnc:report-finished)
|
|
|
|
|
document))
|
|
|
|
|
|
|
|
|
|
;; Export reports
|
|
|
|
|
|
|
|
|
|
(export category-barchart-income-uuid category-barchart-expense-uuid
|
|
|
|
|
category-barchart-asset-uuid category-barchart-liability-uuid)
|
|
|
|
|
category-barchart-asset-uuid category-barchart-liability-uuid)
|
|
|
|
|
|
|
|
|
|
(define category-barchart-income-uuid "44f81bee049b4b3ea908f8dac9a9474e")
|
|
|
|
|
(define category-barchart-expense-uuid "b1f15b2052c149df93e698fe85a81ea6")
|
|
|
|
|
(define category-barchart-asset-uuid "e9cf815f79db44bcb637d0295093ae3d")
|
|
|
|
|
(define category-barchart-liability-uuid "faf410e8f8da481fbc09e4763da40bcc")
|
|
|
|
|
|
|
|
|
|
(for-each
|
|
|
|
|
(for-each
|
|
|
|
|
(lambda (l)
|
|
|
|
|
(let ((tip-and-rev (cddddr l)))
|
|
|
|
|
(gnc:define-report
|
|
|
|
|
@ -834,31 +834,31 @@ developing over time"))
|
|
|
|
|
'name (car l)
|
|
|
|
|
'report-guid (car (reverse l))
|
|
|
|
|
'menu-path (if (caddr l)
|
|
|
|
|
(list gnc:menuname-income-expense)
|
|
|
|
|
(list gnc:menuname-asset-liability))
|
|
|
|
|
(list gnc:menuname-income-expense)
|
|
|
|
|
(list gnc:menuname-asset-liability))
|
|
|
|
|
'menu-name (cadddr l)
|
|
|
|
|
'menu-tip (car tip-and-rev)
|
|
|
|
|
'options-generator (lambda () (options-generator (cadr l)
|
|
|
|
|
'options-generator (lambda () (options-generator (cadr l)
|
|
|
|
|
(cadr tip-and-rev)
|
|
|
|
|
(caddr l)))
|
|
|
|
|
'renderer (lambda (report-obj)
|
|
|
|
|
(category-barchart-renderer report-obj
|
|
|
|
|
(car l)
|
|
|
|
|
(car (reverse l))
|
|
|
|
|
(cadr l)
|
|
|
|
|
(caddr l))))))
|
|
|
|
|
(list
|
|
|
|
|
;; reportname, account-types, do-intervals?,
|
|
|
|
|
(category-barchart-renderer report-obj
|
|
|
|
|
(car l)
|
|
|
|
|
(car (reverse l))
|
|
|
|
|
(cadr l)
|
|
|
|
|
(caddr l))))))
|
|
|
|
|
(list
|
|
|
|
|
;; reportname, account-types, do-intervals?,
|
|
|
|
|
;; menu-reportname, menu-tip
|
|
|
|
|
(list reportname-income (list ACCT-TYPE-INCOME) #t menuname-income menutip-income (lambda (x) #t) category-barchart-income-uuid)
|
|
|
|
|
(list reportname-expense (list ACCT-TYPE-EXPENSE) #t menuname-expense menutip-expense (lambda (x) #f) category-barchart-expense-uuid)
|
|
|
|
|
(list reportname-assets
|
|
|
|
|
(list reportname-assets
|
|
|
|
|
(list ACCT-TYPE-ASSET ACCT-TYPE-BANK ACCT-TYPE-CASH ACCT-TYPE-CHECKING
|
|
|
|
|
ACCT-TYPE-SAVINGS ACCT-TYPE-MONEYMRKT
|
|
|
|
|
ACCT-TYPE-RECEIVABLE ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL
|
|
|
|
|
ACCT-TYPE-CURRENCY)
|
|
|
|
|
#f menuname-assets menutip-assets (lambda (x) #f) category-barchart-asset-uuid)
|
|
|
|
|
(list reportname-liabilities
|
|
|
|
|
(list reportname-liabilities
|
|
|
|
|
(list ACCT-TYPE-LIABILITY ACCT-TYPE-PAYABLE ACCT-TYPE-CREDIT
|
|
|
|
|
ACCT-TYPE-CREDITLINE)
|
|
|
|
|
#f menuname-liabilities menutip-liabilities (lambda (x) #t) category-barchart-liability-uuid)))
|
|
|
|
|
|
Christopher Lam
8 years ago