diff options
-rw-r--r-- | module/datetime/app.scm | 10 | ||||
-rw-r--r-- | module/entry-points/server.scm | 8 | ||||
-rw-r--r-- | module/output/html.scm | 8 | ||||
-rw-r--r-- | module/output/ical.scm | 6 | ||||
-rw-r--r-- | module/util/app.scm | 10 | ||||
-rw-r--r-- | module/vcomponent.scm | 28 |
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)) |