diff options
Diffstat (limited to '')
-rw-r--r-- | module/vcomponent/datetime.scm | 25 | ||||
-rw-r--r-- | module/vcomponent/group.scm | 4 | ||||
-rw-r--r-- | module/vcomponent/load.scm | 6 | ||||
-rw-r--r-- | module/vcomponent/parse.scm | 36 | ||||
-rw-r--r-- | module/vcomponent/recurrence/parse.scm | 7 |
5 files changed, 39 insertions, 39 deletions
diff --git a/module/vcomponent/datetime.scm b/module/vcomponent/datetime.scm index 5bf829a9..c01de7e7 100644 --- a/module/vcomponent/datetime.scm +++ b/module/vcomponent/datetime.scm @@ -1,10 +1,10 @@ (define-module (vcomponent datetime) #:use-module (vcomponent base) - #:use-module (srfi srfi-19) - #:use-module (srfi srfi-19 util) + #:use-module (srfi srfi-19 alt) + #:use-module (srfi srfi-19 alt util) #:use-module (util) - #:export (parse-datetime + #:export (#;parse-datetime event-overlaps? overlapping? event-contains? @@ -12,6 +12,7 @@ ) ;;; date time pointer +#; (define (parse-datetime dtime) "Parse the given date[time] string into a date object." (string->date @@ -33,30 +34,26 @@ Event must have the DTSTART and DTEND attribute set." (attr event-b 'DTSTART) (attr event-b 'DTEND))) -(define (event-contains? ev time) +(define (event-contains? ev datetime) "Does event overlap the date that contains time." - (let* ((date (time-utc->date time)) - (start (date->time-utc (drop-time date))) + (let* ((start (get-date datetime)) (end (add-day start))) (event-overlaps? ev start end))) -(define (ev-time<? a b) - (time<? (attr a 'DTSTART) - (attr b 'DTSTART))) +(define-public (ev-time<? a b) + (date/-time<? (attr a 'DTSTART) + (attr b 'DTSTART))) ;; Returns length of the event @var{e}, as a time-duration object. (define-public (event-length e) - (time-difference + (time- (attr e 'DTEND) (attr e 'DTSTART))) ;; Returns the length of the part of @var{e} which is within the day ;; starting at the time @var{start-of-day}. (define-public (event-length/day e start-of-day) - (time-difference + (time- (time-min (add-day start-of-day) (attr e 'DTEND)) (time-max start-of-day (attr e 'DTSTART)))) -(define-public (ev-time<? a b) - (time<? (attr a 'DTSTART) - (attr b 'DTSTART))) diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm index 46160a3a..acf41999 100644 --- a/module/vcomponent/group.scm +++ b/module/vcomponent/group.scm @@ -1,8 +1,8 @@ (define-module (vcomponent group) #:use-module (vcomponent) #:use-module (vcomponent datetime) - #:use-module (srfi srfi-19) - #:use-module (srfi srfi-19 util) + #:use-module (srfi srfi-19 alt) + #:use-module (srfi srfi-19 alt util) #:use-module (srfi srfi-41) #:use-module (srfi srfi-41 util) #:export (group-stream get-groups-between)) diff --git a/module/vcomponent/load.scm b/module/vcomponent/load.scm index 574c1d20..2e69d1f5 100644 --- a/module/vcomponent/load.scm +++ b/module/vcomponent/load.scm @@ -2,7 +2,7 @@ :export (load-calendars load-calendars*) :use-module (util) :use-module (srfi srfi-1) - :use-module (srfi srfi-19) + :use-module (srfi srfi-19 alt) :use-module (srfi srfi-41) :use-module (srfi srfi-41 util) :use-module (parameters) @@ -43,5 +43,5 @@ ;; collection if sorted, but for the time beieng it's much ;; easier to always sort it. (values calendars - (sort*! regular time<? (extract 'DTSTART)) - (sort*! repeating time<? (extract 'DTSTART))))) + (sort*! regular date/-time<? (extract 'DTSTART)) + (sort*! repeating date/-time<? (extract 'DTSTART))))) diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm index c4142910..646d1f72 100644 --- a/module/vcomponent/parse.scm +++ b/module/vcomponent/parse.scm @@ -3,9 +3,10 @@ :use-module (rnrs bytevectors) :use-module (srfi srfi-1) :use-module (srfi srfi-9) - :use-module (srfi srfi-19) - :use-module (srfi srfi-19 setters) - :use-module (srfi srfi-19 util) + :use-module (srfi srfi-19 alt) + ;; :use-module (srfi srfi-19 setters) + :use-module (srfi srfi-19 alt util) + :use-module (srfi srfi-26) :use-module ((ice-9 rdelim) :select (read-line)) :use-module ((ice-9 textual-ports) :select (unget-char)) :use-module ((ice-9 ftw) :select (scandir ftw)) @@ -14,6 +15,7 @@ :use-module (util strbuf) :use-module (vcomponent base) :use-module (vcomponent datetime) + :use-module (srfi srfi-19 alt util) ) (use-modules ((rnrs base) #:select (assert))) @@ -147,25 +149,27 @@ (when (and (eq? 'VEVENT (type component)) (not (attr component 'DTEND))) (set! (attr component 'DTEND) - (add-duration (attr component 'DTSTART) - (make-duration 3600)))) + (let ((start (attr component 'DTSTART))) + (if (date? start) + (date+ start (date day: 1)) + (datetime+ start (datetime time: (time hour: 1))))))) - (set! component (parent component)) - ] + (set! component (parent component))] [else ;; TODO repeated keys (let ((it (make-vline str (get-param-table ctx)))) ;; Type specific processing (case (get-line-key ctx) - [(DTSTART DTEND) - (with-vline-tz - it - ;; TODO many of these are way to low - (mod! (value it) (compose date->time-utc parse-datetime)))] - [(RECURRENCE-ID) - (with-vline-tz - it (mod! (value it) (compose date->time-utc parse-datetime)))]) + [(DTSTART DTEND RECURRENCE-ID) + + (let ((v (prop it 'VALUE))) + (mod! (value it) + (if (or (and=>> v car (cut string=? <> "DATE-TIME")) + (string-contains (value it) "T")) + parse-datetime parse-date)))] + + ) ;; From RFC 5545 ยง3.6.1 @@ -298,7 +302,7 @@ row ~a column ~a ctx = ~a (set! (attr head 'X-HNH-ALTERNATIVES) (sort*! rest ;; HERE - time<? (extract 'RECURRENCE-ID))) + date/-time< (extract 'RECURRENCE-ID))) (add-child! calendar head))]) ;; return diff --git a/module/vcomponent/recurrence/parse.scm b/module/vcomponent/recurrence/parse.scm index 680a818e..f532987a 100644 --- a/module/vcomponent/recurrence/parse.scm +++ b/module/vcomponent/recurrence/parse.scm @@ -4,10 +4,9 @@ #:export (parse-recurrence-rule) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-19) ; Datetime - #:use-module (srfi srfi-19 util) + #:use-module (srfi srfi-19 alt) ; Datetime + #:use-module (srfi srfi-19 alt util) #:use-module (srfi srfi-26) - #:use-module ((vcomponent datetime) #:select (parse-datetime)) #:use-module (vcomponent recurrence internal) #:use-module (util) #:use-module (ice-9 match)) @@ -50,7 +49,7 @@ (let* (((key val) kv)) (let-lazy ((symb (string->symbol val)) - (date (date->time-utc (parse-datetime val))) + (date (parse-datetime val)) (days (map parse-day-spec (string-split val #\,))) (num (string->number val)) (nums (map string->number (string-split val #\,)))) |