From 3f2ad7c6a7ff95693c0cf64f72ed95bb6adb3521 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Mon, 27 Apr 2020 17:06:31 +0200
Subject: Minor updates.

---
 TODO                   |   3 --
 module/output/html.scm | 135 ++++++++++++++++++++++++++-----------------------
 static/style.css       |   5 ++
 tests/run-tests.scm    |  10 ++--
 4 files changed, 82 insertions(+), 71 deletions(-)

diff --git a/TODO b/TODO
index c0d8f5a1..b98964e1 100644
--- a/TODO
+++ b/TODO
@@ -44,9 +44,6 @@ Handle systems with bad `cal' programs
 HTML
 ====
 
-Popups i månadsvy
------------------
-
 Placering av popups
 -------------------
 
diff --git a/module/output/html.scm b/module/output/html.scm
index 1a60549a..45666ae8 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -393,11 +393,15 @@
                 (match-lambda* [(start end) `(div ,start " — " ,end)]
                                [(start) `(div ,start)]))
              ,(when (and=> (attr ev 'LOCATION) (negate string-null?))
-                `(div (b "Plats: ") (div (@ (class "location")),(string-map (lambda (c) (if (char=? c #\,) #\newline c)) (attr ev 'LOCATION)))))
-             ,(and=> (attr ev 'DESCRIPTION) (lambda (str) (catch #t (lambda () ((get-config 'description-filter) ev str))
-                                                       (lambda (err . args)
-                                                         (warning "~a on formatting description, ~s" err args)
-                                                         str))))
+                `(div (b "Plats: ")
+                      (div (@ (class "location"))
+                           ,(string-map (lambda (c) (if (char=? c #\,) #\newline c))
+                                        (attr ev 'LOCATION)))))
+             ,(and=> (attr ev 'DESCRIPTION)
+                     (lambda (str) (catch #t (lambda () ((get-config 'description-filter) ev str))
+                                (lambda (err . args)
+                                  (warning "~a on formatting description, ~s" err args)
+                                  str))))
              ,(awhen (attr ev 'RRULE)
                      (format-recurrence-rule ev))
              ,(when (attr ev 'LAST-MODIFIED)
@@ -517,9 +521,11 @@
                     next-start
                     prev-start)
   (define (td date)
+    ;; TODO make entrire cell clickable
     `(td (@ (class
               ,(when (date< date start-date) "prev ")
               ,(when (date< end-date date) "next "))
+            ;; TODO <time> tag here instead
             (id ,(date->string date "td-~Y-~m-~d"))
             )
          (a (@ (href ,(cond
@@ -676,64 +682,67 @@
                 (details (@ (open) (style "grid-area: cal"))
                          (summary "Month overwiew")
                          (div (@ (class "smallcall-head")) ,(string-titlecase (date->string start-date "~B ~Y")))
-                         (div (@ (class "smallcal"))
-                              ;; prev button
-                              ,(nav-link "«" (prev-start start-date))
-
-                              ;; calendar table
-                              ;; TODO
-                              (div ,(cal-table start-date: start-date end-date: end-date
-                                               next-start: next-start
-                                               prev-start: prev-start
-                                               ))
-
-                              ;; next button
-                              ,(nav-link "»" (next-start start-date))))
-
-
-                (div (@ (style "grid-area: details"))
-                     ;; TODO only include these sliders in debug builds
-                     (details (@ (class "sliders"))
-                              (summary "Option sliders")
-                              (label "Event blankspace")
-                              ,(slider-input
-                                variable: "editmode"
-                                min: 0
-                                max: 1
-                                step: 0.01
-                                value: 1)
-
-                              (label "Fontsize")
-                              ,(slider-input
-                                unit: "pt"
-                                min: 1
-                                max: 20
-                                step: 1
-                                value: 8
-                                variable: "event-font-size"))
-
-                     ;; List of calendars
-                     (details (@ (class "calendarlist")
-                                 #; (style "grid-area: details")
-                                 )
-                              (summary "Calendar list")
-                              (ul ,@(map (lambda (calendar)
-                                           `(li (@ (class "CAL_bg_" ,(html-attr (attr calendar 'NAME))))
-                                                ,(attr calendar 'NAME)))
-                                         calendars))))
-
-                ;; List of events
-                (div (@ (class "eventlist")
-                        (style "grid-area: events"))
-                     ;; Events which started before our start point, but "spill" into our time span.
-                     (section (@ (class "text-day"))
-                              (header (h2 "Tidigare"))
-                              ,@(stream->list
-                                 (stream-map fmt-single-event
-                                             (stream-take-while (compose (cut date/-time<? <> start-date)
-                                                                         (extract 'DTSTART))
-                                                                (cdr (stream-car evs))))))
-                     ,@(stream->list (stream-map fmt-day evs))))))))
+                         ;; NOTE it might be a good idea to put the navigation buttons
+                         ;; earlier in the DOM-tree/tag order. At least Vimium's
+                         ;; @key{[[} keybind sometimes finds parts of events instead.
+                           (div (@ (class "smallcal"))
+                                ;; prev button
+                                ,(nav-link "«" (prev-start start-date))
+
+                                ;; calendar table
+                                ;; TODO
+                                (div ,(cal-table start-date: start-date end-date: end-date
+                                                 next-start: next-start
+                                                 prev-start: prev-start
+                                                 ))
+
+                                ;; next button
+                                ,(nav-link "»" (next-start start-date))))
+
+
+                          (div (@ (style "grid-area: details"))
+                               ;; TODO only include these sliders in debug builds
+                               (details (@ (class "sliders"))
+                                        (summary "Option sliders")
+                                        (label "Event blankspace")
+                                        ,(slider-input
+                                          variable: "editmode"
+                                          min: 0
+                                          max: 1
+                                          step: 0.01
+                                          value: 1)
+
+                                        (label "Fontsize")
+                                        ,(slider-input
+                                          unit: "pt"
+                                          min: 1
+                                          max: 20
+                                          step: 1
+                                          value: 8
+                                          variable: "event-font-size"))
+
+                               ;; List of calendars
+                               (details (@ (class "calendarlist")
+                                           #; (style "grid-area: details")
+                                           )
+                                        (summary "Calendar list")
+                                        (ul ,@(map (lambda (calendar)
+                                                     `(li (@ (class "CAL_bg_" ,(html-attr (attr calendar 'NAME))))
+                                                          ,(attr calendar 'NAME)))
+                                                   calendars))))
+
+                          ;; List of events
+                          (div (@ (class "eventlist")
+                                  (style "grid-area: events"))
+                               ;; Events which started before our start point, but "spill" into our time span.
+                               (section (@ (class "text-day"))
+                                        (header (h2 "Tidigare"))
+                                        ,@(stream->list
+                                           (stream-map fmt-single-event
+                                                       (stream-take-while (compose (cut date/-time<? <> start-date)
+                                                                                   (extract 'DTSTART))
+                                                                          (cdr (stream-car evs))))))
+                               ,@(stream->list (stream-map fmt-day evs))))))))
 
 
 (define-public (html-chunked-main count calendars events start-date chunk-length)
diff --git a/static/style.css b/static/style.css
index 2cfa5f8a..fb2759df 100644
--- a/static/style.css
+++ b/static/style.css
@@ -615,6 +615,11 @@ along with their colors.
     overflow-y: auto;
 }
 
+.event-inner .popup .location {
+    font-style: initial;
+    /* font-size: initial; */
+}
+
 .popup .popup-control {
     display: flex;
     flex-direction: column;
diff --git a/tests/run-tests.scm b/tests/run-tests.scm
index ded94cc5..e01fcb0b 100755
--- a/tests/run-tests.scm
+++ b/tests/run-tests.scm
@@ -33,11 +33,11 @@
 ;; Load tests
 
 (define (read-multiple)
-(let loop ((done '()))
-  (let ((sexp (read)))
-    (if (eof-object? sexp)
-        (reverse done)
-        (loop (cons sexp done))))))
+  (let loop ((done '()))
+    (let ((sexp (read)))
+      (if (eof-object? sexp)
+          (reverse done)
+          (loop (cons sexp done))))))
 
 
 ;; TODO test-group fails if called before any test begin, since
-- 
cgit v1.2.3