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

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

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)

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