diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-05-03 11:42:01 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-05-03 11:42:01 +0200 |
| commit | 802f8a5d482e73785127dd7c560a68972c355c3f (patch) | |
| tree | e6c9e2efaf138727bd54b53fa72aeae2103ed01d | |
| parent | Whitespace fixup. (diff) | |
| download | calp-802f8a5d482e73785127dd7c560a68972c355c3f.tar.gz calp-802f8a5d482e73785127dd7c560a68972c355c3f.tar.xz | |
[today] and [jump to] now works without JS.
| -rw-r--r-- | module/entry-points/server.scm | 28 | ||||
| -rw-r--r-- | module/output/html.scm | 22 | ||||
| -rw-r--r-- | module/server/macro.scm | 3 |
3 files changed, 37 insertions, 16 deletions
diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm index 78eac835..689b220b 100644 --- a/module/entry-points/server.scm +++ b/module/entry-points/server.scm @@ -18,6 +18,7 @@ :use-module (web request) :use-module (web response) :use-module (web uri) + :use-module (web http) :use-module (sxml simple) @@ -99,13 +100,32 @@ intervaltype: 'month )))))) + ;; Get specific page by query string instead of by path. + ;; Useful for <form>'s, since they always submit in this form, but also + ;; useful when javascript is disabled, since a link to "today" needs some + ;; form of evaluation when clicked. + (GET "/today" (view date) + (define location + (parse-header 'location + (format #f "/~a/~a.html" + (or view "month") + (date->string + (cond [date => parse-iso-date] + [else (current-date)]) + "~1"))) ) + + (return (build-response + code: 302 + headers: `((location . ,location))) + "")) + ;; TODO export all events in interval (GET "/calendar" (start end) (return '((content-type text/calendar)) (with-output-to-string (lambda () - (ical-main (parse-iso-date start) - (parse-iso-date end)))))) + (ical-main (parse-iso-date start) + (parse-iso-date end)))))) ;; TODO this fails if there's a period in the uid. (GET "/calendar/:uid{.*}.ics" (uid) @@ -139,9 +159,7 @@ ;; (sleep 1) (return '((content-type text/plain)) (string-append (number->string state) "\n") - (1+ state))) - - )) + (1+ state))))) (define options '((port (value #t) (single-char #\p)) diff --git a/module/output/html.scm b/module/output/html.scm index a9f8fa5d..cbbc2498 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -686,21 +686,21 @@ ,(btn id: "today-button" href: (string-append - "/today" (case intervaltype - [(month) "/month"] - [(week) "/week"] - [else "/month"])) + "/today?" (case intervaltype + [(month) "view=month"] + [(week) "view=week"])) "idag")) (div (@ (class "jump-to")) - (form (@ (action ,(case intervaltype - [(month) "/month"] - [(week) "/week"] - [else "/month"]))) + (form (@ (action "/today")) + (input (@ (type hidden) + (name "view") + (value ,(case intervaltype + [(month week) => symbol->string] + [else "month"])))) (input (@ (type date) - (name "start-date") - (value (date->string start-date "~1")) - )) + (name "date") + (value (date->string start-date "~1")))) ,(btn "➔")))) (details (@ (open) (style "grid-area: cal")) diff --git a/module/server/macro.scm b/module/server/macro.scm index 28565c3b..ba70a484 100644 --- a/module/server/macro.scm +++ b/module/server/macro.scm @@ -45,7 +45,10 @@ ;; (assert ;; (= (1- (match:count match-object)) ;; (length intersect))) + + ;; Those parameters which were present in the template uri ((lambda ,intersect + ;; Those that only are in the query string (lambda* (,@(unless (null? diff) `(#:key ,@diff #:allow-other-keys)) #:rest rest) ,@body)) |