From 72792b048e6bbdd06ba3c775c8b870d64dcd856d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Sun, 26 Apr 2020 18:50:41 +0200
Subject: Sidebar event code now reusable for popups.

---
 module/output/html.scm | 51 ++++++++++++++++++++++++++++++--------------------
 1 file changed, 31 insertions(+), 20 deletions(-)

(limited to 'module/output')

diff --git a/module/output/html.scm b/module/output/html.scm
index bc8eefae..3cf110da 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -128,6 +128,9 @@
 
 
 (define (event-debug-html event)
+  `(div (@ (class "eventlist"))
+        ,(fmt-single-event event))
+  #;
   `(table
     (tbody
      ,@(hash-map->list
@@ -364,18 +367,20 @@
 
 
 ;; For sidebar, just text
-(define (fmt-single-event ev)
+(define* (fmt-single-event ev
+                           optional: (attributes '())
+                           key: (fmt-header list))
   ;; (format (current-error-port) "fmt-single-event: ~a~%" (attr ev 'X-HNH-FILENAME))
-  `(article (@ (id ,(UID ev))
-               (class "eventtext CAL_bg_"
-                 ,(html-attr (or (attr (parent ev) 'NAME) "unknown"))
-                 ,(when (and (attr ev 'PARTSTAT) (string= "TENTATIVE" (attr ev 'PARTSTAT)))
-                    " tentative")))
-            (h3 (a (@ (href "#" ,(date-link (as-date (attr ev 'DTSTART))))
-                      (class "hidelink"))
-                   ,(when (attr ev 'RRULE)
-                      `(span (@ (class "repeating")) "↺"))
-                   ,(attr ev 'SUMMARY)))
+  `(article (@ ,@(assq-merge
+                  attributes
+                  `((class "eventtext CAL_bg_"
+                      ,(html-attr (or (attr (parent ev) 'NAME) "unknown"))
+                      ,(when (and (attr ev 'PARTSTAT) (string= "TENTATIVE" (attr ev 'PARTSTAT)))
+                         " tentative")))))
+            (h3 ,(fmt-header
+                  (when (attr ev 'RRULE)
+                    `(span (@ (class "repeating")) "↺"))
+                  (attr ev 'SUMMARY)))
             (div
              ,(call-with-values (lambda () (fmt-time-span ev))
                 (match-lambda* [(start end) `(div ,start " — " ,end)]
@@ -401,15 +406,21 @@
                              `(a (@ (href "#" ,s)
                                     (class "hidelink")) ,s))))
               ,@(stream->list
-                 (stream-map fmt-single-event
-                             (stream-filter
-                              (lambda (ev)
-                                ;; If start was an earlier day
-                                ;; This removes all descriptions from
-                                ;; events for previous days,
-                                ;; solving duplicates.
-                                (date/-time<=? date (attr ev 'DTSTART)))
-                              events))))))
+                 (stream-map
+                  (lambda (ev) (fmt-single-event
+                           ev `((id ,(UID ev)))
+                           fmt-header: (lambda body
+                                         `(a (@ (href "#" ,(date-link (as-date (attr ev 'DTSTART))))
+                                                (class "hidelink"))
+                                             ,@body))))
+                  (stream-filter
+                   (lambda (ev)
+                     ;; If start was an earlier day
+                     ;; This removes all descriptions from
+                     ;; events for previous days,
+                     ;; solving duplicates.
+                     (date/-time<=? date (attr ev 'DTSTART)))
+                   events))))))
 
 
 ;;; Table output
-- 
cgit v1.2.3