From 3c10480d4e8aee3a643b92dbd4c77a2005fe3c47 Mon Sep 17 00:00:00 2001 From: Andrew Sackville-West Date: Tue, 18 Dec 2007 20:55:39 +0000 Subject: [PATCH] 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 --- src/app-utils/app-utils.scm | 3 +++ src/app-utils/date-utilities.scm | 27 +++++++++++++++++++ src/report/standard-reports/transaction.scm | 29 ++++++++++++++++++++- 3 files changed, 58 insertions(+), 1 deletion(-) diff --git a/src/app-utils/app-utils.scm b/src/app-utils/app-utils.scm index 879c4ed1c8..d1c0968b83 100644 --- a/src/app-utils/app-utils.scm +++ b/src/app-utils/app-utils.scm @@ -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) diff --git a/src/app-utils/date-utilities.scm b/src/app-utils/date-utilities.scm index 2390db5d0d..d0765b80d3 100644 --- a/src/app-utils/date-utilities.scm +++ b/src/app-utils/date-utilities.scm @@ -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) diff --git a/src/report/standard-reports/transaction.scm b/src/report/standard-reports/transaction.scm index b3f611f3f3..5dcd25e810 100644 --- a/src/report/standard-reports/transaction.scm +++ b/src/report/standard-reports/transaction.scm @@ -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