From b01f3793f7205c1b3c89af40c469ad933282629d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Thu, 19 Mar 2020 16:31:27 +0100
Subject: Add relevant content to calendar table.

---
 module/output/html.scm | 42 +++++++++++++++++++++++++++++++++---------
 static/style.css       | 32 ++++++++++++++++++++++++++++++--
 2 files changed, 63 insertions(+), 11 deletions(-)

diff --git a/module/output/html.scm b/module/output/html.scm
index 5380d354..54ac7538 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -285,20 +285,44 @@
        (div (@ (class "days"))
             ,@(stream->list (stream-map lay-out-day event-groups)))))
 
-;; TODO this currently only popuplates the table with the number of events for
-;;      each day. It should show all the actual events.
+(define (make-small-block event)
+  `(a (@ (href "#" ,(UID event))
+         (class "hidelink"))
+      (div (@ (class "inline-event CAL_"
+                ,(html-attr (attr (parent event) 'NAME))))
+           ,((summary-filter) event (attr event 'SUMMARY)))))
+
 ;; (stream event-group) -> sxml
 (define (render-calendar-table event-groups)
   `(div (@ (class "caltable"))
         ,@(map (lambda (d) `(div (@ (class "thead")) ,(week-day-name d)))
                (weekday-list (week-start)))
-        ,@(stream->list
-           (stream-map
-            (match-lambda
-              [(day-date . events)
-               `(div (@ (class "tbody"))
-                     ,(stream-length events))])
-            event-groups))))
+        ,@(cons
+           ;; First day is a special case, since I always want to show a full date there.
+           ;; For all other days I'm only interested in the parts that change.
+           (let* (((day-date . events) (stream-car event-groups)))
+             `(div (@ (class "tbody")) "")
+             `(div (@ (class "tbody"))
+                   (div (@ (class "date-info"))
+                        (span (@ (class "day-number")) ,(date->string day-date "~e"))
+                        (span (@ (class "month-name")) ,(date->string day-date "~b"))
+                        (span (@ (class "year-number")) ", ",(date->string day-date "~Y")))
+                   ,@(stream->list (stream-map make-small-block events))))
+           (stream->list
+            (stream-map
+             (match-lambda
+               [(day-date . events)
+                `(div (@ (class "tbody"))
+                      (div (@ (class "date-info"))
+                           (span (@ (class "day-number")) ,(date->string day-date "~e"))
+                           ,(when (= 1 (day day-date))
+                              `(span (@ (class "month-name")) ,(date->string day-date "~b")))
+                           ,(when (= 1 (month day-date) (day day-date))
+                              `(span (@ (class "year-number"))
+                                     ", " ,(date->string day-date "~Y"))))
+                      ,@(stream->list
+                         (stream-map make-small-block events)))])
+             (stream-cdr event-groups))))))
 
 
 ;;; NOTE
diff --git a/static/style.css b/static/style.css
index 810fa0b4..d38d8833 100644
--- a/static/style.css
+++ b/static/style.css
@@ -132,13 +132,41 @@ body {
 
 .caltable .thead {
     font-weight: bold;
-    text-align: center;
+    display: flex;
+    align-items: center;
+    justify-content: center;
 }
 
-.caltable div {
+.caltable .thead,
+.caltable .tbody {
     border: 1px solid gray;
 }
 
+.caltable .tbody {
+    overflow-y: auto;
+}
+
+.inline-event {
+    font-size: 8pt;
+    border-radius: 5px;
+    padding: 2px;
+    margin: 2px;
+    font-family: arial;
+}
+
+.date-info .day-number {
+    font-size: 150%;
+    padding: 2pt;
+}
+
+.date-info .month-name {
+    color: gray;
+}
+
+.date-info .year-number {
+    color: gray;
+}
+
 /* ---------------------------------------- */
 
 .calendar {
-- 
cgit v1.2.3