IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

[budget-barchart] reindent/delete-trailing-whitespace/untabify

Browse Source
This commit is contained in:
Christopher Lam 2020-06-30 17:50:43 +08:00
parent 2610b5f57f
commit fdc2238192
1 changed files with 157 additions and 206 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

353
gnucash/report/reports/standard/budget-barchart.scm
View File

@ -33,8 +33,7 @@
(use-modules (gnucash app-utils)) (use-modules (gnucash app-utils))
(use-modules (gnucash report)) (use-modules (gnucash report))
(define reportname (define reportname (N_ "Budget Chart"))
(N_ "Budget Chart"))
(define optname-accounts (N_ "Accounts")) (define optname-accounts (N_ "Accounts"))
(define optname-budget (N_ "Budget")) (define optname-budget (N_ "Budget"))
@ -50,20 +49,16 @@
(define opthelp-depth-limit (define opthelp-depth-limit
(N_ "Maximum number of levels in the account tree displayed.")) (N_ "Maximum number of levels in the account tree displayed."))
;(define (options-generator inc-exp?)
(define (options-generator) (define (options-generator)
(let* ( (let ((options (gnc:new-options)))
(options (gnc:new-options))
;; This is just a helper function for making options. (define (add-option new-option)
;; See libgnucash/scm/options.scm for details. (gnc:register-option options new-option))
(add-option
(lambda (new-option)
(gnc:register-option options new-option)))
)
;; Option to select Budget ;; Option to select Budget
(add-option (gnc:make-budget-option (add-option (gnc:make-budget-option
gnc:pagename-general optname-budget gnc:pagename-general optname-budget
"a" (N_ "Budget to use."))) "a" (N_ "Budget to use.")))
;; date interval ;; date interval
(gnc:options-add-date-interval! (gnc:options-add-date-interval!
@ -71,14 +66,15 @@
optname-from-date optname-to-date "b") optname-from-date optname-to-date "b")
;; Option to select the accounts to that will be displayed ;; Option to select the accounts to that will be displayed
(add-option (gnc:make-account-list-option (add-option
gnc:pagename-accounts optname-accounts (gnc:make-account-list-option
"c" (N_ "Report on these accounts.") gnc:pagename-accounts optname-accounts
(lambda () "c" (N_ "Report on these accounts.")
(gnc:filter-accountlist-type (lambda ()
(list ACCT-TYPE-BANK ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY) (gnc:filter-accountlist-type
(gnc-account-get-descendants-sorted (gnc-get-current-root-account)))) (list ACCT-TYPE-BANK ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY)
#f #t)) (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
#f #t))
(gnc:options-add-account-levels! (gnc:options-add-account-levels!
options gnc:pagename-accounts optname-depth-limit options gnc:pagename-accounts optname-depth-limit
@ -95,30 +91,27 @@
;; Display tab ;; Display tab
(add-option (add-option
(gnc:make-multichoice-option (gnc:make-multichoice-option
gnc:pagename-display ;; tab name gnc:pagename-display optname-chart-type "b"
optname-chart-type ;; displayed option name (N_ "This is a multi choice option.") 'bars
"b" ;; localization in the tab (list
(N_ "This is a multi choice option.") ;; option help text (vector 'bars
'bars ;; default selectioin (N_ "Barchart")
(list (N_ "Show the report as a bar chart."))
(vector 'bars (vector 'lines
(N_ "Barchart") (N_ "Linechart")
(N_ "Show the report as a bar chart.")) (N_ "Show the report as a line chart.")))))
(vector 'lines
(N_ "Linechart")
(N_ "Show the report as a line chart.")))))
(gnc:options-add-plot-size! (gnc:options-add-plot-size!
options gnc:pagename-display options gnc:pagename-display
optname-plot-width optname-plot-height "c" (cons 'percent 100.0) (cons 'percent 100.0)) optname-plot-width optname-plot-height "c"
(cons 'percent 100.0) (cons 'percent 100.0))
;; Set default page ;; Set default page
(gnc:options-set-default-section options gnc:pagename-general) (gnc:options-set-default-section options gnc:pagename-general)
;; Return options ;; Return options
options options))
))
;; For each period in the budget: ;; For each period in the budget:
@ -127,51 +120,42 @@
;; ;;
;; Create bar and values ;; 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
(let* ( budget acct running-sum chart-type width height
(chart #f) report-start-time report-end-time)
) (let ((chart #f))
(if (eqv? chart-type 'bars) (if (eqv? chart-type 'bars)
(begin (begin
;; Setup barchart ;; Setup barchart
(set! chart (gnc:make-html-barchart)) (set! chart (gnc:make-html-barchart))
(gnc:html-barchart-set-title! chart (xaccAccountGetName acct)) (gnc:html-barchart-set-title! chart (xaccAccountGetName acct))
(gnc:html-barchart-set-width! chart width) (gnc:html-barchart-set-width! chart width)
(gnc:html-barchart-set-height! chart height) (gnc:html-barchart-set-height! chart height)
(gnc:html-barchart-set-row-labels-rotated?! chart #t) (gnc:html-barchart-set-row-labels-rotated?! chart #t)
(gnc:html-barchart-set-col-labels! (gnc:html-barchart-set-col-labels! chart (list (_ "Budget") (_ "Actual")))
chart (list (_ "Budget") (_ "Actual"))) (gnc:html-barchart-set-col-colors! chart '("#0074D9" "#FF4136")))
(gnc:html-barchart-set-col-colors! ;; else
chart '("#0074D9" "#FF4136")) (begin
) ;; Setup linechart
;; else (set! chart (gnc:make-html-linechart))
(begin (gnc:html-linechart-set-title! chart (xaccAccountGetName acct))
;; Setup linechart (gnc:html-linechart-set-width! chart width)
(set! chart (gnc:make-html-linechart)) (gnc:html-linechart-set-height! chart height)
(gnc:html-linechart-set-title! chart (xaccAccountGetName acct)) (gnc:html-linechart-set-row-labels-rotated?! chart #t)
(gnc:html-linechart-set-width! chart width) (gnc:html-linechart-set-col-labels! chart (list (_ "Budget") (_ "Actual")))
(gnc:html-linechart-set-height! chart height) (gnc:html-linechart-set-col-colors! chart '("#0074D9" "#FF4136"))))
(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 ;; Prepare vars for running sums, and to loop though periods
(let* ( (let* ((num-periods (gnc-budget-get-num-periods budget))
(num-periods (gnc-budget-get-num-periods budget)) (period 0)
(period 0) (bgt-sum 0)
(bgt-sum 0) (act-sum 0)
(act-sum 0) (date (gnc-budget-get-period-start-date budget period))
(date (gnc-budget-get-period-start-date budget period)) (bgt-vals '())
(bgt-vals '()) (act-vals '())
(act-vals '()) (date-iso-string-list '())
(date-iso-string-list '()) (save-fmt (qof-date-format-get)))
(save-fmt (qof-date-format-get))
)
;; make sure jqplot receives the date strings in ISO format (Bug763257) ;; make sure jqplot receives the date strings in ISO format (Bug763257)
(qof-date-format-set QOF-DATE-FORMAT-ISO) (qof-date-format-set QOF-DATE-FORMAT-ISO)
@ -179,72 +163,60 @@
;; Loop through periods ;; Loop through periods
(while (< period num-periods) (while (< period num-periods)
;;add calc new running sums ;;add calc new running sums
(if running-sum (when running-sum
(begin (set! bgt-sum
(set! bgt-sum (+ bgt-sum (+ bgt-sum
(gnc-numeric-to-double (gnc-numeric-to-double
(gnc:get-account-period-rolledup-budget-value budget acct period)))) (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-numeric-to-double
(gnc-budget-get-account-period-actual-value budget acct period)))) (gnc:get-account-period-rolledup-budget-value budget acct period)))
) (set! act-sum
) (gnc-numeric-to-double
(if (<= report-start-time date) (gnc-budget-get-account-period-actual-value budget acct period))))
;; within reporting period, update the display lists (set! bgt-vals (append bgt-vals (list bgt-sum)))
(begin (set! act-vals (append act-vals (list act-sum)))
(if (not running-sum) (set! date-iso-string-list
(begin (append date-iso-string-list (list (qof-print-date date)))))
(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 ;; prepare data for next loop repetition
(set! period (+ period 1)) (set! period (+ period 1))
(set! date (gnc-budget-get-period-start-date budget period)) (set! date (gnc-budget-get-period-start-date budget period))
(if (< report-end-time date) (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 ;; restore the date strings format
(qof-date-format-set save-fmt) (qof-date-format-set save-fmt)
(if (eqv? chart-type 'bars) (if (eqv? chart-type 'bars)
(begin (begin
;; Add data to the bar chart ;; Add data to the bar chart
(gnc:html-barchart-append-column! chart bgt-vals) (gnc:html-barchart-append-column! chart bgt-vals)
(gnc:html-barchart-append-column! chart act-vals) (gnc:html-barchart-append-column! chart act-vals)
(gnc:html-barchart-set-row-labels! chart date-iso-string-list) (gnc:html-barchart-set-row-labels! chart date-iso-string-list)
(if running-sum (if running-sum
(gnc:html-barchart-set-subtitle! (gnc:html-barchart-set-subtitle!
chart (format #f "Bgt: ~a Act: ~a" bgt-sum act-sum))) chart (format #f "Bgt: ~a Act: ~a" bgt-sum act-sum))))
) ;; else
;; else (begin
(begin ;; Add data to the line chart
;; Add data to the line chart (gnc:html-linechart-append-column! chart bgt-vals)
(gnc:html-linechart-append-column! chart bgt-vals) (gnc:html-linechart-append-column! chart act-vals)
(gnc:html-linechart-append-column! chart act-vals) (gnc:html-linechart-set-row-labels! chart date-iso-string-list)
(gnc:html-linechart-set-row-labels! chart date-iso-string-list) (if running-sum
(if running-sum (gnc:html-linechart-set-subtitle!
(gnc:html-linechart-set-subtitle! chart (format #f "Bgt: ~a Act: ~a" bgt-sum act-sum))))))
chart
(format #f "Bgt: ~a Act: ~a" bgt-sum act-sum)))
)
)
)
;; Return newly created chart ;; Return newly created chart
chart chart))
))
;; This is the rendering function. It accepts a database of options ;; This is the rendering function. It accepts a database of options
@ -263,82 +235,61 @@
;; This is a helper function to find out the level of the account ;; This is a helper function to find out the level of the account
;; with in the account tree ;; with in the account tree
(define (get-account-level account level) (define (get-account-level account level)
(let ( (let ((parent (gnc-account-get-parent account)))
(parent (gnc-account-get-parent account))
)
(cond (cond
( ((null? parent) level)
(null? parent) ;; exit (else (get-account-level parent (+ level 1))))))
level
) (let* ((budget (get-option gnc:pagename-general optname-budget))
(else (budget-valid? (and budget (not (null? budget))))
(get-account-level parent (+ level 1)) (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)))))
(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 (cond
((null? accounts) ((null? accounts)
;; No accounts selected ;; No accounts selected
(gnc:html-document-add-object! (gnc:html-document-add-object!
document document
(gnc:html-make-no-account-warning (gnc:html-make-no-account-warning
report-title (gnc:report-id report-obj)))) report-title (gnc:report-id report-obj))))
((not budget-valid?) ((not budget-valid?)
;; No budget selected. ;; No budget selected.
(gnc:html-document-add-object! (gnc:html-document-add-object!
document (gnc:html-make-generic-budget-warning reportname))) document (gnc:html-make-generic-budget-warning reportname)))
;; Else create chart for each account ;; Else create chart for each account
(else (else
(for-each (for-each
(lambda (acct) (lambda (acct)
(if (or (if (or (and (equal? depth-limit 'all)
(and (equal? depth-limit 'all) (null? (gnc-account-get-descendants acct)))
(null? (gnc-account-get-descendants acct)) (and (not (equal? depth-limit 'all))
) (<= (get-account-level acct 0) depth-limit)
(and (not (equal? depth-limit 'all)) (null? (gnc-account-get-descendants acct)))
(<= (get-account-level acct 0) depth-limit) (and (not (equal? depth-limit 'all))
(null? (gnc-account-get-descendants acct)) (= (get-account-level acct 0) depth-limit)))
) (gnc:html-document-add-object!
(and (not (equal? depth-limit 'all)) document
(= (get-account-level acct 0) depth-limit) (gnc:chart-create-budget-actual
) budget acct running-sum chart-type width height
) from-date-t64 to-date-t64))))
(gnc:html-document-add-object! accounts)))
document
(gnc:chart-create-budget-actual budget acct running-sum chart-type width height from-date-t64 to-date-t64)
)
)
)
accounts
)
)
) ;; end cond
document document))
))
;; Here we define the actual report ;; Here we define the actual report
(gnc:define-report (gnc:define-report