mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
TP->T64: gnucash/report/standard-reports/daily-reports.scm
This commit is contained in:
parent
78ea4545f3
commit
59a8a42f7d
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user