diff options
Diffstat (limited to '')
-rw-r--r-- | module/vcomponent.scm | 80 |
1 files changed, 46 insertions, 34 deletions
diff --git a/module/vcomponent.scm b/module/vcomponent.scm index 871ac2e7..add08775 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -26,6 +26,7 @@ (define (parse-dates! cal) "Parse all start times into scheme date objects." + #; (for tz in (filter (lambda (o) (eq? 'VTIMEZONE (type o))) (children cal)) (for-each (lambda (p) (mod! (attr p "DTSTART") string->time-utc)) (children tz)) @@ -35,32 +36,45 @@ (make-tz-set tz))) (for ev in (filter (lambda (o) (eq? 'VEVENT (type o))) (children cal)) - (define dptr (attr* ev 'DTSTART)) - (define eptr (attr* ev 'DTEND)) - - (define date (parse-datetime (value dptr))) - (define end-date - (cond ;; [(attr ev 'DURATION) => (lambda (d) (add-duration ...))] - [(not eptr) - (let ((d (set (date-hour date) = (+ 1)))) - (set! (attr ev 'DTEND) d - eptr (attr* ev 'DTEND)) - d)] - [(value eptr) => parse-datetime] - [else - (set (date-hour date) = (+ 1))])) - - (set! (value dptr) (date->time-utc date) - (value eptr) (date->time-utc end-date)) - - (when (prop (attr* ev 'DTSTART) 'TZID) - (set! (zone-offset date) (get-tz-offset ev) - (value dptr) (date->time-utc date) - - ;; The standard says that DTEND must have the same - ;; timezone as DTSTART. Here we trust that blindly. - (zone-offset end-date) (zone-offset date) - (value eptr) (date->time-utc end-date))))) + (let ((tz (getenv "TZ"))) + (aif (prop (attr* ev 'DTSTART) 'TZID) + (setenv "TZ" (car it)) + (unsetenv "TZ")) + (let* + ((dptr (attr* ev 'DTSTART)) + (eptr (attr* ev 'DTEND)) + + (date (parse-datetime (value dptr))) + (end-date + (cond ;; [(attr ev 'DURATION) => (lambda (d) (add-duration ...))] + [(not eptr) + (let ((d (set (date-hour date) = (+ 1)))) + (set! (attr ev 'DTEND) d + eptr (attr* ev 'DTEND)) + d)] + [(value eptr) => parse-datetime] + [else + (set (date-hour date) = (+ 1))]))) + + (set! (value dptr) (date->time-utc date) + (value eptr) (date->time-utc end-date)) + + (when (prop (attr* ev 'DTSTART) 'TZID) + ;; (format (current-error-port) "date = ~a~%" date) + (set! (zone-offset date) (zone-offset (time-utc->date (value dptr)))) + ;; (format (current-error-port) "date = ~a~%" date) + ;; set! (zone-offset date) (get-tz-offset ev) + + (set! + (value dptr) (date->time-utc date) + + ;; The standard says that DTEND must have the same + ;; timezone as DTSTART. Here we trust that blindly. + (zone-offset end-date) (zone-offset date) + (value eptr) (date->time-utc end-date)))) + + + (setenv "TZ" tz)))) (define* (parse-calendar path) @@ -97,14 +111,12 @@ (for component in (children cal) (case (type component) ((VTIMEZONE) - (set! tz (cons component tz)) - #; - (unless (find (lambda (z) - (string=? (attr z "TZID") - (attr component "TZID"))) - (filter (lambda (o) (eq? 'VTIMEZONE (type o))) - (children accum))) - (add-child! accum component))) + ;; (set! tz (cons component tz)) + (unless (find (lambda (o) (and (eq? 'VTIMEZONE (type o)) + (string=? (attr o "TZID") + (attr component "TZID")))) + (children accum)) + (add-child! accum component))) ((VEVENT) (add-child! accum component) ) |