r16680 - gnucash/trunk/src - forward-port (swigify) weekly subtotals for transaction report. see #138989.
Andrew Sackville-West
andrewsw at cvs.gnucash.org
Tue Dec 18 15:55:39 EST 2007
Author: andrewsw
Date: 2007-12-18 15:55:39 -0500 (Tue, 18 Dec 2007)
New Revision: 16680
Trac: http://svn.gnucash.org/trac/changeset/16680
Modified:
gnucash/trunk/src/app-utils/app-utils.scm
gnucash/trunk/src/app-utils/date-utilities.scm
gnucash/trunk/src/report/standard-reports/transaction.scm
Log:
forward-port (swigify) weekly subtotals for transaction report. see #138989.
Modified: gnucash/trunk/src/app-utils/app-utils.scm
===================================================================
--- gnucash/trunk/src/app-utils/app-utils.scm 2007-12-18 15:31:34 UTC (rev 16679)
+++ gnucash/trunk/src/app-utils/app-utils.scm 2007-12-18 20:55:39 UTC (rev 16680)
@@ -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)
Modified: gnucash/trunk/src/app-utils/date-utilities.scm
===================================================================
--- gnucash/trunk/src/app-utils/date-utilities.scm 2007-12-18 15:31:34 UTC (rev 16679)
+++ gnucash/trunk/src/app-utils/date-utilities.scm 2007-12-18 20:55:39 UTC (rev 16680)
@@ -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)
Modified: gnucash/trunk/src/report/standard-reports/transaction.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/transaction.scm 2007-12-18 15:31:34 UTC (rev 16679)
+++ gnucash/trunk/src/report/standard-reports/transaction.scm 2007-12-18 20:55:39 UTC (rev 16680)
@@ -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 @@
;; 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
More information about the gnucash-changes
mailing list