[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