diff options
Diffstat (limited to '')
-rw-r--r-- | vcalendar.scm | 49 | ||||
-rw-r--r-- | vcalendar/datetime.scm | 4 | ||||
-rw-r--r-- | vcalendar/recur.scm | 17 |
3 files changed, 48 insertions, 22 deletions
diff --git a/vcalendar.scm b/vcalendar.scm index 1bf0a1bb..03817957 100644 --- a/vcalendar.scm +++ b/vcalendar.scm @@ -1,27 +1,38 @@ (define-module (vcalendar) #:use-module (vcalendar primitive) + #:use-module (vcalendar datetime) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26)) + #:use-module (srfi srfi-26) + #:use-module (util)) + +(define (parse-dates! cal) +;;; Parse all start times into scheme date objects. + (for-each-in (children cal 'VEVENT) + (lambda (ev) + (transform-attr! ev "DTSTART" parse-datetime) + (transform-attr! ev "DTEND" parse-datetime))) + cal) (define-public (make-vcomponent path) - (if (string-ci=? ".ics" (string-take-right path 4)) - ;; == Single ICS file == - ;; Remove the abstract ROOT component, - ;; returning the wanted VCALENDAR component - (car (%vcomponent-children - (%vcomponent-make path))) - ;; == Assume vdir == - ;; Also removes the abstract ROOT component, but also - ;; merges all VCALENDAR's children into the first - ;; VCALENDAR, and return that VCALENDAR. - ;; - ;; TODO the other VCALENDAR components might not get thrown away, - ;; this since I protect them from the GC in the C code. - (reduce (lambda (cal accum) - (for-each (cut %vcomponent-push-child! accum <>) - (%vcomponent-children cal)) - accum) - '() (%vcomponent-children (%vcomponent-make path))))) + (parse-dates! + (if (string-ci=? ".ics" (string-take-right path 4)) + ;; == Single ICS file == + ;; Remove the abstract ROOT component, + ;; returning the wanted VCALENDAR component + (car (%vcomponent-children + (%vcomponent-make path))) + ;; == Assume vdir == + ;; Also removes the abstract ROOT component, but also + ;; merges all VCALENDAR's children into the first + ;; VCALENDAR, and return that VCALENDAR. + ;; + ;; TODO the other VCALENDAR components might not get thrown away, + ;; this since I protect them from the GC in the C code. + (reduce (lambda (cal accum) + (for-each (cut %vcomponent-push-child! accum <>) + (%vcomponent-children cal)) + accum) + '() (%vcomponent-children (%vcomponent-make path)))))) (define-public (type-filter t lst) (filter (lambda (e) (eqv? t (type e))) diff --git a/vcalendar/datetime.scm b/vcalendar/datetime.scm index af8382c8..9f47f5c3 100644 --- a/vcalendar/datetime.scm +++ b/vcalendar/datetime.scm @@ -7,7 +7,9 @@ (define (parse-datetime dtime) "Parse the given date[time] string into a date object." - (localize-date + ;; localize-date + + (date->time-utc (string->date dtime (case (string-length dtime) diff --git a/vcalendar/recur.scm b/vcalendar/recur.scm index a480d946..23c00b12 100644 --- a/vcalendar/recur.scm +++ b/vcalendar/recur.scm @@ -126,9 +126,17 @@ (match rule (($ <recur-rule> freq until count interval bysecond byminute byhour wkst) (case freq - ((WEEKLY) (transform-attr! new-event "DTSTART" (cut date-add <> 1 weeks)) + ((WEEKLY) + (transform-attr! new-event "DTSTART" (cut time-add <> 1 weeks)) + (set! (attr new-event "DTEND") + (add-duration (attr new-event "DTSTART") + (attr new-event "DURATION"))) (values new-event rule)) - ((DAILY) (transform-attr! new-event "DTSTART" (cut date-add <> 1 days)) + ((DAILY) + (transform-attr! new-event "DTSTART" (cut time-add <> 1 days)) + (set! (attr new-event "DTEND") + (add-duration (attr new-event "DTSTART") + (attr new-event "DURATION"))) (values new-event rule)) (else (values '() rule)))) (_ (values event rule))))) @@ -142,6 +150,11 @@ (recur-event-stream next-event next-rule))))) (define (recur-event event) + (unless (attr event "DURATION") + (set! (attr event "DURATION") + (time-difference + (attr event "DTEND") + (attr event "DTSTART")))) (recur-event-stream event (build-recur-rules (get-attr event "RRULE")))) (define tzero (make-time time-utc 0 0)) |