mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[budget-barchart] allow budget-period selection
This commit changes report to choose start/end budget periods instead of start/end dates for reporting.
This commit is contained in:
Christopher Lam
parent
f7ff85b8c3
commit
a323b25067
@ -44,28 +44,94 @@
|
||||
(define opthelp-chart-type (N_ "Select which chart type to use"))
|
||||
(define optname-plot-width (N_ "Plot Width"))
|
||||
(define optname-plot-height (N_ "Plot Height"))
|
||||
(define optname-from-date (N_ "Start Date"))
|
||||
(define optname-to-date (N_ "End Date"))
|
||||
|
||||
(define optname-depth-limit (N_ "Levels of Subaccounts"))
|
||||
(define opthelp-depth-limit
|
||||
(N_ "Maximum number of levels in the account tree displayed."))
|
||||
|
||||
;(define (options-generator inc-exp?)
|
||||
(define optname-budget-period-start (N_ "Range start"))
|
||||
(define opthelp-budget-period-start
|
||||
(N_ "Select a budget period type that starts the reporting range."))
|
||||
(define optname-budget-period-start-exact (N_ "Exact start period"))
|
||||
(define opthelp-budget-period-start-exact
|
||||
(N_ "Select exact period that starts the reporting range."))
|
||||
|
||||
(define optname-budget-period-end (N_ "Range end"))
|
||||
(define opthelp-budget-period-end
|
||||
(N_ "Select a budget period type that ends the reporting range."))
|
||||
(define optname-budget-period-end-exact (N_ "Exact end period"))
|
||||
(define opthelp-budget-period-end-exact
|
||||
(N_ "Select exact period that ends the reporting range."))
|
||||
|
||||
(define (options-generator)
|
||||
(let* ((options (gnc:new-options))
|
||||
(add-option
|
||||
(lambda (new-option)
|
||||
(gnc:register-option options new-option))))
|
||||
|
||||
;; Option to select Budget
|
||||
(add-option (gnc:make-budget-option
|
||||
gnc:pagename-general optname-budget
|
||||
"a" (N_ "Budget to use.")))
|
||||
|
||||
;; date interval
|
||||
(gnc:options-add-date-interval!
|
||||
options gnc:pagename-general
|
||||
optname-from-date optname-to-date "b")
|
||||
;; options to select budget period
|
||||
(let ((period-options
|
||||
(list (vector 'first
|
||||
(N_ "First")
|
||||
(N_ "The first period of the budget"))
|
||||
(vector 'previous
|
||||
(N_ "Previous")
|
||||
(N_ "Budget period was before current period, according to report evaluation date"))
|
||||
(vector 'current
|
||||
(N_ "Current")
|
||||
(N_ "Current period, according to report evaluation date"))
|
||||
(vector 'next
|
||||
(N_ "Next")
|
||||
(N_ "Next period, according to report evaluation date"))
|
||||
(vector 'last
|
||||
(N_ "Last")
|
||||
(N_ "Last budget period"))
|
||||
(vector 'manual
|
||||
(N_ "Manual period selection")
|
||||
(N_ "Explicitly select period value with spinner below"))))
|
||||
(start-period 'first)
|
||||
(end-period 'last))
|
||||
|
||||
(add-option
|
||||
(gnc:make-multichoice-callback-option
|
||||
gnc:pagename-general optname-budget-period-start
|
||||
"g1.1" opthelp-budget-period-start start-period
|
||||
period-options
|
||||
#f
|
||||
(lambda (new-val)
|
||||
(gnc-option-db-set-option-selectable-by-name
|
||||
options gnc:pagename-general optname-budget-period-start-exact
|
||||
(eq? new-val 'manual))
|
||||
(set! end-period new-val))))
|
||||
|
||||
(add-option
|
||||
(gnc:make-number-range-option
|
||||
gnc:pagename-general optname-budget-period-start-exact
|
||||
"g1.2" opthelp-budget-period-start-exact
|
||||
1 1 60 0 1))
|
||||
|
||||
(add-option
|
||||
(gnc:make-multichoice-callback-option
|
||||
gnc:pagename-general optname-budget-period-end
|
||||
"g2.1" opthelp-budget-period-end end-period
|
||||
period-options
|
||||
#f
|
||||
(lambda (new-val)
|
||||
(gnc-option-db-set-option-selectable-by-name
|
||||
options gnc:pagename-general optname-budget-period-end-exact
|
||||
(eq? new-val 'manual))
|
||||
(set! end-period new-val))))
|
||||
|
||||
(add-option
|
||||
(gnc:make-number-range-option
|
||||
gnc:pagename-general optname-budget-period-end-exact
|
||||
"g2.2" opthelp-budget-period-end-exact
|
||||
1 1 60 0 1)))
|
||||
|
||||
;; Option to select the accounts to that will be displayed
|
||||
(add-option (gnc:make-account-list-option
|
||||
@ -124,7 +190,8 @@
|
||||
;;
|
||||
;; Create bar and values
|
||||
;;
|
||||
(define (gnc:chart-create-budget-actual budget acct running-sum chart-type width height report-start-time report-end-time)
|
||||
(define (gnc:chart-create-budget-actual budget acct running-sum chart-type width height
|
||||
startperiod endperiod)
|
||||
(define curr (xaccAccountGetCommodity acct))
|
||||
(define (amount->monetary amount)
|
||||
(gnc:monetary->string
|
||||
@ -144,55 +211,57 @@
|
||||
(gnc:html-chart-set! chart '(options hover animationDuration) 0)
|
||||
(gnc:html-chart-set! chart '(options responsiveAnimationDuration) 0)
|
||||
|
||||
;; Prepair vars for running sums, and to loop though periods
|
||||
(let* ((num-periods (gnc-budget-get-num-periods budget))
|
||||
(period 0)
|
||||
(bgt-sum 0)
|
||||
(act-sum 0)
|
||||
(date (gnc-budget-get-period-start-date budget period))
|
||||
(bgt-vals '())
|
||||
(act-vals '())
|
||||
(dates-list '()))
|
||||
;; loop though periods
|
||||
(let loop ((periods (iota (gnc-budget-get-num-periods budget)))
|
||||
(bgt-sum 0)
|
||||
(act-sum 0)
|
||||
(bgt-vals '())
|
||||
(act-vals '())
|
||||
(dates-list '()))
|
||||
|
||||
;; Loop through periods
|
||||
(while (< period num-periods)
|
||||
;;add calc new running sums
|
||||
(when running-sum
|
||||
(set! bgt-sum
|
||||
(+ bgt-sum
|
||||
(gnc:get-account-period-rolledup-budget-value budget acct period)))
|
||||
(set! act-sum
|
||||
(+ act-sum
|
||||
(gnc-budget-get-account-period-actual-value budget acct period))))
|
||||
(when (<= report-start-time date)
|
||||
;; within reporting period, update the display lists
|
||||
(unless running-sum
|
||||
(set! bgt-sum
|
||||
(gnc:get-account-period-rolledup-budget-value budget acct period))
|
||||
(set! act-sum
|
||||
(gnc-budget-get-account-period-actual-value budget acct period)))
|
||||
(set! bgt-vals (cons bgt-sum bgt-vals))
|
||||
(set! act-vals (cons act-sum act-vals))
|
||||
(set! dates-list (cons (qof-print-date date) dates-list)))
|
||||
;; prepare data for next loop repetition
|
||||
(set! period (1+ period))
|
||||
(set! date (gnc-budget-get-period-start-date budget period))
|
||||
(if (< report-end-time date)
|
||||
(set! period num-periods)))
|
||||
(set! bgt-vals (reverse bgt-vals))
|
||||
(set! act-vals (reverse act-vals))
|
||||
(set! dates-list (reverse dates-list))
|
||||
|
||||
(gnc:html-chart-add-data-series! chart (_ "Budget") bgt-vals "#0074D9")
|
||||
(gnc:html-chart-add-data-series! chart (_ "Actual") act-vals "#FF4136")
|
||||
(gnc:html-chart-set-data-labels! chart dates-list)
|
||||
(if running-sum
|
||||
(cond
|
||||
((null? periods)
|
||||
(gnc:html-chart-add-data-series! chart
|
||||
(_ "Budget")
|
||||
(reverse bgt-vals)
|
||||
"#0074D9"
|
||||
'fill (eq? chart-type 'bars))
|
||||
(gnc:html-chart-add-data-series! chart
|
||||
(_ "Actual")
|
||||
(reverse act-vals)
|
||||
"#FF4136"
|
||||
'fill (eq? chart-type 'bars))
|
||||
(gnc:html-chart-set-data-labels! chart (reverse dates-list))
|
||||
(when running-sum
|
||||
(gnc:html-chart-set-title!
|
||||
chart
|
||||
(list (xaccAccountGetName acct)
|
||||
(format #f "Bgt: ~a Act: ~a"
|
||||
(amount->monetary bgt-sum)
|
||||
(amount->monetary act-sum))))))
|
||||
(else
|
||||
(let* ((period (car periods))
|
||||
(bgt-sum (+ (gnc:get-account-period-rolledup-budget-value
|
||||
budget acct period)
|
||||
(if running-sum bgt-sum 0)))
|
||||
(act-sum (+ (gnc-budget-get-account-period-actual-value
|
||||
budget acct period)
|
||||
(if running-sum act-sum 0))))
|
||||
(if (<= startperiod period endperiod)
|
||||
(loop (cdr periods)
|
||||
bgt-sum
|
||||
act-sum
|
||||
(cons bgt-sum bgt-vals)
|
||||
(cons act-sum act-vals)
|
||||
(cons (qof-print-date
|
||||
(gnc-budget-get-period-start-date budget period))
|
||||
dates-list))
|
||||
(loop (cdr periods)
|
||||
bgt-sum
|
||||
act-sum
|
||||
bgt-vals
|
||||
act-vals
|
||||
dates-list))))))
|
||||
|
||||
;; Return newly created chart
|
||||
chart))
|
||||
@ -218,24 +287,51 @@
|
||||
((null? parent) level)
|
||||
(else (get-account-level parent (1+ level))))))
|
||||
|
||||
(let* (
|
||||
(budget (get-option gnc:pagename-general optname-budget))
|
||||
(budget-valid? (and budget (not (null? budget))))
|
||||
(running-sum (get-option gnc:pagename-display optname-running-sum))
|
||||
(chart-type (get-option gnc:pagename-display optname-chart-type))
|
||||
(height (get-option gnc:pagename-display optname-plot-height))
|
||||
(width (get-option gnc:pagename-display optname-plot-width))
|
||||
(accounts (get-option gnc:pagename-accounts optname-accounts))
|
||||
(depth-limit (get-option gnc:pagename-accounts optname-depth-limit))
|
||||
(report-title (get-option gnc:pagename-general
|
||||
gnc:optname-reportname))
|
||||
(document (gnc:make-html-document))
|
||||
(from-date-t64 (gnc:time64-start-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general optname-from-date))))
|
||||
(to-date-t64 (gnc:time64-end-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general optname-to-date)))))
|
||||
(define (curr-period budget)
|
||||
(let ((now (current-time))
|
||||
(max-period (1- (gnc-budget-get-num-periods budget))))
|
||||
(let loop ((period 0))
|
||||
(cond
|
||||
((< now (gnc-budget-get-period-end-date budget period)) period)
|
||||
((<= max-period period) period)
|
||||
(else (loop (1+ period)))))))
|
||||
|
||||
(define (option->period period budget manual-period)
|
||||
(let ((max-period (1- (gnc-budget-get-num-periods budget))))
|
||||
(min max-period
|
||||
(max 0
|
||||
(case period
|
||||
((first) 0)
|
||||
((previous) (1- (curr-period budget)))
|
||||
((current) (curr-period budget))
|
||||
((next) (1+ (curr-period budget)))
|
||||
((last) max-period)
|
||||
((manual) (1- manual-period)))))))
|
||||
|
||||
(let* ((budget (get-option gnc:pagename-general optname-budget))
|
||||
(budget-valid? (and budget (not (null? budget))))
|
||||
(running-sum (get-option gnc:pagename-display optname-running-sum))
|
||||
(chart-type (get-option gnc:pagename-display optname-chart-type))
|
||||
(height (get-option gnc:pagename-display optname-plot-height))
|
||||
(width (get-option gnc:pagename-display optname-plot-width))
|
||||
(accounts (get-option gnc:pagename-accounts optname-accounts))
|
||||
(depth-limit (get-option gnc:pagename-accounts optname-depth-limit))
|
||||
(report-title (get-option gnc:pagename-general gnc:optname-reportname))
|
||||
(start-period (get-option gnc:pagename-general optname-budget-period-start))
|
||||
(start-period-exact (and budget-valid?
|
||||
(option->period
|
||||
start-period budget
|
||||
(get-option
|
||||
gnc:pagename-general
|
||||
optname-budget-period-start-exact))))
|
||||
(end-period (get-option gnc:pagename-general optname-budget-period-end))
|
||||
(end-period-exact (and budget-valid?
|
||||
(option->period
|
||||
end-period budget
|
||||
(get-option
|
||||
gnc:pagename-general
|
||||
optname-budget-period-end-exact))))
|
||||
(document (gnc:make-html-document)))
|
||||
|
||||
(cond
|
||||
((null? accounts)
|
||||
@ -265,7 +361,9 @@
|
||||
document
|
||||
(gnc:chart-create-budget-actual
|
||||
budget acct running-sum chart-type
|
||||
width height from-date-t64 to-date-t64))))
|
||||
width height
|
||||
(min start-period-exact end-period-exact)
|
||||
(max start-period-exact end-period-exact)))))
|
||||
accounts)))
|
||||
|
||||
document))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user