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

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

@ -116,11 +116,12 @@
gnc:pagename-display optname-show-total gnc:pagename-display optname-show-total
"b" (N_ "Show the total balance in legend?") #t)) "b" (N_ "Show the total balance in legend?") #t))
(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)
options)) options))
@ -131,22 +132,21 @@
;; 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
(gnc:lookup-option (gnc:lookup-option
(gnc:report-options report-obj) section name))) (gnc:report-options report-obj) section name)))
(gnc:report-starting reportname) (gnc:report-starting reportname)
;; Get all options ;; Get all options
(let* ((to-date (gnc:time64-end-day-time (let* ((to-date (gnc:time64-end-day-time
(gnc:date-option-absolute-time (gnc:date-option-absolute-time
(get-option gnc:pagename-general optname-to-date)))) (get-option gnc:pagename-general optname-to-date))))
(from-date (gnc:time64-start-day-time (from-date (gnc:time64-start-day-time
(gnc:date-option-absolute-time (gnc:date-option-absolute-time
(get-option gnc:pagename-general (get-option gnc:pagename-general
optname-from-date)))) optname-from-date))))
(accounts (get-option gnc:pagename-accounts optname-accounts)) (accounts (get-option gnc:pagename-accounts optname-accounts))
(dosubs? (get-option gnc:pagename-accounts optname-subacct)) (dosubs? (get-option gnc:pagename-accounts optname-subacct))
@ -155,47 +155,44 @@
optname-report-currency)) optname-report-currency))
(price-source (get-option gnc:pagename-general (price-source (get-option gnc:pagename-general
optname-price-source)) optname-price-source))
(report-title (get-option gnc:pagename-general (report-title (get-option gnc:pagename-general
gnc:optname-reportname)) gnc:optname-reportname))
(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))
(splits '()) (splits '())
(daily-totals (list 0 0 0 0 0 0 0)) (daily-totals (list 0 0 0 0 0 0 0))
;; Note: the absolute-super-duper-i18n'ed solution ;; Note: the absolute-super-duper-i18n'ed solution
;; would be to use the locale-using functions ;; would be to use the locale-using functions
;; date->string of srfi-19, similar to get_wday_name() ;; date->string of srfi-19, similar to get_wday_name()
;; in src/engine/FreqSpeq.c. For now, we simply use ;; in src/engine/FreqSpeq.c. For now, we simply use
;; the normal translations, which show up in the glade ;; the normal translations, which show up in the glade
;; file src/gnome-utils/gtkbuilder/gnc-frequency.glade anyway. ;; file src/gnome-utils/gtkbuilder/gnc-frequency.glade anyway.
(days-of-week (list (_"Sunday") (_"Monday") (days-of-week (list (_"Sunday") (_"Monday")
(_"Tuesday") (_"Wednesday") (_"Tuesday") (_"Wednesday")
(_"Thursday") (_"Friday") (_"Saturday")))) (_"Thursday") (_"Friday") (_"Saturday"))))
(gnc:debug daily-totals) (gnc:debug daily-totals)
;; The percentage done numbers here are a hack so that ;; The percentage done numbers here are a hack so that
;; something gets displayed. On my system the ;; something gets displayed. On my system the
;; gnc:case-exchange-time-fn takes about 20% of the time ;; gnc:case-exchange-time-fn takes about 20% of the time
@ -203,57 +200,58 @@
;; routine needs to send progress reports, or the price ;; routine needs to send progress reports, or the price
;; lookup should be distributed and done when actually ;; lookup should be distributed and done when actually
;; needed so as to amortize the cpu time properly. ;; needed so as to amortize the cpu time properly.
(gnc:report-percent-done 1) (gnc:report-percent-done 1)
(set! commodity-list (gnc:accounts-get-commodities (set! commodity-list (gnc:accounts-get-commodities
(append (append
(gnc:acccounts-get-all-subaccounts accounts) (gnc:acccounts-get-all-subaccounts accounts)
accounts) accounts)
report-currency)) report-currency))
(gnc:report-percent-done 5) (gnc:report-percent-done 5)
(set! exchange-fn (gnc:case-exchange-time-fn (set! exchange-fn (gnc:case-exchange-time-fn
price-source report-currency price-source report-currency
commodity-list to-date commodity-list to-date
5 20)) 5 20))
(gnc:report-percent-done 20) (gnc:report-percent-done 20)
;; initialize the query to find splits in the right ;; initialize the query to find splits in the right
;; date range and accounts ;; date range and accounts
(qof-query-set-book query (gnc-get-current-book)) (qof-query-set-book query (gnc-get-current-book))
;; for balance purposes, we don't need to do this, but it cleans up ;; for balance purposes, we don't need to do this, but it cleans up
;; the table display. ;; the table display.
(gnc:query-set-match-non-voids-only! query (gnc-get-current-book)) (gnc:query-set-match-non-voids-only! query (gnc-get-current-book))
;; add accounts to the query (include subaccounts ;; add accounts to the query (include subaccounts
;; if requested) ;; if requested)
(gnc:report-percent-done 25) (gnc:report-percent-done 25)
(if dosubs? (if dosubs?
(let ((subaccts '())) (let ((subaccts '()))
(for-each (for-each
(lambda (acct) (lambda (acct)
(let ((this-acct-subs (let ((this-acct-subs
(gnc-account-get-descendants-sorted acct))) (gnc-account-get-descendants-sorted acct)))
(if (list? this-acct-subs) (if (list? this-acct-subs)
(set! subaccts (set! subaccts
(append subaccts this-acct-subs))))) (append subaccts this-acct-subs)))))
accounts) accounts)
;; Beware: delete-duplicates is an O(n^2) ;; Beware: delete-duplicates is an O(n^2)
;; algorithm. More efficient method: sort the list, ;; algorithm. More efficient method: sort the list,
;; then use a linear algorithm. ;; then use a linear algorithm.
(set! accounts (set! accounts
(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
query #t from-date #t to-date QOF-QUERY-AND) query #t from-date #t to-date QOF-QUERY-AND)
(qof-query-set-sort-order query (qof-query-set-sort-order query
(list SPLIT-TRANS TRANS-DATE-POSTED) (list SPLIT-TRANS TRANS-DATE-POSTED)
(list QUERY-DEFAULT-SORT) (list QUERY-DEFAULT-SORT)
'()) '())
;; get the query results ;; get the query results
(set! splits (qof-query-run query)) (set! splits (qof-query-run query))
(qof-query-destroy query) (qof-query-destroy query)
(gnc:report-percent-done 40) (gnc:report-percent-done 40)
@ -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,50 +282,49 @@
(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
(format #f report-title
(string-append
(format #f
(_ "~a to ~a") (_ "~a to ~a")
(qof-print-date from-date) (qof-print-date from-date)
(qof-print-date to-date)) (qof-print-date to-date))
(if show-total? (if show-total?
(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-chart-add-data-series!
""))) chart
reportname
(gnc:html-piechart-set-data! chart (map cadr zipped-list)) (map cadr zipped-list)
(gnc:html-piechart-set-colors! (gnc:assign-colors (length zipped-list)))
chart (gnc:assign-colors (length zipped-list))) (gnc:html-chart-set-data-labels! chart labels)
(gnc:html-piechart-set-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
report-title (gnc:report-id report-obj)))))) report-title (gnc:report-id report-obj))))))
(gnc:html-document-add-object! (gnc:html-document-add-object!
document document
(gnc:html-make-empty-data-warning (gnc:html-make-empty-data-warning
@ -336,22 +333,23 @@
(gnc:report-finished) (gnc:report-finished)
document)) document))
(for-each (for-each
(lambda (l) (lambda (l)
(gnc:define-report (gnc:define-report
'version 1 'version 1
'name (car l) 'name (car l)
'report-guid (car (reverse l)) 'report-guid (car (reverse l))
'menu-path (list gnc:menuname-income-expense) 'menu-path (list gnc:menuname-income-expense)
'menu-name (caddr l) 'menu-name (caddr l)
'menu-tip (car (cdddr l)) 'menu-tip (car (cdddr l))
'options-generator (lambda () (options-generator (cadr l))) 'options-generator (lambda () (options-generator (cadr l)))
'renderer (lambda (report-obj) 'renderer (lambda (report-obj)
(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")))