Popups are now correcetly rooted.

3 files changed, 28 insertions, 8 deletions

diff --git a/module/html/view/calendar.scm b/module/html/view/calendar.scm
index 2371cfe0..52e42078 100644
--- a/module/html/view/calendar.scm
+++ b/module/html/view/calendar.scm
@@ -97,6 +97,10 @@
 
 (define repo-url (make-parameter "https://git.hornquist.se"))
 
+
+;; TODO document what @var{render-calendar} is supposed to take and return.
+;; Can at least note that @var{render-calendar} is strongly encouraged to include
+;; (script "const VIEW='??';"), where ?? is replaced by the name of the view.
 (define*-public (html-generate
                  key:
                  (intervaltype 'all)    ; 'week | 'month | 'all
@@ -179,10 +183,11 @@
                               next-start: next-start
                               prev-start: prev-start
                               )
-
-           ,@(for event in (stream->list
-                            (events-between pre-start post-end events))
-                  (popup event (string-append "popup" (html-id event)))))
+           ;; Popups used to be here, but was moved into render-calendar so each
+           ;; sub-view can itself decide where to put them. This is important
+           ;; since they need to be placed as children to the scrolling
+           ;; component, if one such component exists.
+           )
 
           ;; Page footer
           (footer
diff --git a/module/html/view/calendar/month.scm b/module/html/view/calendar/month.scm
index 9288fd1a..99640a22 100644
--- a/module/html/view/calendar/month.scm
+++ b/module/html/view/calendar/month.scm
@@ -35,7 +35,8 @@
                    (events-between s e (list->stream long-events)))))
          (date-range pre-start post-end (date day: 7))))
 
-  `((header (@ (class "table-head"))
+  `((script "const VIEW='month';")
+    (header (@ (class "table-head"))
             ,(string-titlecase (date->string start-date "~B ~Y")))
     (div (@ (class "caltable")
             (style "grid-template-rows: 2em"
@@ -74,7 +75,14 @@
                       ,@(map make-small-block (stream->list events)))))
              short-event-groups
              (repeating-naturals 1 7)
-             )))))
+             )))
+
+    ;; These popups are relative the document root. Can thus be placed anywhere in the DOM.
+    ,@(for event in (stream->list
+                     (events-between start-date end-date events))
+           ((@ (html vcomponent) popup) event
+            (string-append "popup" ((@ (html util) html-id) event))))
+    ))
 
 
 
diff --git a/module/html/view/calendar/week.scm b/module/html/view/calendar/week.scm
index 7da186e1..34e8eeb4 100644
--- a/module/html/view/calendar/week.scm
+++ b/module/html/view/calendar/week.scm
@@ -22,7 +22,8 @@
 (define*-public (render-calendar key: events start-date end-date #:allow-other-keys)
   (let* ((long-events short-events (partition long-event? (stream->list (events-between start-date end-date events))))
          (range (date-range start-date end-date)))
-    `((div (@ (class "calendar"))
+    `((script "const VIEW='week';")
+      (div (@ (class "calendar"))
            (div (@ (class "days"))
                 ,@(time-marker-div)
                 (div (@ (class "longevents event-container")
@@ -41,7 +42,13 @@
                    (stream-map
                     lay-out-day
                     (get-groups-between (group-stream (list->stream short-events))
-                                        start-date end-date))))))))
+                                        start-date end-date)))
+
+                ,@(for event in (stream->list
+                                 (events-between start-date end-date events))
+                       ((@ (html vcomponent ) popup) event (string-append "popup" (html-id event))))
+
+                )))))