diff --git a/ChangeLog b/ChangeLog index 136c28e42d..803ed50023 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2000-06-27 Robert Graham Merkel + + * src/scm/date-utilities.scm: Added date-granularity timepair comparison + functions. + + * src/scm/report/transaction-report.scm: Changed to use date + comparison functions in date-utilities.scm + 2000-06-26 Robert Graham Merkel * src/guile/global-options.[ch] (gnc_option_refresh_ui_by_name): diff --git a/src/scm/date-utilities.scm b/src/scm/date-utilities.scm index 42ed3247cb..bb1f60e0a4 100644 --- a/src/scm/date-utilities.scm +++ b/src/scm/date-utilities.scm @@ -33,24 +33,27 @@ (define (gnc:date-get-week-day datevec) (+ (vector-ref datevec 6) 1)) ;; jan 1 == 1 + (define (gnc:date-get-year-day datevec) (+ (vector-ref datevec 7) 1)) -;; fixme: internationalize +(define (gnc:timepair-get-year tp) + (gnc:date-get-year (localtime (gnc:timepair->secs tp)))) + +(define (gnc:timepair-get-month-day tp) + (gnc:date-get-month (localtime (gnc:timepair->secs tp)))) + +(define (gnc:timepair-get-month tp) + (gnc:date-get-month (localtime (gnc:timepair->secs tp)))) + +(define (gnc:timepair-get-week-day tp) + (gnc:date-get-week-day (localtime (gnc:timepair->secs tp)))) + +(define (gnc:timepair-get-year-day tp) + (gnc:date-get-year-day (localtime (gnc:timepair->secs tp)))) + (define (gnc:date-get-month-string datevec) - (case (gnc:date-get-month datevec) - ((1) "January") - ((2) "February") - ((3) "March") - ((4) "April") - ((5) "May") - ((6) "June") - ((7) "July") - ((8) "August") - ((9) "September") - ((10) "October") - ((11) "November") - ((12) "December"))) + (strftime "%B" datevec)) ;; is leap year? (define (gnc:leap-year? year) @@ -144,15 +147,41 @@ (define gnc:timepair-lt gnc:timepair-later) +(define (gnc:timepair-earlier t1 t2) + (gnc:timepair-later t2 t1)) + ;; t1 <= t2 (define (gnc:timepair-le t1 t2) (cond ((< (car t1) (car t2)) #t) ((= (car t1) (car t2)) (<= (cdr t2) (cdr t2))) (else #f))) +(define (gnc:timepair-ge t1 t2) + (gnc:timepair-le t2 t1)) + (define (gnc:timepair-eq t1 t2) (and (= (car t1) (car t2)) (= (cdr t1) (cdr t2)))) +;; date-granularity comparison functions. + +(define (gnc:timepair-earlier-date t1 t2) + (gnc:timepair-earlier (gnc:timepair-canonical-day-time t1) + (gnc:timepair-canonical-day-time t2))) + +(define (gnc:timepair-later-date t1 t2) + (gnc:timepair-earlier-date t2 t1)) + +(define (gnc:timepair-le-date t1 t2) + (gnc:timepair-le (gnc:timepair-canonical-day-time t1) + (gnc:timepair-canonical-day-time t2))) + +(define (gnc:timepair-ge-date t1 t2) + (gnc:timepair-le t2 t1)) + +(define (gnc:timepair-eq-date t1 t2) + (gnc:timepair-eq (gnc:timepair-canonical-day-time t1) + (gnc:timepair-canonical-day-time t2))) + ;; Build a list of time intervals (define (dateloop curd endd incr) (cond ((gnc:timepair-later curd endd) @@ -211,6 +240,9 @@ (+ (car tp) (/ (cdr tp) 1000000000)))) +(define (gnc:timepair->date tp) + (localtime (gnc:timepair->secs tp))) + ;; Find difference in seconds time 1 and time2 (define (gnc:timepair-delta t1 t2) (- (gnc:timepair->secs t2) (gnc:timepair->secs t1))) @@ -221,7 +253,7 @@ ;;; Added from transaction-report.scm (define (gnc:timepair-to-datestring tp) - (let ((bdtime (localtime (car tp)))) + (let ((bdtime (localtime (gnc:timepair->secs tp)))) (strftime "%x" bdtime))) ;; given a timepair contains any time on a certain day (local time) diff --git a/src/scm/report/transaction-report.scm b/src/scm/report/transaction-report.scm index 5b36555b3e..a838b08e10 100644 --- a/src/scm/report/transaction-report.scm +++ b/src/scm/report/transaction-report.scm @@ -253,9 +253,9 @@ (lambda (split) (gnc:transaction-get-date-posted (gnc:split-get-parent split))) (if ascending? - (lambda (a b) (< (car a) (car b))) - (lambda (a b) (> (car a) (car b)))) - (lambda (a b) (= (car a) (car b))) + gnc:timepair-later-date + gnc:timepair-earlier-date) + gnc:timepair-eq-date #f #f)) @@ -264,37 +264,37 @@ (lambda (split) (gnc:transaction-get-date-posted (gnc:split-get-parent split))) (if ascending? - (lambda (a b) (< (car a) (car b))) - (lambda (a b) (> (car a) (car b)))) - (lambda (a b) (= (car a) (car b))) + gnc:timepair-later-date + gnc:timepair-earlier-date) + gnc:timepair-eq-date (lambda (a b) - (= (gnc:date-get-month (localtime (car a))) - (gnc:date-get-month (localtime (car b))))) + (= (gnc:timepair-get-month a) + (gnc:timepair-get-month b))) (lambda (date) - (gnc:date-get-month-string (localtime (car date)))))) + (gnc:date-get-month-string (localtime (gnc:timepair->secs date)))))) ((date-yearly) (make-report-sort-spec (lambda (split) (gnc:transaction-get-date-posted (gnc:split-get-parent split))) (if ascending? - (lambda (a b) (< (car a) (car b))) - (lambda (a b) (> (car a) (car b)))) - (lambda (a b) (= (car a) (car b))) + gnc:timepair-later-date + gnc:timepair-earlier-date) + gnc:timepair-eq-date (lambda (a b) - (= (gnc:date-get-year (localtime (car a))) - (gnc:date-get-year (localtime (car b))))) + (= (gnc:timepair-get-year a) + (gnc:timepair-get-year b))) (lambda (date) - (number->string (gnc:date-get-year (localtime (car date))))))) + (number->string (gnc:timepair-get-year date))))) ((time) (make-report-sort-spec (lambda (split) (gnc:transaction-get-date-entered (gnc:split-get-parent split))) (if ascending? - (lambda (a b) (< (car a) (car b))) - (lambda (a b) (> (car a) (car b)))) - (lambda (a b) (and (= (car a) (car b)) (= (cdr a) (cdr b)))) + gnc:timepair-later + gnc:timepair-earlier) + gnc:timepair-eq #f #f)) @@ -377,15 +377,14 @@ ;; returns a predicate that returns true only if a split is ;; between early-date and late-date - (define (split-report-make-date-filter-predicate begin-date-secs - end-date-secs) + (define (split-report-make-date-filter-predicate begin-date-tp + end-date-tp) (lambda (split) - (let ((date - (car (gnc:timepair-canonical-day-time - (gnc:transaction-get-date-posted - (gnc:split-get-parent split)))))) - (and (>= date begin-date-secs) - (<= date end-date-secs))))) + (let ((tp + (gnc:transaction-get-date-posted + (gnc:split-get-parent split)))) + (and (gnc:timepair-ge-date tp begin-date-tp) + (gnc:timepair-le-date tp end-date-tp))))) ;; register a configuration option for the transaction report (define (trep-options-generator) @@ -600,9 +599,9 @@ "Style")) (accounts (gnc:option-value tr-report-account-op)) (date-filter-pred (split-report-make-date-filter-predicate - (car (gnc:option-value begindate)) - (car (gnc:timepair-end-day-time - (gnc:option-value enddate))))) + (gnc:option-value begindate) + (gnc:timepair-end-day-time + (gnc:option-value enddate)))) (s1 (split-report-get-sort-spec-entry (gnc:option-value tr-report-primary-key-op) (eq? (gnc:option-value tr-report-primary-order-op) 'ascend)