[Gnucash-changes] Ed Huff's (May) patch re: quarterly support in
the transaction report +
Joshua Sled
jsled at cvs.gnucash.org
Fri Oct 7 11:33:22 EDT 2005
Log Message:
-----------
Ed Huff's (May) patch re: quarterly support in the transaction report + date-handling refactoring.
Tags:
----
gnucash-gnome2-dev
Modified Files:
--------------
gnucash/src/report/standard-reports:
transaction.scm
gnucash:
ChangeLog
gnucash/src/app-utils:
app-utils.scm
date-utilities.scm
Revision Data
-------------
Index: transaction.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/standard-reports/transaction.scm,v
retrieving revision 1.15.4.3
retrieving revision 1.15.4.4
diff -Lsrc/report/standard-reports/transaction.scm -Lsrc/report/standard-reports/transaction.scm -u -r1.15.4.3 -r1.15.4.4
--- src/report/standard-reports/transaction.scm
+++ src/report/standard-reports/transaction.scm
@@ -81,19 +81,29 @@
(= (gnc:split-compare-other-account-codes a b) 0))
(define (timepair-same-year tp-a tp-b)
- (= (tm:year (gnc:timepair->date tp-a))
- (tm:year (gnc:timepair->date tp-b))))
+ (= (gnc:timepair-get-year tp-a)
+ (gnc:timepair-get-year tp-b)))
+
+(define (timepair-same-quarter tp-a tp-b)
+ (and (timepair-same-year tp-a tp-b)
+ (= (gnc:timepair-get-quarter tp-a)
+ (gnc:timepair-get-quarter tp-b))))
(define (timepair-same-month tp-a tp-b)
(and (timepair-same-year tp-a tp-b)
- (= (tm:mon (gnc:timepair->date tp-a))
- (tm:mon (gnc:timepair->date tp-b)))))
+ (= (gnc:timepair-get-month tp-a)
+ (gnc:timepair-get-month tp-b))))
(define (split-same-month-p a b)
(let ((tp-a (gnc:transaction-get-date-posted (gnc:split-get-parent a)))
(tp-b (gnc:transaction-get-date-posted (gnc:split-get-parent b))))
(timepair-same-month tp-a tp-b)))
+(define (split-same-quarter-p a b)
+ (let ((tp-a (gnc:transaction-get-date-posted (gnc:split-get-parent a)))
+ (tp-b (gnc:transaction-get-date-posted (gnc:split-get-parent b))))
+ (timepair-same-quarter tp-a tp-b)))
+
(define (split-same-year-p a b)
(let ((tp-a (gnc:transaction-get-date-posted (gnc:split-get-parent a)))
(tp-b (gnc:transaction-get-date-posted (gnc:split-get-parent b))))
@@ -158,15 +168,24 @@
table width subheading-style)))
(define (render-month-subheading split table width subheading-style column-vector)
- (let ((tm (gnc:timepair->date (gnc:transaction-get-date-posted
- (gnc:split-get-parent split)))))
- (add-subheading-row (strftime "%B %Y" tm)
- table width subheading-style)))
+ (add-subheading-row (gnc:date-get-month-year-string
+ (gnc:timepair->date
+ (gnc:transaction-get-date-posted
+ (gnc:split-get-parent split))))
+ table width subheading-style))
+
+(define (render-quarter-subheading split table width subheading-style column-vector)
+ (add-subheading-row (gnc:date-get-quarter-year-string
+ (gnc:timepair->date
+ (gnc:transaction-get-date-posted
+ (gnc:split-get-parent split))))
+ table width subheading-style))
(define (render-year-subheading split table width subheading-style column-vector)
- (add-subheading-row (strftime "%Y" (gnc:timepair->date
- (gnc:transaction-get-date-posted
- (gnc:split-get-parent split))))
+ (add-subheading-row (gnc:date-get-year-string
+ (gnc:timepair->date
+ (gnc:transaction-get-date-posted
+ (gnc:split-get-parent split))))
table width subheading-style))
@@ -227,10 +246,18 @@
(let ((tm (gnc:timepair->date (gnc:transaction-get-date-posted
(gnc:split-get-parent split)))))
(add-subtotal-row table width
- (total-string (strftime "%B %Y" tm))
+ (total-string (gnc:date-get-month-year-string tm))
total-collector subtotal-style export?)))
+(define (render-quarter-subtotal
+ table width split total-collector subtotal-style column-vector export?)
+ (let ((tm (gnc:timepair->date (gnc:transaction-get-date-posted
+ (gnc:split-get-parent split)))))
+ (add-subtotal-row table width
+ (total-string (gnc:date-get-quarter-year-string tm))
+ total-collector subtotal-style export?)))
+
(define (render-year-subtotal
table width split total-collector subtotal-style column-vector export?)
(let ((tm (gnc:timepair->date (gnc:transaction-get-date-posted
@@ -645,6 +672,7 @@
(vector 'none (N_ "None") (N_ "None"))
;;(vector 'weekly (N_ "Weekly") (N_ "Weekly"))
(vector 'monthly (N_ "Monthly") (N_ "Monthly"))
+ (vector 'quarterly (N_ "Quarterly") (N_ "Quarterly"))
(vector 'yearly (N_ "Yearly") (N_ "Yearly")))))
;; primary sorting criterion
@@ -1105,6 +1133,8 @@
(cons 'none (vector #f #f #f))
(cons 'monthly (vector split-same-month-p render-month-subheading
render-month-subtotal))
+ (cons 'quarterly (vector split-same-quarter-p render-quarter-subheading
+ render-quarter-subtotal))
(cons 'yearly (vector split-same-year-p render-year-subheading
render-year-subtotal))))
Index: ChangeLog
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/ChangeLog,v
retrieving revision 1.1487.2.309
retrieving revision 1.1487.2.310
diff -LChangeLog -LChangeLog -u -r1.1487.2.309 -r1.1487.2.310
--- ChangeLog
+++ ChangeLog
@@ -1,3 +1,18 @@
+2005-10-07 Joshua Sled <jsled at asynchronous.org>
+
+ Patch from Edward J. Huff <ejhuff at huff20may77.us>:
+ * src/report/standard-reports/transaction.scm:
+ * src/app-utils/date-utilities.scm:
+ * src/app-utils/app-utils.scm:
+ Add "Quarterly" option to transaction report. Add support
+ functions to app-utils.scm and date-utilities.scm to support
+ finding the quarter of a given date, and to format it as Q1, Q2,
+ Q3, or Q4. Fix a bug in the as-yet-unused function
+ gnc:timepair-get-month-day. Make use of the existing support
+ functions instead of re-inventing them in transaction.scm.
+ Move all uses of strftime from transaction.scm to
+ date-utilities.scm.
+
2005-10-07 David Hampton <hampton at employees.org>
* src/gnome-utils/dialog-options.c: Convert the multiple choice
Index: app-utils.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/app-utils/app-utils.scm,v
retrieving revision 1.22.4.3
retrieving revision 1.22.4.4
diff -Lsrc/app-utils/app-utils.scm -Lsrc/app-utils/app-utils.scm -u -r1.22.4.3 -r1.22.4.4
--- src/app-utils/app-utils.scm
+++ src/app-utils/app-utils.scm
@@ -137,16 +137,22 @@
(export gnc:timepair->date)
(export gnc:date->timepair)
(export gnc:date-get-year)
+(export gnc:date-get-quarter)
(export gnc:date-get-month-day)
(export gnc:date-get-month)
(export gnc:date-get-week-day)
(export gnc:date-get-year-day)
(export gnc:timepair-get-year)
+(export gnc:timepair-get-quarter)
(export gnc:timepair-get-month-day)
(export gnc:timepair-get-month)
(export gnc:timepair-get-week-day)
(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:leap-year?)
(export gnc:days-in-year)
(export gnc:days-in-month)
Index: date-utilities.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/app-utils/date-utilities.scm,v
retrieving revision 1.4.4.1
retrieving revision 1.4.4.2
diff -Lsrc/app-utils/date-utilities.scm -Lsrc/app-utils/date-utilities.scm -u -r1.4.4.1 -r1.4.4.2
--- src/app-utils/date-utilities.scm
+++ src/app-utils/date-utilities.scm
@@ -38,6 +38,8 @@
;; get stuff from localtime date vector
(define (gnc:date-get-year datevec)
(+ 1900 (tm:year datevec)))
+(define (gnc:date-get-quarter datevec)
+ (+ (quotient (tm:mon datevec) 3) 1))
(define (gnc:date-get-month-day datevec)
(tm:mday datevec))
;; get month with january==1
@@ -53,8 +55,11 @@
(define (gnc:timepair-get-year tp)
(gnc:date-get-year (gnc:timepair->date tp)))
+(define (gnc:timepair-get-quarter tp)
+ (gnc:date-get-quarter (gnc:timepair->date tp)))
+
(define (gnc:timepair-get-month-day tp)
- (gnc:date-get-month (gnc:timepair->date tp)))
+ (gnc:date-get-month-day (gnc:timepair->date tp)))
(define (gnc:timepair-get-month tp)
(gnc:date-get-month (gnc:timepair->date tp)))
@@ -65,9 +70,24 @@
(define (gnc:timepair-get-year-day tp)
(gnc:date-get-year-day (gnc:timepair->date tp)))
+(define (gnc:date-get-year-string datevec)
+ (strftime "%Y" datevec))
+
+(define (gnc:date-get-quarter-string datevec)
+ (sprintf #f "Q%d" (gnc:date-get-quarter datevec)))
+
+(define (gnc:date-get-quarter-year-string datevec)
+ (string-append
+ (gnc:date-get-quarter-string datevec)
+ " "
+ (gnc:date-get-year-string datevec)))
+
(define (gnc:date-get-month-string datevec)
(strftime "%B" datevec))
+(define (gnc:date-get-month-year-string datevec)
+ (strftime "%B %Y" datevec))
+
;; is leap year?
(define (gnc:leap-year? year)
(if (= (remainder year 4) 0)
More information about the gnucash-changes
mailing list