gnucash master: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Wed Jul 1 20:23:13 EDT 2020
Updated via https://github.com/Gnucash/gnucash/commit/602161ff (commit)
via https://github.com/Gnucash/gnucash/commit/cf5aa925 (commit)
via https://github.com/Gnucash/gnucash/commit/fdc22381 (commit)
from https://github.com/Gnucash/gnucash/commit/948a9a29 (commit)
commit 602161ff832502d723f28f364d00fa5d9a6d48d5
Merge: 948a9a293 cf5aa925f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Jul 2 08:19:33 2020 +0800
Merge branch 'master-797828'
commit cf5aa925f9692a0f5dce957eff22b9d98bb19dc0
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Jun 30 19:00:53 2020 +0800
Bug 797828 - Budget Barchart was not upgraded
* upgrade to html-chart
* use period start/end instead of date start/end
diff --git a/gnucash/report/reports/standard/budget-barchart.scm b/gnucash/report/reports/standard/budget-barchart.scm
index a4a476ef9..28abf4099 100644
--- a/gnucash/report/reports/standard/budget-barchart.scm
+++ b/gnucash/report/reports/standard/budget-barchart.scm
@@ -42,28 +42,90 @@
(define optname-chart-type (N_ "Chart Type"))
(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 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 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"))))
+
(define (options-generator)
- (let ((options (gnc:new-options)))
+ (let ((options (gnc:new-options))
+ (ui-start-period-type 'current)
+ (ui-end-period-type 'next))
(define (add-option new-option)
(gnc:register-option options new-option))
+ (define (set-option-enabled options page opt-name enabled)
+ (gnc-option-db-set-option-selectable-by-name options page opt-name enabled))
+
;; Option to select Budget
- (add-option (gnc:make-budget-option
- gnc:pagename-general optname-budget
- "a" (N_ "Budget to use.")))
+ (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")
+ (add-option
+ (gnc:make-multichoice-callback-option
+ gnc:pagename-general optname-budget-period-start
+ "g1.1" opthelp-budget-period-start 'current period-options #f
+ (lambda (new-val)
+ (set-option-enabled options gnc:pagename-general
+ optname-budget-period-start-exact (eq? 'manual new-val))
+ (set! ui-start-period-type 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 'next period-options #f
+ (lambda (new-val)
+ (set-option-enabled options gnc:pagename-general
+ optname-budget-period-end-exact (eq? 'manual new-val))
+ (set! ui-end-period-type 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
@@ -77,17 +139,13 @@
#f #t))
(gnc:options-add-account-levels!
- options gnc:pagename-accounts optname-depth-limit
- "d" opthelp-depth-limit 6)
+ options gnc:pagename-accounts optname-depth-limit "d" opthelp-depth-limit 6)
;; Display tab
(add-option
(gnc:make-simple-boolean-option
- gnc:pagename-display
- optname-running-sum
- "a"
- (N_ "Calculate as running sum?")
- #t))
+ gnc:pagename-display optname-running-sum "a"
+ (N_ "Calculate as running sum?") #t))
;; Display tab
(add-option
@@ -105,7 +163,7 @@
(gnc:options-add-plot-size!
options gnc:pagename-display
optname-plot-width optname-plot-height "c"
- (cons 'percent 100.0) (cons 'percent 100.0))
+ (cons 'percent 100) (cons 'percent 100))
;; Set default page
(gnc:options-set-default-section options gnc:pagename-general)
@@ -122,101 +180,72 @@
;;
(define (gnc:chart-create-budget-actual
budget acct running-sum chart-type width height
- report-start-time report-end-time)
- (let ((chart #f))
-
- (if (eqv? chart-type 'bars)
- (begin
- ;; Setup barchart
- (set! chart (gnc:make-html-barchart))
- (gnc:html-barchart-set-title! chart (xaccAccountGetName acct))
- (gnc:html-barchart-set-width! chart width)
- (gnc:html-barchart-set-height! chart height)
- (gnc:html-barchart-set-row-labels-rotated?! chart #t)
- (gnc:html-barchart-set-col-labels! chart (list (_ "Budget") (_ "Actual")))
- (gnc:html-barchart-set-col-colors! chart '("#0074D9" "#FF4136")))
- ;; else
- (begin
- ;; Setup linechart
- (set! chart (gnc:make-html-linechart))
- (gnc:html-linechart-set-title! chart (xaccAccountGetName acct))
- (gnc:html-linechart-set-width! chart width)
- (gnc:html-linechart-set-height! chart height)
- (gnc:html-linechart-set-row-labels-rotated?! chart #t)
- (gnc:html-linechart-set-col-labels! chart (list (_ "Budget") (_ "Actual")))
- (gnc:html-linechart-set-col-colors! chart '("#0074D9" "#FF4136"))))
-
- ;; Prepare vars for running sums, and to loop though periods
- (let* ((num-periods (gnc-budget-get-num-periods budget))
- (period 0)
+ period-start period-end)
+
+ (define chart (gnc:make-html-chart))
+ (define num-periods (gnc-budget-get-num-periods budget))
+ (define curr (xaccAccountGetCommodity acct))
+ (define (amount->monetary amount)
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary curr amount)))
+ (let lp ((period 0)
(bgt-sum 0)
(act-sum 0)
- (date (gnc-budget-get-period-start-date budget period))
(bgt-vals '())
(act-vals '())
- (date-iso-string-list '())
- (save-fmt (qof-date-format-get)))
-
- ;; make sure jqplot receives the date strings in ISO format (Bug763257)
- (qof-date-format-set QOF-DATE-FORMAT-ISO)
-
- ;; Loop through periods
- (while (< period num-periods)
- ;;add calc new running sums
- (when running-sum
- (set! bgt-sum
- (+ bgt-sum
- (gnc-numeric-to-double
- (gnc:get-account-period-rolledup-budget-value budget acct period))))
- (set! act-sum
- (+ act-sum
- (gnc-numeric-to-double
- (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-numeric-to-double
- (gnc:get-account-period-rolledup-budget-value budget acct period)))
- (set! act-sum
- (gnc-numeric-to-double
- (gnc-budget-get-account-period-actual-value budget acct period))))
- (set! bgt-vals (append bgt-vals (list bgt-sum)))
- (set! act-vals (append act-vals (list act-sum)))
- (set! date-iso-string-list
- (append date-iso-string-list (list (qof-print-date date)))))
-
- ;; prepare data for next loop repetition
- (set! period (+ period 1))
- (set! date (gnc-budget-get-period-start-date budget period))
- (if (< report-end-time date)
- (set! period num-periods)))
-
- ;; restore the date strings format
- (qof-date-format-set save-fmt)
-
- (if (eqv? chart-type 'bars)
- (begin
- ;; Add data to the bar chart
- (gnc:html-barchart-append-column! chart bgt-vals)
- (gnc:html-barchart-append-column! chart act-vals)
- (gnc:html-barchart-set-row-labels! chart date-iso-string-list)
- (if running-sum
- (gnc:html-barchart-set-subtitle!
- chart (format #f "Bgt: ~a Act: ~a" bgt-sum act-sum))))
- ;; else
- (begin
- ;; Add data to the line chart
- (gnc:html-linechart-append-column! chart bgt-vals)
- (gnc:html-linechart-append-column! chart act-vals)
- (gnc:html-linechart-set-row-labels! chart date-iso-string-list)
- (if running-sum
- (gnc:html-linechart-set-subtitle!
- chart (format #f "Bgt: ~a Act: ~a" bgt-sum act-sum))))))
-
- ;; Return newly created chart
- chart))
+ (dates-list '()))
+ (cond
+ ((>= period num-periods)
+ (gnc:html-chart-set-width! chart width)
+ (gnc:html-chart-set-height! chart height)
+ (gnc:html-chart-set-type! chart (if (eq? chart-type 'bars) 'bar 'line))
+ (gnc:html-chart-set-currency-iso! chart (gnc-commodity-get-mnemonic curr))
+ (gnc:html-chart-set-currency-symbol! chart (gnc-commodity-get-nice-symbol curr))
+ (gnc:html-chart-set-y-axis-label! chart (gnc-commodity-get-mnemonic curr))
+
+ ;; disable animation; with multiple accounts selected this report
+ ;; will create several charts, all will want to animate
+ (gnc:html-chart-set! chart '(options animation duration) 0)
+ (gnc:html-chart-set! chart '(options hover animationDuration) 0)
+ (gnc:html-chart-set! chart '(options responsiveAnimationDuration) 0)
+ (gnc:html-chart-set-title!
+ chart (if running-sum
+ (list (xaccAccountGetName acct)
+ ;; Translators: Bgt and Act refer to budgeted and
+ ;; actual total amounts.
+ (format #f (_ "Bgt: ~a Act: ~a")
+ (amount->monetary bgt-sum)
+ (amount->monetary act-sum)))
+ (list (xaccAccountGetName acct))))
+ (gnc:html-chart-set-data-labels! chart (reverse dates-list))
+ (gnc:html-chart-add-data-series! chart
+ (_ "Actual")
+ (reverse act-vals)
+ "#FF4136"
+ 'fill (eq? chart-type 'bars))
+ (gnc:html-chart-add-data-series! chart
+ (_ "Budget")
+ (reverse bgt-vals)
+ "#0074D9"
+ 'fill (eq? chart-type 'bars))
+ chart)
+ (else
+ (let ((date (gnc-budget-get-period-start-date budget period))
+ (new-bgt-sum (+ (gnc:get-account-period-rolledup-budget-value
+ budget acct period)
+ (if running-sum bgt-sum 0)))
+ (new-act-sum (+ (gnc-budget-get-account-period-actual-value
+ budget acct period)
+ (if running-sum act-sum 0))))
+ (if (<= period-start period period-end)
+ (lp (1+ period) new-bgt-sum new-act-sum
+ (cons new-bgt-sum bgt-vals)
+ (cons new-act-sum act-vals)
+ (cons (qof-print-date date) dates-list))
+ (lp (1+ period) new-bgt-sum new-act-sum
+ bgt-vals
+ act-vals
+ dates-list)))))))
;; This is the rendering function. It accepts a database of options
@@ -240,54 +269,78 @@
((null? parent) level)
(else (get-account-level parent (+ level 1))))))
+ (define (find-period-relative-to-current budget adjuster)
+ (define (period-start x) (gnc-budget-get-period-start-date budget x))
+ (define (period-end x) (gnc-budget-get-period-end-date budget x))
+ (let* ((now (current-time))
+ (total-periods (gnc-budget-get-num-periods budget))
+ (last-period (1- total-periods)))
+ (cond ((< now (period-start 0)) 1)
+ ((> now (period-end last-period)) total-periods)
+ (else (let ((found-period
+ (find (lambda (period)
+ (<= (period-start period)
+ now
+ (period-end period)))
+ (iota total-periods))))
+ (and found-period
+ (max 0 (min last-period (adjuster found-period)))))))))
+
+ (define (calc-user-period budget period-type period-exact-val)
+ (case period-type
+ ((first) 0)
+ ((last) (1- (gnc-budget-get-num-periods budget)))
+ ((manual) (1- period-exact-val))
+ ((previous) (find-period-relative-to-current budget 1-))
+ ((current) (find-period-relative-to-current budget identity))
+ ((next) (find-period-relative-to-current budget 1+))))
+
+ (define (to-period-val v)
+ (inexact->exact (round (get-option gnc:pagename-general v))))
+
(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)))))
+ (report-title (get-option gnc:pagename-general gnc:optname-reportname))
+ (p-start (get-option gnc:pagename-general optname-budget-period-start))
+ (p-start-exact (to-period-val optname-budget-period-start-exact))
+ (p-end (get-option gnc:pagename-general optname-budget-period-end))
+ (p-end-exact (to-period-val optname-budget-period-end-exact))
+ (document (gnc:make-html-document)))
(cond
((null? accounts)
- ;; No accounts selected
(gnc:html-document-add-object!
document
(gnc:html-make-no-account-warning
report-title (gnc:report-id report-obj))))
- ((not budget-valid?)
- ;; No budget selected.
+ ((null? budget)
(gnc:html-document-add-object!
document (gnc:html-make-generic-budget-warning reportname)))
;; Else create chart for each account
(else
- (for-each
- (lambda (acct)
- (if (or (and (equal? depth-limit 'all)
- (null? (gnc-account-get-descendants acct)))
- (and (not (equal? depth-limit 'all))
- (<= (get-account-level acct 0) depth-limit)
- (null? (gnc-account-get-descendants acct)))
- (and (not (equal? depth-limit 'all))
- (= (get-account-level acct 0) depth-limit)))
+ (let ((period-start (calc-user-period budget p-start p-start-exact))
+ (period-end (calc-user-period budget p-end p-end-exact)))
+ (for-each
+ (lambda (acct)
+ (when (or (and (eq? depth-limit 'all)
+ (null? (gnc-account-get-descendants acct)))
+ (and (not (eq? depth-limit 'all))
+ (<= (get-account-level acct 0) depth-limit)
+ (null? (gnc-account-get-descendants acct)))
+ (and (not (eq? depth-limit 'all))
+ (= (get-account-level acct 0) depth-limit)))
(gnc:html-document-add-object!
- document
- (gnc:chart-create-budget-actual
- budget acct running-sum chart-type width height
- from-date-t64 to-date-t64))))
- accounts)))
+ document (gnc:chart-create-budget-actual
+ budget acct running-sum chart-type width height
+ period-start period-end))))
+ accounts))))
document))
commit fdc2238192c5365f1ac2343fddf6a982b4339fe2
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Jun 30 17:50:43 2020 +0800
[budget-barchart] reindent/delete-trailing-whitespace/untabify
diff --git a/gnucash/report/reports/standard/budget-barchart.scm b/gnucash/report/reports/standard/budget-barchart.scm
index 9f5f1ac05..a4a476ef9 100644
--- a/gnucash/report/reports/standard/budget-barchart.scm
+++ b/gnucash/report/reports/standard/budget-barchart.scm
@@ -33,8 +33,7 @@
(use-modules (gnucash app-utils))
(use-modules (gnucash report))
-(define reportname
- (N_ "Budget Chart"))
+(define reportname (N_ "Budget Chart"))
(define optname-accounts (N_ "Accounts"))
(define optname-budget (N_ "Budget"))
@@ -50,20 +49,16 @@
(define opthelp-depth-limit
(N_ "Maximum number of levels in the account tree displayed."))
-;(define (options-generator inc-exp?)
(define (options-generator)
- (let* (
- (options (gnc:new-options))
- ;; This is just a helper function for making options.
- ;; See libgnucash/scm/options.scm for details.
- (add-option
- (lambda (new-option)
- (gnc:register-option options new-option)))
- )
+ (let ((options (gnc:new-options)))
+
+ (define (add-option 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.")))
+ gnc:pagename-general optname-budget
+ "a" (N_ "Budget to use.")))
;; date interval
(gnc:options-add-date-interval!
@@ -71,14 +66,15 @@
optname-from-date optname-to-date "b")
;; Option to select the accounts to that will be displayed
- (add-option (gnc:make-account-list-option
- gnc:pagename-accounts optname-accounts
- "c" (N_ "Report on these accounts.")
- (lambda ()
- (gnc:filter-accountlist-type
- (list ACCT-TYPE-BANK ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY)
- (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
- #f #t))
+ (add-option
+ (gnc:make-account-list-option
+ gnc:pagename-accounts optname-accounts
+ "c" (N_ "Report on these accounts.")
+ (lambda ()
+ (gnc:filter-accountlist-type
+ (list ACCT-TYPE-BANK ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY)
+ (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
+ #f #t))
(gnc:options-add-account-levels!
options gnc:pagename-accounts optname-depth-limit
@@ -87,7 +83,7 @@
;; Display tab
(add-option
(gnc:make-simple-boolean-option
- gnc:pagename-display
+ gnc:pagename-display
optname-running-sum
"a"
(N_ "Calculate as running sum?")
@@ -95,30 +91,27 @@
;; Display tab
(add-option
- (gnc:make-multichoice-option
- gnc:pagename-display ;; tab name
- optname-chart-type ;; displayed option name
- "b" ;; localization in the tab
- (N_ "This is a multi choice option.") ;; option help text
- 'bars ;; default selectioin
- (list
- (vector 'bars
- (N_ "Barchart")
- (N_ "Show the report as a bar chart."))
- (vector 'lines
- (N_ "Linechart")
- (N_ "Show the report as a line chart.")))))
-
- (gnc:options-add-plot-size!
- options gnc:pagename-display
- optname-plot-width optname-plot-height "c" (cons 'percent 100.0) (cons 'percent 100.0))
+ (gnc:make-multichoice-option
+ gnc:pagename-display optname-chart-type "b"
+ (N_ "This is a multi choice option.") 'bars
+ (list
+ (vector 'bars
+ (N_ "Barchart")
+ (N_ "Show the report as a bar chart."))
+ (vector 'lines
+ (N_ "Linechart")
+ (N_ "Show the report as a line chart.")))))
+
+ (gnc:options-add-plot-size!
+ options gnc:pagename-display
+ optname-plot-width optname-plot-height "c"
+ (cons 'percent 100.0) (cons 'percent 100.0))
;; Set default page
(gnc:options-set-default-section options gnc:pagename-general)
;; Return options
- options
-))
+ options))
;; For each period in the budget:
@@ -127,51 +120,42 @@
;;
;; Create bar and values
;;
-(define (gnc:chart-create-budget-actual budget acct running-sum chart-type width height report-start-time report-end-time)
- (let* (
- (chart #f)
- )
+(define (gnc:chart-create-budget-actual
+ budget acct running-sum chart-type width height
+ report-start-time report-end-time)
+ (let ((chart #f))
(if (eqv? chart-type 'bars)
- (begin
- ;; Setup barchart
- (set! chart (gnc:make-html-barchart))
- (gnc:html-barchart-set-title! chart (xaccAccountGetName acct))
- (gnc:html-barchart-set-width! chart width)
- (gnc:html-barchart-set-height! chart height)
- (gnc:html-barchart-set-row-labels-rotated?! chart #t)
- (gnc:html-barchart-set-col-labels!
- chart (list (_ "Budget") (_ "Actual")))
- (gnc:html-barchart-set-col-colors!
- chart '("#0074D9" "#FF4136"))
- )
- ;; else
- (begin
- ;; Setup linechart
- (set! chart (gnc:make-html-linechart))
- (gnc:html-linechart-set-title! chart (xaccAccountGetName acct))
- (gnc:html-linechart-set-width! chart width)
- (gnc:html-linechart-set-height! chart height)
- (gnc:html-linechart-set-row-labels-rotated?! chart #t)
- (gnc:html-linechart-set-col-labels!
- chart (list (_ "Budget") (_ "Actual")))
- (gnc:html-linechart-set-col-colors!
- chart '("#0074D9" "#FF4136"))
- )
- )
+ (begin
+ ;; Setup barchart
+ (set! chart (gnc:make-html-barchart))
+ (gnc:html-barchart-set-title! chart (xaccAccountGetName acct))
+ (gnc:html-barchart-set-width! chart width)
+ (gnc:html-barchart-set-height! chart height)
+ (gnc:html-barchart-set-row-labels-rotated?! chart #t)
+ (gnc:html-barchart-set-col-labels! chart (list (_ "Budget") (_ "Actual")))
+ (gnc:html-barchart-set-col-colors! chart '("#0074D9" "#FF4136")))
+ ;; else
+ (begin
+ ;; Setup linechart
+ (set! chart (gnc:make-html-linechart))
+ (gnc:html-linechart-set-title! chart (xaccAccountGetName acct))
+ (gnc:html-linechart-set-width! chart width)
+ (gnc:html-linechart-set-height! chart height)
+ (gnc:html-linechart-set-row-labels-rotated?! chart #t)
+ (gnc:html-linechart-set-col-labels! chart (list (_ "Budget") (_ "Actual")))
+ (gnc:html-linechart-set-col-colors! chart '("#0074D9" "#FF4136"))))
;; Prepare 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 '())
- (date-iso-string-list '())
- (save-fmt (qof-date-format-get))
- )
+ (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 '())
+ (date-iso-string-list '())
+ (save-fmt (qof-date-format-get)))
;; make sure jqplot receives the date strings in ISO format (Bug763257)
(qof-date-format-set QOF-DATE-FORMAT-ISO)
@@ -179,72 +163,60 @@
;; Loop through periods
(while (< period num-periods)
;;add calc new running sums
- (if running-sum
- (begin
- (set! bgt-sum (+ bgt-sum
- (gnc-numeric-to-double
+ (when running-sum
+ (set! bgt-sum
+ (+ bgt-sum
+ (gnc-numeric-to-double
(gnc:get-account-period-rolledup-budget-value budget acct period))))
- (set! act-sum (+ act-sum
+ (set! act-sum
+ (+ act-sum
+ (gnc-numeric-to-double
+ (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-numeric-to-double
- (gnc-budget-get-account-period-actual-value budget acct period))))
- )
- )
- (if (<= report-start-time date)
- ;; within reporting period, update the display lists
- (begin
- (if (not running-sum)
- (begin
- (set! bgt-sum
- (gnc-numeric-to-double
- (gnc:get-account-period-rolledup-budget-value budget acct period)))
- (set! act-sum
- (gnc-numeric-to-double
- (gnc-budget-get-account-period-actual-value budget acct period)))
- )
- )
- (set! bgt-vals (append bgt-vals (list bgt-sum)))
- (set! act-vals (append act-vals (list act-sum)))
- (set! date-iso-string-list (append date-iso-string-list (list (qof-print-date date))))
- )
- )
+ (gnc:get-account-period-rolledup-budget-value budget acct period)))
+ (set! act-sum
+ (gnc-numeric-to-double
+ (gnc-budget-get-account-period-actual-value budget acct period))))
+ (set! bgt-vals (append bgt-vals (list bgt-sum)))
+ (set! act-vals (append act-vals (list act-sum)))
+ (set! date-iso-string-list
+ (append date-iso-string-list (list (qof-print-date date)))))
+
;; prepare data for next loop repetition
(set! period (+ period 1))
(set! date (gnc-budget-get-period-start-date budget period))
(if (< report-end-time date)
- (set! period num-periods) ;; reporting period has ended, break the loop
- )
- )
+ (set! period num-periods)))
;; restore the date strings format
(qof-date-format-set save-fmt)
(if (eqv? chart-type 'bars)
- (begin
- ;; Add data to the bar chart
- (gnc:html-barchart-append-column! chart bgt-vals)
- (gnc:html-barchart-append-column! chart act-vals)
- (gnc:html-barchart-set-row-labels! chart date-iso-string-list)
- (if running-sum
- (gnc:html-barchart-set-subtitle!
- chart (format #f "Bgt: ~a Act: ~a" bgt-sum act-sum)))
- )
- ;; else
- (begin
- ;; Add data to the line chart
- (gnc:html-linechart-append-column! chart bgt-vals)
- (gnc:html-linechart-append-column! chart act-vals)
- (gnc:html-linechart-set-row-labels! chart date-iso-string-list)
- (if running-sum
- (gnc:html-linechart-set-subtitle!
- chart
- (format #f "Bgt: ~a Act: ~a" bgt-sum act-sum)))
- )
- )
- )
+ (begin
+ ;; Add data to the bar chart
+ (gnc:html-barchart-append-column! chart bgt-vals)
+ (gnc:html-barchart-append-column! chart act-vals)
+ (gnc:html-barchart-set-row-labels! chart date-iso-string-list)
+ (if running-sum
+ (gnc:html-barchart-set-subtitle!
+ chart (format #f "Bgt: ~a Act: ~a" bgt-sum act-sum))))
+ ;; else
+ (begin
+ ;; Add data to the line chart
+ (gnc:html-linechart-append-column! chart bgt-vals)
+ (gnc:html-linechart-append-column! chart act-vals)
+ (gnc:html-linechart-set-row-labels! chart date-iso-string-list)
+ (if running-sum
+ (gnc:html-linechart-set-subtitle!
+ chart (format #f "Bgt: ~a Act: ~a" bgt-sum act-sum))))))
;; Return newly created chart
- chart
-))
+ chart))
;; This is the rendering function. It accepts a database of options
@@ -257,88 +229,67 @@
;; This is a helper function for looking up option values.
(define (get-option section name)
- (gnc:option-value
+ (gnc:option-value
(gnc:lookup-option (gnc:report-options report-obj) section name)))
;; This is a helper function to find out the level of the account
;; with in the account tree
(define (get-account-level account level)
- (let (
- (parent (gnc-account-get-parent account))
- )
+ (let ((parent (gnc-account-get-parent account)))
(cond
- (
- (null? parent) ;; exit
- level
- )
- (else
- (get-account-level parent (+ level 1))
- )
- )
- )
- )
-
- (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))))
- )
+ ((null? parent) level)
+ (else (get-account-level parent (+ level 1))))))
+
+ (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)))))
+
(cond
- ((null? accounts)
- ;; No accounts selected
- (gnc:html-document-add-object!
- document
- (gnc:html-make-no-account-warning
- report-title (gnc:report-id report-obj))))
-
- ((not budget-valid?)
- ;; No budget selected.
- (gnc:html-document-add-object!
- document (gnc:html-make-generic-budget-warning reportname)))
-
- ;; Else create chart for each account
- (else
- (for-each
- (lambda (acct)
- (if (or
- (and (equal? depth-limit 'all)
- (null? (gnc-account-get-descendants acct))
- )
- (and (not (equal? depth-limit 'all))
- (<= (get-account-level acct 0) depth-limit)
- (null? (gnc-account-get-descendants acct))
- )
- (and (not (equal? depth-limit 'all))
- (= (get-account-level acct 0) depth-limit)
- )
- )
- (gnc:html-document-add-object!
- document
- (gnc:chart-create-budget-actual budget acct running-sum chart-type width height from-date-t64 to-date-t64)
- )
- )
- )
- accounts
- )
- )
- ) ;; end cond
-
- document
-))
+ ((null? accounts)
+ ;; No accounts selected
+ (gnc:html-document-add-object!
+ document
+ (gnc:html-make-no-account-warning
+ report-title (gnc:report-id report-obj))))
+
+ ((not budget-valid?)
+ ;; No budget selected.
+ (gnc:html-document-add-object!
+ document (gnc:html-make-generic-budget-warning reportname)))
+
+ ;; Else create chart for each account
+ (else
+ (for-each
+ (lambda (acct)
+ (if (or (and (equal? depth-limit 'all)
+ (null? (gnc-account-get-descendants acct)))
+ (and (not (equal? depth-limit 'all))
+ (<= (get-account-level acct 0) depth-limit)
+ (null? (gnc-account-get-descendants acct)))
+ (and (not (equal? depth-limit 'all))
+ (= (get-account-level acct 0) depth-limit)))
+ (gnc:html-document-add-object!
+ document
+ (gnc:chart-create-budget-actual
+ budget acct running-sum chart-type width height
+ from-date-t64 to-date-t64))))
+ accounts)))
+
+ document))
;; Here we define the actual report
(gnc:define-report
Summary of changes:
.../report/reports/standard/budget-barchart.scm | 496 +++++++++++----------
1 file changed, 250 insertions(+), 246 deletions(-)
More information about the gnucash-changes
mailing list