Change call signature for [gs]etf.

6 files changed, 38 insertions, 32 deletions

diff --git a/module/datetime/app.scm b/module/datetime/app.scm
index 989a0847..9797ee39 100644
--- a/module/datetime/app.scm
+++ b/module/datetime/app.scm
@@ -5,12 +5,12 @@
   :use-module (datetime zic))
 
 (define-method (init-app)
-  (setf app 'zoneinfo
+  (setf 'zoneinfo
         (let* ((pipe
-               (-> (@ (global) basedir)
-                   dirname
-                   (string-append "/tzget")
-                   ((@ (ice-9 popen) open-input-pipe))))
+                (-> (@ (global) basedir)
+                    dirname
+                    (string-append "/tzget")
+                    ((@ (ice-9 popen) open-input-pipe))))
                (path (read-line pipe))
                (names (string-split (read-line pipe) #\space)))
           (read-zoneinfo
diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm
index 6a4558a6..3dab6e9c 100644
--- a/module/entry-points/server.scm
+++ b/module/entry-points/server.scm
@@ -64,8 +64,8 @@
           (return '((content-type text/html))
                   (with-output-to-string
                     (lambda ()
-                      (html-generate calendars: (getf app 'calendars)
-                                     events: (getf app 'event-set)
+                      (html-generate calendars: (getf 'calendars)
+                                     events: (getf 'event-set)
                                      start-date: start-date
                                      end-date: (date+ start-date (date day: 6))
                                      next-start: (lambda (d) (date+ d (date day: 7)))
@@ -79,8 +79,8 @@
           (return '((content-type text/html))
                   (with-output-to-string
                     (lambda ()
-                      (html-generate calendars: (getf app 'calendars)
-                                     events: (getf app 'event-set)
+                      (html-generate calendars: (getf 'calendars)
+                                     events: (getf 'event-set)
                                      start-date: start-date
                                      end-date: (date- (month+ start-date)
                                                       (date day: 1))
diff --git a/module/output/html.scm b/module/output/html.scm
index 740be7b9..702d229d 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -748,8 +748,8 @@
 
 (define-method (html-chunked-main count start-date chunk-length)
 
-  (define calendars (getf app 'calendars))
-  (define events (getf app 'event-set))
+  (define calendars (getf 'calendars))
+  (define events (getf 'event-set))
 
   ;; TODO This still doesn't account for PWD, file existing but is of
   ;; wrong type, html directory existing but static symlink missing,
@@ -786,8 +786,8 @@
 
 (define-method (html-table-main count start-date)
 
-  (define calendars (getf app 'calendars))
-  (define events (getf app 'event-set))
+  (define calendars (getf 'calendars))
+  (define events (getf 'event-set))
 
   ;; TODO same file creation as in html-chunked-main
   (stream-for-each
diff --git a/module/output/ical.scm b/module/output/ical.scm
index 8388bfc1..098d4e90 100644
--- a/module/output/ical.scm
+++ b/module/output/ical.scm
@@ -153,7 +153,7 @@
   (add-child! cal event)
 
   (awhen (prop (attr* event 'DTSTART) 'TZID)
-         (add-child! cal (zoneinfo->vtimezone (getf (current-app) 'zoneinfo) it)))
+         (add-child! cal (zoneinfo->vtimezone (getf 'zoneinfo) it)))
 
   (unless (attr event 'UID)
     (set! (attr event 'UID)
@@ -202,7 +202,7 @@ CALSCALE:GREGORIAN\r
   (let ((tz-names (get-tz-names events)))
     (for-each component->ical-string
               ;; TODO we realy should send the earliest event from each timezone here.
-              (map (lambda (name) (zoneinfo->vtimezone (getf (current-app) 'zoneinfo) name (car events)))
+              (map (lambda (name) (zoneinfo->vtimezone (getf 'zoneinfo) name (car events)))
                    tz-names)))
 
   (for-each component->ical-string events)
@@ -218,4 +218,4 @@ CALSCALE:GREGORIAN\r
            ;; We just dump all repeating objects, since it's much cheaper to do
            ;; it this way than to actually figure out which are applicable for
            ;; the given date range.
-           (getf (current-app) 'repeating-events))))
+           (getf 'repeating-events))))
diff --git a/module/util/app.scm b/module/util/app.scm
index 95df741a..e5b03b0f 100644
--- a/module/util/app.scm
+++ b/module/util/app.scm
@@ -26,18 +26,24 @@
             body ...))])))
 
 
-(define (getf app field)
+(define-method (getf field)
   (aif (hashq-ref (get-ht app) field)
        (force it)
        (error "No field" field)))
 
 (define-syntax setf%
   (syntax-rules ()
+    [(_ field value)
+     (setf% (current-app) field value)]
     [(_ app field value)
-     (hashq-set! (get-ht app) field (delay (begin value)))]))
+     (hashq-set! (get-ht app) field (delay value))]))
 
 (define-syntax setf
   (syntax-rules ()
+    ;; special case to use current appp)
+    [(_ key value)
+     (setf% key value)]
+
     [(_ app) app]
     [(_ app key value rest ...)
      (begin (setf% app key value)
diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index 83954f52..aaaf5d36 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -28,17 +28,17 @@
 
 
 (define-method (init-app calendar-files)
-  (setf app 'calendars (load-calendars calendar-files))
+  (setf 'calendars (load-calendars calendar-files))
 
-  (setf app 'events
+  (setf 'events
         (concatenate
          ;; TODO does this drop events?
          (map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o)))
                                (children cal)))
-              (getf app 'calendars))))
+              (getf 'calendars))))
 
-  (setf app 'fixed-and-repeating-events
-        (let* ((repeating regular (partition repeating? (getf app 'events))))
+  (setf 'fixed-and-repeating-events
+        (let* ((repeating regular (partition repeating? (getf 'events))))
 
           ;; (report-time! "Sorting")
           ;; NOTE There might be instances where we don't care if the
@@ -48,22 +48,22 @@
            (sort*! regular   date/-time<? (extract 'DTSTART))
            (sort*! repeating date/-time<? (extract 'DTSTART)))))
 
-  (setf app 'fixed-events (car (getf app 'fixed-and-repeating-events)))
-  (setf app 'repeating-events (cadr (getf app 'fixed-and-repeating-events)))
+  (setf 'fixed-events (car (getf 'fixed-and-repeating-events)))
+  (setf 'repeating-events (cadr (getf 'fixed-and-repeating-events)))
 
-  (setf app 'event-set (calculate-recurrence-set
-                        (getf app 'fixed-events)
-                        (getf app 'repeating-events)))
+  (setf 'event-set (calculate-recurrence-set
+                    (getf 'fixed-events)
+                        (getf 'repeating-events)))
 
-  (setf app 'uid-map
+  (setf 'uid-map
         (let ((ht (make-hash-table)))
-          (for-each (lambda (event) (hash-set! ht (attr event 'UID) event)) (getf app 'events))
+          (for-each (lambda (event) (hash-set! ht (attr event 'UID) event)) (getf 'events))
           ht)))
 
 (define-method (fixed-events-in-range start end)
   (filter-sorted (lambda (ev) ((in-date-range? start end)
                           (as-date (attr ev 'DTSTART))))
-                 (getf app 'fixed-events)))
+                 (getf 'fixed-events)))
 
 (define-method (get-event-by-uid uid)
-  (hash-ref (getf app 'uid-map) uid))
+  (hash-ref (getf 'uid-map) uid))