From b9b068e11dff9c57c050a5f67d111ed8fe41e076 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sat, 4 Apr 2020 01:46:27 +0200 Subject: Add header for month layout. --- module/output/html.scm | 123 +++++++++++++++++++++++++------------------------ static/style.css | 15 +++++- 2 files changed, 76 insertions(+), 62 deletions(-) diff --git a/module/output/html.scm b/module/output/html.scm index 55b05b17..80a5798b 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -277,24 +277,24 @@ (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")) - (div (@ (class "days")) - ,@(time-marker-div) - (div (@ (class "longevents") - (style "grid-column-end: span " ,(days-between start-date end-date))) - "" ; prevent self-closing - ,@(lay-out-long-events start-date end-date long-events)) - ,@(map (lambda (day-date) - `(div (@ (class "meta")) - ,(let ((str (date-link day-date))) - `(span (@ (id ,str) (class "daydate")) ,str)) - (span (@ (class "dayname")) ,(string-titlecase (date->string day-date "~a")))) ) - range) - ,@(stream->list - (stream-map - lay-out-day - (get-groups-between (group-stream (list->stream short-events)) - start-date end-date))))))) + `((div (@ (class "calendar")) + (div (@ (class "days")) + ,@(time-marker-div) + (div (@ (class "longevents") + (style "grid-column-end: span " ,(days-between start-date end-date))) + "" ; prevent self-closing + ,@(lay-out-long-events start-date end-date long-events)) + ,@(map (lambda (day-date) + `(div (@ (class "meta")) + ,(let ((str (date-link day-date))) + `(span (@ (id ,str) (class "daydate")) ,str)) + (span (@ (class "dayname")) ,(string-titlecase (date->string day-date "~a")))) ) + range) + ,@(stream->list + (stream-map + lay-out-day + (get-groups-between (group-stream (list->stream short-events)) + start-date end-date)))))))) ;;; Prodcedures for text output @@ -353,38 +353,40 @@ (define event-groups (get-groups-between (group-stream events) pre-start post-end)) - `(div (@ (class "caltable")) - ,@(map (lambda (d) `(div (@ (class "thead")) ,(string-titlecase (week-day-name d)))) - (weekday-list (get-config 'week-start))) - ,@(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 "cal-cell")) - (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 "cal-cell")) - (div (@ (class "date-info " - ,(when (or (date< day-date start-date) - (date< end-date day-date)) - "non-current") - )) - (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)))))) + `((header (@ (class "table-head")) + ,(string-titlecase (date->string start-date "~B ~Y"))) + (div (@ (class "caltable")) + ,@(map (lambda (d) `(div (@ (class "thead")) ,(string-titlecase (week-day-name d)))) + (weekday-list (get-config 'week-start))) + ,@(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 "cal-cell")) + (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 "cal-cell")) + (div (@ (class "date-info " + ,(when (or (date< day-date start-date) + (date< end-date day-date)) + "non-current") + )) + (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))))))) @@ -474,7 +476,7 @@ (define*-public (html-generate key: calendars events start-date end-date - render-calendar ; (bunch of kv args) → sxml + render-calendar ; (bunch of kv args) → (list sxml) next-start ; date → date prev-start ; date → date ;; The pre and post dates are if we want to show some dates just outside our @@ -526,19 +528,18 @@ (body (div (@ (class "root")) - ;; Actuall calendar (main ;; Actuall calendar (@ (style "grid-area: main")) - ,(render-calendar calendars: calendars - events: events - start-date: start-date - end-date: end-date - pre-start: pre-start - post-end: post-end - next-start: next-start - prev-start: prev-start - )) + ,@(render-calendar calendars: calendars + events: events + start-date: start-date + end-date: end-date + pre-start: pre-start + post-end: post-end + next-start: next-start + prev-start: prev-start + )) ;; Page footer (footer diff --git a/static/style.css b/static/style.css index e871d1fd..7bfdf42b 100644 --- a/static/style.css +++ b/static/style.css @@ -17,8 +17,8 @@ html, body { grid-template-rows: auto; grid-template-areas: + "main main nav" "main main cal" - "main main nav" "main main details" "main main events" "footer footer events"; @@ -28,6 +28,7 @@ html, body { .root { grid-template-areas: "main main" + "nav events" "cal events" "details events" ". events" @@ -45,6 +46,12 @@ html, body { .root main { min-width: 0; /* for wide */ min-height: 0; /* for tall */ + + /* apparently required if one wants to have multiple + items within main, without it overflowing + */ + display: flex; + flex-direction: column; } /* Page footer @@ -281,6 +288,12 @@ along with their colors. color: gray; } +.table-head { + font-size: 200%; + text-align: center; +} + + /* Weekly calendar ---------------------------------------- */ -- cgit v1.2.3