From 802f8a5d482e73785127dd7c560a68972c355c3f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Sun, 3 May 2020 11:42:01 +0200
Subject: [today] and [jump to] now works without JS.

---
 module/entry-points/server.scm | 28 +++++++++++++++++++++++-----
 module/output/html.scm         | 22 +++++++++++-----------
 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))
-- 
cgit v1.2.3