diff options
| -rw-r--r-- | module/vcalendar.scm | 40 | ||||
| -rw-r--r-- | module/vcalendar/recurrence/generate.scm | 56 | ||||
| -rw-r--r-- | module/vcalendar/timezone.scm | 23 |
3 files changed, 68 insertions, 51 deletions
diff --git a/module/vcalendar.scm b/module/vcalendar.scm index 2b664b56..a45e54a2 100644 --- a/module/vcalendar.scm +++ b/module/vcalendar.scm @@ -6,6 +6,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (srfi srfi-19 util) + #:use-module (srfi srfi-19 setters) #:use-module (srfi srfi-26) #:use-module ((ice-9 optargs) #:select (define*-public)) #:use-module (util) @@ -23,28 +24,23 @@ (define (parse-dates! cal) "Parse all start times into scheme date objects." - (for-each-in (children cal 'VTIMEZONE) - (lambda (tz) - (for-each (lambda (p) (mod! (attr p "DTSTART") string->time-utc)) - (children tz)) - - ;; TZSET is the generated recurrence set of a timezone - (set! (attr tz 'X-HNH-TZSET) - (make-tz-set tz)))) - - (for-each - (lambda (ev) - (mod! (attr ev "DTSTART") string->time-utc - (attr ev "DTEND") string->time-utc) - - (when (prop (attr* ev 'DTSTART) 'TZID) - (let* ((of (get-tz-offset ev))) - (set! (prop (attr* ev 'DTSTART) 'TZID) #f) - ;; 5545 says that DTEND is local time iff DTSTART is local time. - ;; But who says that will be true... - (mod! (attr ev 'DTSTART) - (cut subtract-duration <> (make-duration of)))))) - (children cal 'VEVENT)) + (for tz in (children cal 'VTIMEZONE) + (for-each (lambda (p) (mod! (attr p "DTSTART") string->time-utc)) + (children tz)) + + ;; TZSET is the generated recurrence set of a timezone + (set! (attr tz 'X-HNH-TZSET) + (make-tz-set tz))) + + (for ev in (children cal 'VEVENT) + (define date (parse-datetime (attr ev 'DTSTART))) + + (mod! (attr ev "DTEND") string->time-utc) + (set! (attr ev "DTSTART") (date->time-utc date)) + + (when (prop (attr* ev 'DTSTART) 'TZID) + (set! (zone-offset date) (get-tz-offset ev) + (attr ev 'DTSTART) (date->time-utc date)))) ;; Return cal) diff --git a/module/vcalendar/recurrence/generate.scm b/module/vcalendar/recurrence/generate.scm index 2a5cfc91..3baaa6eb 100644 --- a/module/vcalendar/recurrence/generate.scm +++ b/module/vcalendar/recurrence/generate.scm @@ -8,6 +8,7 @@ #:use-module (util) #:use-module (vcalendar) + #:use-module (vcalendar timezone) #:use-module (vcalendar recurrence internal) #:use-module (vcalendar recurrence parse) @@ -39,32 +40,37 @@ ((WEEKLY) (* 60 60 24 7)))) ;; Event x Rule → Event +;; TODO My current naïve aproach to simple adding a constant time to an event +;; breaks with time-zones. betwen 12:00 two adjacent days might NOT be 24h. +;; Specifically, 23h or 25h when going between summer and "normal" time. (define (next-event ev r) - (let ((e (copy-vcomponent ev))) - (cond - ((memv (freq r) '(SECONDLY MINUTELY HOURLY DAILY WEEKLY)) - (mod! (attr e 'DTSTART) - ;; Previously I had the mutating version of - ;; @var{add-duration(!)} here. However since - ;; @var{copy-vcomponent} doesn't do a deep copy that - ;; modified the attribute for all items in the set, - ;; breaking everything. - (cut add-duration <> - (make-duration - (* (interval r) ; INTERVAL - (seconds-in (freq r))))))) - - ((memv (freq r) '(MONTHLY YEARLY)) - (let ((sdate (time-utc->date (attr e 'DTSTART)))) - (case (freq r) - ((MONTHLY) (mod! (month sdate) (cut + <> (interval r)))) - ((YEARLY) (mod! (year sdate) (cut + <> (interval r))))) - (set! (attr e 'DTSTART) - (date->time-utc sdate)))) - - ;; TODO - ;; All the BY... fields - ) + (let* ((e (copy-vcomponent ev)) + (d (time-utc->date + (attr e 'DTSTART) + (if (prop (attr* ev 'DTSTART) 'TZID) + (get-tz-offset e) + 0)))) + + (let ((i (interval r))) + (case (freq r) + ((SECONDLY) (mod! (second d) = (+ i))) + ((MINUTELY) (mod! (minute d) = (+ i))) + ((HOURLY) (mod! (hour d) = (+ i))) + ((DAILY) (mod! (day d) = (+ i))) + ((WEEKLY) (mod! (day d) = (+ (* i 7)))) + ((MONTHLY) (mod! (month d) = (+ i))) + ((YEARLY) (mod! (year d) = (+ i))))) + + (set! (attr e 'DTSTART) + (date->time-utc d)) + + (when (prop (attr* e 'DTSTART) 'TZID) + (let ((of (get-tz-offset e))) + ;; This addition works, but we still get lunch at 13 + (set! (zone-offset d) of))) + + (set! (attr e 'DTSTART) + (date->time-utc d)) (when (attr e 'DTEND) (set! (attr e 'DTEND) diff --git a/module/vcalendar/timezone.scm b/module/vcalendar/timezone.scm index 82d13a8d..560289d4 100644 --- a/module/vcalendar/timezone.scm +++ b/module/vcalendar/timezone.scm @@ -6,7 +6,7 @@ :use-module (srfi srfi-41) :use-module (srfi srfi-41 util) :use-module (util) - :use-module ((vcalendar recur) :select (generate-recurrence-set)) + :use-module ((vcalendar recurrence generate) :select (generate-recurrence-set)) :use-module ((vcalendar datetime) :select (ev-time<?)) ) @@ -28,6 +28,16 @@ ;; : TZOFFSETFROM: +0200 ;; @end example +;; Given a tz stream of length 2, takes the time difference between the DTSTART +;; of those two. And creates a new VTIMEZONE with that end time. +;; TODO set remaining properties, and type of the newly created component. +(define (extrapolate-tz-stream strm) + (let ((nevent (copy-vcomponent (stream-ref strm 1)))) + (mod! (attr nevent 'DTSTART) + = (add-duration (time-difference + (attr (stream-ref strm 1) 'DTSTART) + (attr (stream-ref strm 0) 'DTSTART)))) + (stream-append strm (stream nevent)))) ;; The RFC requires that at least one DAYLIGHT or STANDARD component is present. ;; Any number of both can be present. This should handle all these cases well, @@ -39,9 +49,14 @@ ev-time<? ;; { DAYLIGHT, STANDARD } (map generate-recurrence-set (children tz))))) - (if (stream-null? strm) - stream-null - (stream-zip strm (stream-cdr strm))))) + + (cond [(stream-null? strm) stream-null] + + [(stream-null? (stream-drop 2 strm)) + (let ((strm (extrapolate-tz-stream strm))) + (stream-zip strm (stream-cdr strm)))] + + [else (stream-zip strm (stream-cdr strm))]))) (define (parse-offset str) (let* (((pm h1 h0 m1 m0) (string->list str))) |