blob: ed3bef6b79343ebbf1e9c0dc5f42e5c0ef233472 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
(define-module (vcomponent timezone)
:use-module (vcomponent base)
: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, extrapolates when the next timezone
;; change aught to be.
;; Currently it does so by taking the first time zone, and adding one
;; year. This kind of works.
;; Previously it took the difference between element 2 and 1, and added
;; that to the start of the secound time zone. This was even more wrong.
;; TODO? set remaining properties, and type of the newly created component.
(define (extrapolate-tz-stream strm)
(let ((nevent (copy-vcomponent (stream-car strm))))
(set! (attr nevent 'DTSTART)
(date->time-utc
(set (date-year
(time-utc->date (attr nevent 'DTSTART)))
= (+ 1))))
(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))])))
;; str ::= ±[0-9]{4}
;; str → int seconds
(define (parse-offset str)
(let* (((± h1 h0 m1 m0) (string->list str)))
((primitive-eval (symbol ±))
(+ (* 60 (string->number (string m1 m0)))
(* 60 60 (string->number (string 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)))
(filter (lambda (o) (eq? 'VTIMEZONE (type o)))
(children cal)))))
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)))))
|