diff options
| -rw-r--r-- | module/srfi/srfi-19/alt.scm | 5 | ||||
| -rw-r--r-- | module/vcomponent/parse.scm | 23 | ||||
| -rw-r--r-- | module/vcomponent/recurrence/generate.scm | 2 |
3 files changed, 14 insertions, 16 deletions
diff --git a/module/srfi/srfi-19/alt.scm b/module/srfi/srfi-19/alt.scm index ec1144d2..26bb03af 100644 --- a/module/srfi/srfi-19/alt.scm +++ b/module/srfi/srfi-19/alt.scm @@ -544,12 +544,11 @@ minute: (s->n str 2 4) second: (s->n str 4 6))) -(define-public (parse-datetime str) +(define*-public (parse-datetime str optional: tz) (let* (((datestr timestr) (string-split str #\T))) (datetime date: (parse-date datestr) time: (parse-time timestr) - tz: (if (string=? "Z" (string-take-right str 1)) - 'Z #f)))) + tz: tz))) (define-public (current-date) diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm index 24becd13..979eea7b 100644 --- a/module/vcomponent/parse.scm +++ b/module/vcomponent/parse.scm @@ -163,18 +163,17 @@ (case (get-line-key ctx) [(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")) - (begin - (set! (prop it 'VALUE) "DATE-TIME") - parse-datetime) - (begin - (set! (prop it 'VALUE) "DATE") - parse-date))))] - - ) + ;; '("Africa/Ceuta" "Europe/Stockholm" "local") + (let ((tz (or (and=> (prop it 'TZID) car) + (and (string= "Z" (string-take-right (value it) 1)) "UTC")))) + + (let ((type (and=> (prop it 'VALUE) car))) + (if (or (and=> type (cut string=? <> "DATE-TIME")) + (string-contains (value it) "T")) + (set! (value it) (parse-datetime (value it) tz) + (prop it 'VALUE) 'DATE-TIME) + (set! (value it) (parse-date (value it)) + (prop it 'VALUE) 'DATE))))]) ;; From RFC 5545 ยง3.6.1 diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm index 087ce14e..f51759e0 100644 --- a/module/vcomponent/recurrence/generate.scm +++ b/module/vcomponent/recurrence/generate.scm @@ -165,7 +165,7 @@ (if (attr event "RRULE") (recur-event-stream event (parse-recurrence-rule (attr event "RRULE") - (if (string= "DATE" (and=> (prop (attr* event 'DTSTART) 'VALUE) car)) + (if (eq? 'DATE (and=> (prop (attr* event 'DTSTART) 'VALUE) car)) parse-date parse-datetime))) ;; TODO some events STANDARD and DAYLIGT doesn't have RRULE's, but rather ;; just mention the current part. Handle this |