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:
Andrew Sackville-West 2007-12-18 20:55:39 +00:00
parent 814068b8bb
commit 3c10480d4e
3 changed files with 58 additions and 1 deletions

View File

@ -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)

View File

@ -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)

View File

@ -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