TP->T64: gnucash/report/standard-reports/daily-reports.scm

This commit is contained in:
Christopher Lam 2018-01-08 18:35:46 +11:00
parent 78ea4545f3
commit 59a8a42f7d

View File

@ -2,6 +2,7 @@
;; daily-reports.scm: reports based on the day of the week ;; daily-reports.scm: reports based on the day of the week
;; ;;
;; Copyright (C) 2003, Andy Wingo <wingo at pobox dot com> ;; Copyright (C) 2003, Andy Wingo <wingo at pobox dot com>
;; Christopher Lam upgrade to time64 (2017)
;; ;;
;; based on account-piecharts.scm by Robert Merkel (rgmerk@mira.net) ;; based on account-piecharts.scm by Robert Merkel (rgmerk@mira.net)
;; and Christian Stimming <stimming@tu-harburg.de> with ;; and Christian Stimming <stimming@tu-harburg.de> with
@ -154,8 +155,8 @@
(list interval-start (list interval-start
interval-end interval-end
(/ (stats-accum 'total #f) (/ (stats-accum 'total #f)
(gnc:timepair-delta interval-start (- interval-end
interval-end)) interval-start))
(minmax-accum 'getmax #f) (minmax-accum 'getmax #f)
(minmax-accum 'getmin #f) (minmax-accum 'getmin #f)
(gain-loss-accum 'debits #f) (gain-loss-accum 'debits #f)
@ -195,9 +196,8 @@
(define (update-stats split-amt split-time) (define (update-stats split-amt split-time)
(let ((time-difference (gnc:timepair-delta (let ((time-difference (- split-time
last-balance-time last-balance-time)))
split-time)))
(stats-accum 'add (* last-balance time-difference)) (stats-accum 'add (* last-balance time-difference))
(set! last-balance (+ last-balance split-amt)) (set! last-balance (+ last-balance split-amt))
(set! last-balance-time split-time) (set! last-balance-time split-time)
@ -205,15 +205,13 @@
(gain-loss-accum 'add split-amt))) (gain-loss-accum 'add split-amt)))
(define (split-recurse) (define (split-recurse)
(if (or (null? splits) (gnc:timepair-gt (if (or (null? splits)
(gnc-transaction-get-date-posted (> (xaccTransGetDate (xaccSplitGetParent (car splits)))
(xaccSplitGetParent to))
(car splits))) to))
#f #f
(let* (let*
((split (car splits)) ((split (car splits))
(split-time (gnc-transaction-get-date-posted (split-time (xaccTransGetDate (xaccSplitGetParent split)))
(xaccSplitGetParent split)))
;; FIXME: Which date should we use here? The 'to' ;; FIXME: Which date should we use here? The 'to'
;; date? the 'split-time'? ;; date? the 'split-time'?
(split-amt (get-split-value split split-time))) (split-amt (get-split-value split split-time)))
@ -225,7 +223,7 @@
; (gnc:debug "splits " splits) ; (gnc:debug "splits " splits)
(update-stats split-amt split-time) (update-stats split-amt split-time)
(set! splits (cdr splits)) (set! splits (cdr splits))
(split-recurse)))) (split-recurse))))
; the minmax accumulator ; the minmax accumulator
@ -238,11 +236,9 @@
(update-stats 0.0 to) (update-stats 0.0 to)
(list minmax-accum stats-accum gain-loss-accum last-balance splits))) (list minmax-accum stats-accum gain-loss-accum last-balance splits)))
(for-each (for-each
(lambda (interval) (lambda (interval)
(let* (let*
((interval-results ((interval-results
(process-interval (process-interval
splits splits
@ -263,7 +259,6 @@
min-max-accum gain-loss-accum))) min-max-accum gain-loss-accum)))
interval-list) interval-list)
(reverse data-rows))) (reverse data-rows)))
@ -283,10 +278,10 @@
(gnc:report-starting reportname) (gnc:report-starting reportname)
;; Get all options ;; Get all options
(let* ((to-date-tp (gnc:timepair-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-tp (gnc:timepair-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))))
@ -308,8 +303,8 @@
(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:timepair-end-day-time (beforebegindate (gnc:time64-end-day-time
(gnc:timepair-previous-day from-date-tp))) (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-piechart))
(topl-accounts (gnc:filter-accountlist-type (topl-accounts (gnc:filter-accountlist-type
@ -372,7 +367,7 @@
(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-tp commodity-list to-date
5 20)) 5 20))
(gnc:report-percent-done 20) (gnc:report-percent-done 20)
@ -406,8 +401,8 @@
(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
(xaccQueryAddDateMatchTS (xaccQueryAddDateMatchTT
query #t from-date-tp #t to-date-tp 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)
@ -438,7 +433,7 @@
;; and analyze the data ;; and analyze the data
(set! data (analyze-splits splits startbal (set! data (analyze-splits splits startbal
from-date-tp to-date-tp from-date to-date
DayDelta monetary->double)) DayDelta monetary->double))
(gnc:report-percent-done 70) (gnc:report-percent-done 70)
@ -448,7 +443,7 @@
(for-each (for-each
(lambda (split) (lambda (split)
(let ((k (modulo (- (gnc:timepair-get-week-day (let ((k (modulo (- (gnc:time64-get-week-day
(list-ref split 1)) 1) 7))) ; end-date (list-ref split 1)) 1) 7))) ; end-date
(list-set! daily-totals k (list-set! daily-totals k
(+ (list-ref daily-totals k) (+ (list-ref daily-totals k)
@ -482,8 +477,8 @@
chart (string-append chart (string-append
(sprintf #f (sprintf #f
(_ "%s to %s") (_ "%s to %s")
(gnc-print-date from-date-tp) (qof-print-date from-date)
(gnc-print-date to-date-tp)) (qof-print-date to-date))
(if show-total? (if show-total?
(let ((total (apply + daily-totals))) (let ((total (apply + daily-totals)))
(sprintf (sprintf