From a323b25067923d6e2ab02cf9b23bfb115960028f Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Thu, 24 Jan 2019 19:07:24 +0800 Subject: [PATCH] [budget-barchart] allow budget-period selection This commit changes report to choose start/end budget periods instead of start/end dates for reporting. --- .../reports/standard/budget-barchart.scm | 236 +++++++++++++----- 1 file changed, 167 insertions(+), 69 deletions(-) diff --git a/gnucash/report/reports/standard/budget-barchart.scm b/gnucash/report/reports/standard/budget-barchart.scm index 92c25c0bb0..ae5bc81f8a 100644 --- a/gnucash/report/reports/standard/budget-barchart.scm +++ b/gnucash/report/reports/standard/budget-barchart.scm @@ -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))