mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
forward-port (swigify) weekly subtotals for transaction report. see #138989.
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@16680 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
parent
814068b8bb
commit
3c10480d4e
@ -145,12 +145,14 @@
|
||||
(export gnc:timepair-get-month-day)
|
||||
(export gnc:timepair-get-month)
|
||||
(export gnc:timepair-get-week-day)
|
||||
(export gnc:timepair-get-week)
|
||||
(export gnc:timepair-get-year-day)
|
||||
(export gnc:date-get-year-string)
|
||||
(export gnc:date-get-quarter-string)
|
||||
(export gnc:date-get-quarter-year-string)
|
||||
(export gnc:date-get-month-string)
|
||||
(export gnc:date-get-month-year-string)
|
||||
(export gnc:date-get-week-year-string)
|
||||
(export gnc:leap-year?)
|
||||
(export gnc:days-in-year)
|
||||
(export gnc:days-in-month)
|
||||
@ -158,6 +160,7 @@
|
||||
(export gnc:date-year-delta)
|
||||
(export gnc:date-to-month-fraction)
|
||||
(export gnc:date-to-week-fraction)
|
||||
(export gnc:date-to-week)
|
||||
(export gnc:date-to-day-fraction)
|
||||
(export moddatek)
|
||||
(export decdate)
|
||||
|
@ -49,6 +49,10 @@
|
||||
(define (gnc:date-get-week-day datevec)
|
||||
(+ (tm:wday datevec) 1))
|
||||
;; jan 1 == 1
|
||||
(define (gnc:date-get-week datevec)
|
||||
(gnc:date-to-week (gnc:timepair->secs
|
||||
(gnc:timepair-start-day-time
|
||||
(gnc:date->timepair datevec)))))
|
||||
|
||||
(define (gnc:date-get-year-day datevec)
|
||||
(+ (tm:yday datevec) 1))
|
||||
@ -68,6 +72,9 @@
|
||||
(define (gnc:timepair-get-week-day tp)
|
||||
(gnc:date-get-week-day (gnc:timepair->date tp)))
|
||||
|
||||
(define (gnc:timepair-get-week tp)
|
||||
(gnc:date-get-week (gnc:timepair->date tp)))
|
||||
|
||||
(define (gnc:timepair-get-year-day tp)
|
||||
(gnc:date-get-year-day (gnc:timepair->date tp)))
|
||||
|
||||
@ -89,6 +96,23 @@
|
||||
(define (gnc:date-get-month-year-string datevec)
|
||||
(strftime "%B %Y" datevec))
|
||||
|
||||
(define (gnc:date-get-week-year-string datevec)
|
||||
(let ((begin-string (gnc-print-date
|
||||
(gnc:secs->timepair
|
||||
(+ (* (gnc:date-to-week
|
||||
(gnc:timepair->secs
|
||||
(gnc:timepair-start-day-time
|
||||
(gnc:date->timepair datevec))))
|
||||
604800 ) 345600))))
|
||||
(end-string (gnc-print-date
|
||||
(gnc:secs->timepair
|
||||
(+ (* (gnc:date-to-week
|
||||
(gnc:timepair->secs
|
||||
(gnc:timepair-start-day-time
|
||||
(gnc:date->timepair datevec))))
|
||||
604800 ) 864000)))))
|
||||
(sprintf #f (_ "%s to %s") begin-string end-string)))
|
||||
|
||||
;; is leap year?
|
||||
(define (gnc:leap-year? year)
|
||||
(if (= (remainder year 4) 0)
|
||||
@ -150,6 +174,9 @@
|
||||
(define (gnc:date-to-week-fraction caltime)
|
||||
(/ (- (/ (/ caltime 3600.0) 24) 3) 7))
|
||||
|
||||
(define (gnc:date-to-week caltime)
|
||||
(quotient (- (quotient caltime 86400) 3) 7))
|
||||
|
||||
;; convert a date in seconds since 1970 into # of days since Feb 28, 1970
|
||||
;; ignoring leap-seconds
|
||||
(define (gnc:date-to-day-fraction caltime)
|
||||
|
@ -95,6 +95,16 @@
|
||||
(= (gnc:timepair-get-month tp-a)
|
||||
(gnc:timepair-get-month tp-b))))
|
||||
|
||||
(define (timepair-same-week tp-a tp-b)
|
||||
(and (timepair-same-year tp-a tp-b)
|
||||
(= (gnc:timepair-get-week tp-a)
|
||||
(gnc:timepair-get-week tp-b))))
|
||||
|
||||
(define (split-same-week-p a b)
|
||||
(let ((tp-a (gnc-transaction-get-date-posted (xaccSplitGetParent a)))
|
||||
(tp-b (gnc-transaction-get-date-posted (xaccSplitGetParent b))))
|
||||
(timepair-same-week tp-a tp-b)))
|
||||
|
||||
(define (split-same-month-p a b)
|
||||
(let ((tp-a (gnc-transaction-get-date-posted (xaccSplitGetParent a)))
|
||||
(tp-b (gnc-transaction-get-date-posted (xaccSplitGetParent b))))
|
||||
@ -168,6 +178,13 @@
|
||||
(used-sort-account-full-name column-vector))))
|
||||
table width subheading-style)))
|
||||
|
||||
(define (render-week-subheading split table width subheading-style column-vector)
|
||||
(add-subheading-row (gnc:date-get-week-year-string
|
||||
(gnc:timepair->date
|
||||
(gnc-transaction-get-date-posted
|
||||
(xaccSplitGetParent split))))
|
||||
table width subheading-style))
|
||||
|
||||
(define (render-month-subheading split table width subheading-style column-vector)
|
||||
(add-subheading-row (gnc:date-get-month-year-string
|
||||
(gnc:timepair->date
|
||||
@ -242,6 +259,14 @@
|
||||
(used-sort-account-full-name column-vector)))
|
||||
total-collector subtotal-style export?))
|
||||
|
||||
(define (render-week-subtotal
|
||||
table width split total-collector subtotal-style column-vector export?)
|
||||
(let ((tm (gnc:timepair->date (gnc-transaction-get-date-posted
|
||||
(xaccSplitGetParent split)))))
|
||||
(add-subtotal-row table width
|
||||
(total-string (gnc:date-get-week-year-string tm))
|
||||
total-collector subtotal-style export?)))
|
||||
|
||||
(define (render-month-subtotal
|
||||
table width split total-collector subtotal-style column-vector export?)
|
||||
(let ((tm (gnc:timepair->date (gnc-transaction-get-date-posted
|
||||
@ -700,7 +725,7 @@
|
||||
(subtotal-choice-list
|
||||
(list
|
||||
(vector 'none (N_ "None") (N_ "None"))
|
||||
;;(vector 'weekly (N_ "Weekly") (N_ "Weekly"))
|
||||
(vector 'weekly (N_ "Weekly") (N_ "Weekly"))
|
||||
(vector 'monthly (N_ "Monthly") (N_ "Monthly"))
|
||||
(vector 'quarterly (N_ "Quarterly") (N_ "Quarterly"))
|
||||
(vector 'yearly (N_ "Yearly") (N_ "Yearly")))))
|
||||
@ -1162,6 +1187,8 @@ Credit Card, and Income accounts")))))
|
||||
;; subtotal-renderer))
|
||||
(list
|
||||
(cons 'none (vector #f #f #f))
|
||||
(cons 'weekly (vector split-same-week-p render-week-subheading
|
||||
render-week-subtotal))
|
||||
(cons 'monthly (vector split-same-month-p render-month-subheading
|
||||
render-month-subtotal))
|
||||
(cons 'quarterly (vector split-same-quarter-p render-quarter-subheading
|
||||
|
Loading…
Reference in New Issue
Block a user