Clean up caltable code.

2 files changed, 65 insertions, 71 deletions

diff --git a/module/output/html.scm b/module/output/html.scm
index 4a6096e3..725cd39a 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -448,6 +448,39 @@
 (define (make-small-block event)
   (make-block event))
 
+(define (caltable-time-cells start-date end-date
+                             pre-start post-end)
+  (map (lambda (day-date i)
+         `(div (@ (style "grid-area:time " ,i)
+                  (class "cal-cell cal-cell-time"))
+               (time (@ (class "date-info "
+                          ,(if (or (date< day-date start-date)
+                                   (date< end-date day-date))
+                               "non-current"
+                               "current"))
+                        (datetime ,(date->string day-date "~1")))
+                     (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"))))))
+       (date-range pre-start post-end)
+       (map floor (iota (length (date-range pre-start post-end)) 1 1/7))))
+
+;; Natural numbers from 1 and up, each number repeated 7 times.
+(define (repeating-naturals from repeats)
+  (stream-unfold
+   cdr                      ; map
+   (const #t)               ; continue?
+   (lambda (x)                   ; gen next
+     (if (= (1- repeats) (car x))
+         (cons 0 (1+ (cdr x)))
+         (cons (1+ (car x)) (cdr x))))
+   (cons 0 from)))
+
 ;; (stream event-group) -> sxml
 (define*-public (render-calendar-table key: events start-date end-date pre-start post-end #:allow-other-keys)
 
@@ -479,53 +512,37 @@
                 (weekday-list (get-config 'week-start)))
          ,@(map (lambda (group i)
                   (let* (((s e . events) group))
-                    `(div (@ (class "cal-cell cal-cell-long")
+                    ;; These divs support dragging to create events.
+                    ;; They have correct size when draging, but are
+                    ;; then created with completely wrong start and
+                    ;; end times. TODO
+                    `(div (@ (class "cal-cell longevents event-container")
                              (style "grid-area: long " ,i ";"
-                                    "grid-column: 1 / span 7;"))
+                                    "grid-column: 1 / span 7;")
+                             (data-start ,(date->string s))
+                             (data-end ,(date->string e)))
                           ,@(lay-out-long-events
                              s e events))))
                 long-event-groups
                 (iota (length long-event-groups) 1))
-         ,@(map (lambda (day-date i)
-                  `(div (@ (style "grid-area:time " ,i)
-                           (class "cal-cell cal-cell-time"))
-                        (time (@ (class "date-info "
-                                   ,(if (or (date< day-date start-date)
-                                            (date< end-date day-date))
-                                        "non-current"
-                                        "current"))
-                                 (datetime ,(date->string day-date "~1")))
-                              (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"))))))
-                (date-range pre-start post-end)
-                (map floor (iota (length (date-range pre-start post-end)) 1 1/7)))
+
+         ,@(caltable-time-cells start-date end-date
+                                pre-start post-end)
 
          ,@(stream->list
             (stream-map
-             (match-lambda*
-               [((day-date . events) i)
-                (format (current-error-port) "> ~a: ~a~%" day-date
-                        (string-join (map (extract 'SUMMARY) (stream->list events))
-                                     ", " 'infix))
-                `(div (@ (style "grid-area:short " ,i)
-                         (class "cal-cell cal-cell-short"))
-                      ,@(stream->list (stream-map make-small-block events)))])
+             (lambda (group i)
+               (define day-date (car group))
+               (define events (cdr group))
+               `(div (@ (style "grid-area:short " ,i)
+                        (class "cal-cell cal-cell-short -event-container")
+                        (data-start ,(date->string day-date))
+                        (data-end ,(date->string (add-day day-date))))
+                     (div (@ (style "overflow-y:auto;"))
+                      ,@(map make-small-block (stream->list events)))))
              short-event-groups
-             ;; Natural numbers from 1 and up, each number repeated 7 times.
-             (stream-unfold
-              cdr        ; map
-              (const #t) ; continue?
-              (lambda (x)     ; gen next
-                (if (= 6 (car x))
-                    (cons 0 (1+ (cdr x)))
-                    (cons (1+ (car x)) (cdr x))))
-              (cons 0 1)))))))
+             (repeating-naturals 1 7)
+             )))))
 
 
 
diff --git a/static/style.css b/static/style.css
index 2a45bdc6..05a75c1c 100644
--- a/static/style.css
+++ b/static/style.css
@@ -320,17 +320,12 @@ along with their colors.
 
     display: grid;
     grid-template-columns: repeat(7, 1fr);
-    /* This is for the first name, the week days.
-       NOTE that I'm not sure this is actually the
-       correct way to do it. */
-    /* grid-template-rows: 2em; */
-    /* grid-auto-rows: 1fr; */
-    /*
-    grid-template-rows: 2em repeat(6, [time] 15pt [long] 1fr [short] 1fr);
-*/
+    /* grid template rows is generated
+       inline in the HTML */
 
     max-height: 100%;
-    /* Apparently needed to ensure that parent can contain all its children */
+    /* Apparently needed to ensure that parent
+       can contain all its children */
     min-height: 0;
 }
 
@@ -354,31 +349,19 @@ along with their colors.
     border-top: none
 }
 
-.caltable .cal-cell-long .event {
+.caltable .longevents .event {
     margin: 0;
     /* TODO use other border rules */
     border: 1px solid black;
 }
 
-.caltable .cal-cell-long .continuing {
-    border-radius: 1cm 0 0 1cm;
-}
-
-.caltable .cal-cell-long .continued {
-    border-radius: 0 1cm 1cm 0;
-}
-
-.caltable .cal-cell-long .continuing.continued {
-    border-radius: 0;
-}
-
-.caltable .cal-cell-long {
+.caltable .longevents {
     border-bottom: none;
     border-top: none;
     position: relative;
 }
 
-.caltable .cal-cell-long .event {
+.caltable .longevents .event {
     position: absolute;
     box-sizing: border-box;
     padding: 0;
@@ -386,10 +369,9 @@ along with their colors.
 
 .caltable .cal-cell {
     overflow-y: auto;
-    /* for long events */
-    overflow-x: hidden;
 }
 
+
 .cal-cell .event {
     font-size: 8pt;
     border-radius: 5px;
@@ -400,14 +382,9 @@ along with their colors.
 
 
 .date-info .day-number {
-    font-size: 150%;
     padding: 2pt;
 }
 
-.caltable .day-number {
-    font-size: initial;
-}
-
 .date-info.current .day-number {
     color: black;
 }
@@ -435,8 +412,8 @@ along with their colors.
 
 .sideclock {
     padding: 0;
-        grid-row: 3;
-        position: relative;
+    grid-row: 3;
+    position: relative;
 }
 .sideclock .day {
     border: 1px transparent;