IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Robert Graham Merkel's scheme date patch.

Browse Source 
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2518 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2000-06-27 04:17:31 +00:00
parent da148fd603
commit 075cbd9157
3 changed files with 83 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
ChangeLog
View File

@ -1,3 +1,11 @@
2000-06-27 Robert Graham Merkel <rgmerk@mira.net>
* 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 <rgmerk@mira.net>
* src/guile/global-options.[ch] (gnc_option_refresh_ui_by_name):

62
src/scm/date-utilities.scm
View File

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

57
src/scm/report/transaction-report.scm
View File

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