diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2019-04-23 18:03:49 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-04-23 18:03:49 +0200 |
commit | 8f4fbcd493e28c86c598efcecdb6dc79d8fe0bfe (patch) | |
tree | 37e49d78df0916efcb0d547e0b28b63247cfec3d /module/vcomponent/timezone.scm | |
parent | Change event-length => event-length/day. (diff) | |
download | calp-8f4fbcd493e28c86c598efcecdb6dc79d8fe0bfe.tar.gz calp-8f4fbcd493e28c86c598efcecdb6dc79d8fe0bfe.tar.xz |
Rename module vcalendar => vcomponent.
Diffstat (limited to 'module/vcomponent/timezone.scm')
-rw-r--r-- | module/vcomponent/timezone.scm | 88 |
1 files changed, 88 insertions, 0 deletions
diff --git a/module/vcomponent/timezone.scm b/module/vcomponent/timezone.scm new file mode 100644 index 00000000..5b262f1c --- /dev/null +++ b/module/vcomponent/timezone.scm @@ -0,0 +1,88 @@ +(define-module (vcomponent timezone) + :use-module (vcomponent) + :use-module ((srfi srfi-1) :select (find)) + :use-module (srfi srfi-19) + :use-module (srfi srfi-19 util) + :use-module (srfi srfi-41) + :use-module (srfi srfi-41 util) + :use-module (util) + :use-module ((vcomponent recurrence generate) :select (generate-recurrence-set)) + :use-module ((vcomponent datetime) :select (ev-time<?)) + ) + +;;@begin exampe +;; <VTIMEZONE> :: "#<vcomponent 558c5da80fc0>" +;; TZID: Europe/Stockholm +;; X-LIC-LOCATION: Europe/Stockholm +;; : <DAYLIGHT> :: "#<vcomponent 558c5e11e7c0>" +;; : RRULE: FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU +;; : DTSTART: 19700329T020000 +;; : TZNAME: CEST +;; : TZOFFSETTO: +0200 +;; : TZOFFSETFROM: +0100 +;; : <STANDARD> :: "#<vcomponent 558c5e11e7e0>" +;; : RRULE: FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU +;; : DTSTART: 19701025T030000 +;; : TZNAME: CET +;; : TZOFFSETTO: +0100 +;; : 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, +;; as long as noone has multiple overlapping timezones, which depend on some +;; further condition. That feels like something that should be impossible, but +;; this is (human) time we are talking about. +(define-public (make-tz-set tz) + (let ((strm (interleave-streams + ev-time<? + ;; { DAYLIGHT, STANDARD } + (map generate-recurrence-set (children tz))))) + + (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))) + ((primitive-eval (symbol pm)) + (+ (* 60 (string->number (list->string (list m1 m0)))) + (* 60 60 (string->number (list->string (list h1 h0)))))))) + +;; Finds the VTIMEZONE with id @var{tzid} in calendar. +;; Crashes on error. +(define (find-tz cal tzid) + (let ((ret (find (lambda (tz) (string=? tzid (attr tz 'TZID))) + (children cal 'VTIMEZONE)))) + ret)) + +;; Takes a VEVENT. +;; Assumes that DTSTART has a TZID property, and that that TZID is available as +;; a direct child of the parent of @var{ev}. +(define-public (get-tz-offset ev) + (let ((ret (stream-find + (lambda (z) + (let* (((start end) (map (extract 'DTSTART) z))) + (and (time<=? start (attr ev 'DTSTART)) + (time<? (attr ev 'DTSTART) end)))) + (attr (find-tz (parent ev) + (car (prop (attr* ev 'DTSTART) 'TZID))) + 'X-HNH-TZSET)))) + (if (not ret) + 0 (parse-offset (attr (car ret) 'TZOFFSETTO))))) + |