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

[daily-reports] upgraded

Browse Source
This commit is contained in:
Christopher Lam 2019-01-19 23:37:21 +08:00
parent 280b745927
commit 9b8057e573
1 changed files with 106 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
gnucash/report/reports/standard/daily-reports.scm
View File

@ -118,7 +118,8 @@
(gnc:options-add-plot-size! (gnc:options-add-plot-size!
options gnc:pagename-display options gnc:pagename-display
optname-plot-width optname-plot-height "d" (cons 'percent 100.0) (cons 'percent 100.0)) optname-plot-width optname-plot-height
"d" (cons 'percent 100.0) (cons 'percent 100.0))
(gnc:options-set-default-section options gnc:pagename-general) (gnc:options-set-default-section options gnc:pagename-general)
@ -131,7 +132,6 @@
;; intervals as arguments. ;; intervals as arguments.
(define (piechart-renderer report-obj reportname (define (piechart-renderer report-obj reportname
account-types) account-types)
;; This is a helper function for looking up option values. ;; This is a helper function for looking up option values.
(define (get-option section name) (define (get-option section name)
(gnc:option-value (gnc:option-value
@ -161,24 +161,21 @@
(show-total? (get-option gnc:pagename-display optname-show-total)) (show-total? (get-option gnc:pagename-display optname-show-total))
(height (get-option gnc:pagename-display optname-plot-height)) (height (get-option gnc:pagename-display optname-plot-height))
(width (get-option gnc:pagename-display optname-plot-width)) (width (get-option gnc:pagename-display optname-plot-width))
(commodity-list #f) (commodity-list #f)
(exchange-fn #f) (exchange-fn #f)
(print-info (gnc-commodity-print-info report-currency #t)) (print-info (gnc-commodity-print-info report-currency #t))
(beforebegindate (gnc:time64-end-day-time (beforebegindate (gnc:time64-end-day-time
(gnc:time64-previous-day from-date))) (gnc:time64-previous-day from-date)))
(document (gnc:make-html-document)) (document (gnc:make-html-document))
(chart (gnc:make-html-piechart)) (chart (gnc:make-html-chart))
(topl-accounts (gnc:filter-accountlist-type (topl-accounts (gnc:filter-accountlist-type
account-types account-types
(gnc-account-get-children-sorted (gnc-account-get-children-sorted
(gnc-get-current-root-account))))) (gnc-get-current-root-account)))))
(define (monetary->double foreign-monetary date) (define (monetary->amount foreign-monetary date)
(gnc-numeric-to-double
(gnc:gnc-monetary-amount (gnc:gnc-monetary-amount
(exchange-fn foreign-monetary report-currency date)))) (exchange-fn foreign-monetary report-currency date)))
(if (not (null? accounts)) (if (not (null? accounts))
(let* ((query (qof-query-create-for-splits)) (let* ((query (qof-query-create-for-splits))
@ -243,7 +240,8 @@
(delete-duplicates (append accounts subaccts))))) (delete-duplicates (append accounts subaccts)))))
(gnc:report-percent-done 30) (gnc:report-percent-done 30)
(xaccQueryAddAccountMatch query accounts QOF-GUID-MATCH-ANY QOF-QUERY-AND) (xaccQueryAddAccountMatch
query accounts QOF-GUID-MATCH-ANY QOF-QUERY-AND)
;; match splits between start and end dates ;; match splits between start and end dates
(xaccQueryAddDateMatchTT (xaccQueryAddDateMatchTT
@ -265,7 +263,7 @@
(lambda (split) (lambda (split)
(let* ((date (xaccTransGetDate (xaccSplitGetParent split))) (let* ((date (xaccTransGetDate (xaccSplitGetParent split)))
(weekday (modulo (1- (gnc:time64-get-week-day date)) 7)) (weekday (modulo (1- (gnc:time64-get-week-day date)) 7))
(exchanged (monetary->double (exchanged (monetary->amount
(gnc:make-gnc-monetary (gnc:make-gnc-monetary
(xaccAccountGetCommodity (xaccSplitGetAccount split)) (xaccAccountGetCommodity (xaccSplitGetAccount split))
(xaccSplitGetAmount split)) (xaccSplitGetAmount split))
@ -284,23 +282,22 @@
(string-append (string-append
(car p) (car p)
" - " " - "
(xaccPrintAmount (gnc:monetary->string
(double-to-gnc-numeric (gnc:make-gnc-monetary
(cadr p) report-currency (cadr p))))
(gnc-commodity-get-fraction report-currency)
GNC-RND-ROUND)
print-info))
(car p))) (car p)))
zipped-list))) zipped-list)))
(if (not (null? zipped-list)) (if (not (null? zipped-list))
(begin (begin
(gnc:html-piechart-set-title! chart report-title) (gnc:html-chart-set-type! chart 'pie)
(gnc:html-piechart-set-width! chart width) (gnc:html-chart-set-width! chart width)
(gnc:html-piechart-set-height! chart height) (gnc:html-chart-set-height! chart height)
(gnc:html-piechart-set-subtitle! (gnc:html-chart-set-title!
chart (string-append chart (list
report-title
(string-append
(format #f (format #f
(_ "~a to ~a") (_ "~a to ~a")
(qof-print-date from-date) (qof-print-date from-date)
@ -309,20 +306,20 @@
(let ((total (apply + daily-totals))) (let ((total (apply + daily-totals)))
(format (format
#f ": ~a" #f ": ~a"
(xaccPrintAmount (gnc:monetary->string
(double-to-gnc-numeric (gnc:make-gnc-monetary
total report-currency total))))
(gnc-commodity-get-fraction report-currency) ""))))
GNC-RND-ROUND)
print-info)))
"")))
(gnc:html-piechart-set-data! chart (map cadr zipped-list))
(gnc:html-piechart-set-colors!
chart (gnc:assign-colors (length zipped-list)))
(gnc:html-piechart-set-labels! chart labels)
(gnc:html-chart-add-data-series!
chart
reportname
(map cadr zipped-list)
(gnc:assign-colors (length zipped-list)))
(gnc:html-chart-set-data-labels! chart labels)
(gnc:html-chart-set-axes-display! chart #f)
(gnc:html-document-add-object! document chart)) (gnc:html-document-add-object! document chart))
(gnc:html-document-add-object! (gnc:html-document-add-object!
document document
(gnc:html-make-empty-data-warning (gnc:html-make-empty-data-warning
@ -350,8 +347,9 @@
(piechart-renderer report-obj (piechart-renderer report-obj
(car l) (car l)
(cadr l))))) (cadr l)))))
(list (list
;; reportname, account-types, menu-reportname, menu-tip ;; reportname, account-types, menu-reportname, menu-tip
(list reportname-income (list ACCT-TYPE-INCOME) menuname-income menutip-income "5e2d129f28d14df881c3e47e3053f604") (list reportname-income (list ACCT-TYPE-INCOME) menuname-income
(list reportname-expense (list ACCT-TYPE-EXPENSE) menuname-expense menutip-expense "dde49fed4ca940959ae7d01b72742530"))) menutip-income "5e2d129f28d14df881c3e47e3053f604")
(list reportname-expense (list ACCT-TYPE-EXPENSE) menuname-expense
menutip-expense "dde49fed4ca940959ae7d01b72742530")))