Add let-env.

3 files changed, 43 insertions, 42 deletions

diff --git a/module/util.scm b/module/util.scm
index 707cba90..0d4d20d6 100644
--- a/module/util.scm
+++ b/module/util.scm
@@ -12,7 +12,7 @@
                 re-export-modules
                 use-modules*
                 -> set aif
-                tree-map let-lazy)
+                tree-map let-lazy let-env)
   #:replace (let* set! define-syntax
                   when unless if))
 
@@ -374,3 +374,17 @@
     [(set (acc obj) = (op rest ...))
      (set-fields
       obj ((acc) (op (acc obj) rest ...)))]))
+
+
+
+;; TODO multiple values
+(define-syntax let-env
+  (syntax-rules ()
+    [(_ ((name value))
+        body ...)
+     (let ((sname (symbol->string (quote name))))
+      (let ((ogenv (getenv sname)))
+        (setenv sname value)
+        (let ((return (begin body ...)))
+          (setenv sname ogenv)
+          return)))]))
diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index c1ee0e23..bda9d58c 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -23,42 +23,36 @@
   "Parse all start times into scheme date objects."
 
   (for ev in (filter (lambda (o) (eq? 'VEVENT (type o))) (children cal))
-       (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))
+       (let-env ((TZ (and=> (prop (attr* ev 'DTSTART) 'TZID) car)))
+                (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))])))
+                     (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))
+                  (set! (value dptr) (date->time-utc date)
+                        (value eptr) (date->time-utc end-date))
 
-           (when (prop (attr* ev 'DTSTART) 'TZID)
-             ;; Re-align date to have correect timezone. This is since time->date gives
-             ;; correct, but the code above may (?) fail to update the timezone.
-             (set! (zone-offset date) (zone-offset (time-utc->date (value dptr)))
-                   (value dptr) (date->time-utc date)
+                  (when (prop (attr* ev 'DTSTART) 'TZID)
+                    ;; Re-align date to have correect timezone. This is since time->date gives
+                    ;; correct, but the code above may (?) fail to update the timezone.
+                    (set! (zone-offset date) (zone-offset (time-utc->date (value dptr)))
+                          (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))))
+                          ;; 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)))))))
 
 
 (define* (parse-calendar path)
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
index 50ce83e5..3988141c 100644
--- a/module/vcomponent/recurrence/generate.scm
+++ b/module/vcomponent/recurrence/generate.scm
@@ -44,13 +44,8 @@
 ;; Specifically, 23h or 25h when going between summer and "normal" time.
 
 (define (next-event ev r)
-  (let ((e (copy-vcomponent ev))
-        (tz (getenv "TZ")))
-    ;; (setenv "TZ" (car (prop (attr* e 'DTSTART) 'TZID)))
-    (aif (prop (attr* e 'DTSTART) 'TZID)
-         (setenv "TZ" (car it))
-         ;; Should missing be this, or explicitly GMT?
-         (unsetenv "TZ"))
+  (let ((e (copy-vcomponent ev)))
+    (let-env ((TZ (and=> (prop (attr* e 'DTSTART) 'TZID) car))))
 
     (let ((d (time-utc->date (attr e 'DTSTART)))
           (i (interval r)))
@@ -72,8 +67,6 @@
       (set! (attr e 'DTEND)
         (add-duration (attr e 'DTSTART) (attr e 'DURATION))))
 
-    (setenv "TZ" tz)
-
     e))
 
 #;