aboutsummaryrefslogtreecommitdiff
path: root/module/html/view
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-08-23 23:22:10 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-08-23 23:22:10 +0200
commitedaf758b80fed1f5f14cd4b192e661c8863e84bc (patch)
tree9baf17c11a6254e81f29a1c473e5eb86c072aa79 /module/html/view
parentAdd rendering of standalone small-cal. (diff)
downloadcalp-edaf758b80fed1f5f14cd4b192e661c8863e84bc.tar.gz
calp-edaf758b80fed1f5f14cd4b192e661c8863e84bc.tar.xz
Move html modules under calp.
Diffstat (limited to 'module/html/view')
-rw-r--r--module/html/view/calendar.scm289
-rw-r--r--module/html/view/calendar/month.scm117
-rw-r--r--module/html/view/calendar/shared.scm96
-rw-r--r--module/html/view/calendar/week.scm121
-rw-r--r--module/html/view/search.scm38
-rw-r--r--module/html/view/small-calendar.scm19
6 files changed, 0 insertions, 680 deletions
diff --git a/module/html/view/calendar.scm b/module/html/view/calendar.scm
deleted file mode 100644
index aa67220c..00000000
--- a/module/html/view/calendar.scm
+++ /dev/null
@@ -1,289 +0,0 @@
-(define-module (html view calendar)
- :use-module (util)
- :use-module (vcomponent)
- :use-module ((vcomponent datetime)
- :select (events-between))
- :use-module ((vcomponent build)
- :select (vcalendar vevent))
- :use-module (datetime)
- :use-module (html components)
- :use-module ((html vcomponent)
- :select (popup
- calendar-styles
- fmt-day
- make-block
- fmt-single-event
- ))
- :use-module (html config)
- :use-module (html util)
- :use-module ((html caltable) :select (cal-table))
-
- :use-module (util config)
-
- :use-module (srfi srfi-1)
- :use-module (srfi srfi-26)
- :use-module (srfi srfi-41)
- :use-module (srfi srfi-41 util)
-
- :use-module ((vcomponent group)
- :select (group-stream get-groups-between))
- )
-
-
-;;; Main-stuff
-
-
-;;; NOTE
-;;; The side bar filters all earlier events for each day to not create repeats,
-;;; and the html-generate procedure also filters, but instead to find earlier eventns.
-;;; All this filtering is probably slow, and should be looked into.
-
-;; TODO place this somewhere proper
-(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
- calendars events start-date end-date
- 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 actuall interval. Primarily for whole month views,
- ;; which needs a bit on each side.
- (pre-start start-date)
- (post-end end-date))
-
- ;; NOTE maybe don't do this again for every month
- (define evs (get-groups-between (group-stream events)
- start-date end-date))
-
- (define (nav-link display date)
- `(a (@ (href ,(date->string date "~Y-~m-~d") ".html")
- (class "nav hidelink"))
- (div (@ (class "nav"))
- ,display)))
-
- (unless next-start
- (error 'html-generate "Next-start needs to be a procedure"))
-
- (unless prev-start
- (error 'html-generate "Prev-start needs to be a procedure"))
-
- (xhtml-doc
- (@ (lang sv))
- (head
- (title "Calendar")
- (meta (@ (charset "utf-8")))
- ;; (meta (@ (http-equiv "Content-Type") (content "application/xhtml+xml")))
- (meta (@ (name viewport)
- (content "width=device-width, initial-scale=0.5")))
- (meta (@ (name description)
- (content "Calendar for the dates between "
- ,(date->string start-date) " and "
- ,(date->string end-date))))
- ;; NOTE this is only for the time actually part of this calendar.
- ;; overflowing times from pre-start and post-end is currently ignored here.
- (meta (@ (name start-time)
- (content ,(date->string start-date "~s"))))
- (meta (@ (name end-time)
- (content ,(date->string (date+ end-date (date day: 1)) "~s"))))
-
- (script "EDIT_MODE=" ,(if (edit-mode) "true" "false") ";")
-
- (style ,(format #f "html {
- --editmode: 1.0;
- --event-font-size: 8pt;
-}"))
-
- ,(include-css "/static/style.css")
- ,(include-alt-css "/static/dark.css" '(title "Dark"))
- ,(include-alt-css "/static/light.css" '(title "Light"))
-
- (script (@ (defer) (src "/static/script.js")))
- ,(calendar-styles calendars))
-
- (body
- (div (@ (class "root"))
- (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
- )
- ;; 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
- (@ (style "grid-area: footer"))
- (span "Page generated " ,(date->string (current-date)))
- (span (a (@ (href ,(repo-url) "/calparse"))
- "Source Code")))
-
- ;; Small calendar and navigation
- (nav (@ (class "calnav") (style "grid-area: nav"))
- (div (@ (class "change-view"))
- ,(btn href: (date->string
- (if (= 1 (day start-date))
- (start-of-week start-date)
- start-date)
- "/week/~1.html")
- "veckovy")
-
- ,(btn href: (date->string (set (day start-date) 1) "/month/~1.html")
- "månadsvy")
-
- ,(btn id: "today-button"
- href: (string-append
- "/today?" (case intervaltype
- [(month) "view=month"]
- [(week) "view=week"]
- [else ""]))
- "idag"))
-
- (div (@ (id "jump-to"))
- ;; Firefox's accessability complain about each date
- ;; component, meaning that it's broken. This label
- ;; is for the whole input, which can be enabled
- ;; if wanted.
- ;; (label (@ (for "date")) "Hoppa till")
- (form (@ (action "/today"))
- (input (@ (type hidden)
- (name "view")
- (value ,(case intervaltype
- [(month week) => symbol->string]
- [else "month"]))))
- (input (@ (type date)
- (name "date")
- (value ,(date->string start-date "~1"))))
- ,(btn "➔"))))
-
- (details (@ (open) (style "grid-area: cal"))
- (summary "Month overview")
- (div (@ (class "smallcall-head"))
- ,(string-titlecase (date->string start-date "~B ~Y")))
- ;; NOTE it might be a good idea to put the navigation buttons
- ;; earlier in the DOM-tree/tag order. At least Vimium's
- ;; @key{[[} keybind sometimes finds parts of events instead.
- (div (@ (class "smallcal"))
- ;; prev button
- ,(nav-link "«" (prev-start start-date))
-
- ;; calendar table
- (div ,(cal-table start-date: start-date end-date: end-date
- next-start: next-start
- prev-start: prev-start
- ))
-
- ;; next button
- ,(nav-link "»" (next-start start-date))))
-
-
- (div (@ (style "grid-area: details"))
- ,(when (or (debug) (edit-mode))
- `(details (@ (class "sliders"))
- (summary "Option sliders")
-
-
- ,@(when (edit-mode)
- `((label "Event blankspace")
- ,(slider-input
- variable: "editmode"
- min: 0
- max: 1
- step: 0.01
- value: 1)))
-
- ,@(when (debug)
- `((label "Fontsize")
- ,(slider-input
- unit: "pt"
- min: 1
- max: 20
- step: 1
- value: 8
- variable: "event-font-size")))))
-
- ;; List of calendars
- (details (@ (class "calendarlist"))
- (summary "Calendar list")
- (ul ,@(map
- (lambda (calendar)
- `(li (@ (class "CAL_"
- ,(html-attr (prop calendar 'NAME))))
- ,(prop calendar 'NAME)))
- calendars))
- (div (@ (id "calendar-dropdown-template") (class "template"))
- (select
- (option "- Choose a Calendar -")
- ,@(let ((dflt (get-config 'default-calendar)))
- (map (lambda (calendar)
- (define name (prop calendar 'NAME))
- `(option (@ (value ,(html-attr name))
- ,@(when (string=? name dflt)
- '((selected))))
- ,name))
- calendars)))
- )))
-
- ;; List of events
- (div (@ (class "eventlist")
- (style "grid-area: events"))
- ;; Events which started before our start point,
- ;; but "spill" into our time span.
- (section (@ (class "text-day"))
- (header (h2 "Tidigare"))
- ;; TODO this group gets styles applied incorrectly.
- ;; Figure out way to merge it with the below call.
- ,@(stream->list
- (stream-map
- fmt-single-event
- (stream-take-while
- (compose (cut date/-time<? <> start-date)
- (extract 'DTSTART))
- (cdr (stream-car evs))))))
- ,@(stream->list (stream-map fmt-day evs))))
-
- ;; This would idealy be a <template> element, but there is some
- ;; form of special case with those in xhtml, but I can't find
- ;; the documentation for it.
- ,@(let* ((cal (vcalendar
- name: "Generated"
- children: (list (vevent
- ;; The event template SHOULD lack
- ;; a UID, to stop potential problems
- ;; with conflicts when multiple it's
- ;; cloned mulitple times.
- dtstart: (datetime)
- dtend: (datetime)
- summary: ""
- ;; force a description field,
- ;; but don't put anything in
- ;; it.
- description: ""))))
- (event (car (children cal))))
- `((div (@ (class "template event-container") (id "event-template")
- ;; Only needed to create a duration. So actual dates
- ;; dosen't matter
- (data-start "2020-01-01")
- (data-end "2020-01-02"))
- ,(caddar ; strip <a> tag
- (make-block event `((class " generated ")))))
- ;; TODO merge this into the event-set, add attribute
- ;; for non-displaying elements.
- (div (@ (class "template") (id "popup-template"))
- ,(popup event (string-append "popup" (html-id event)))))))))
diff --git a/module/html/view/calendar/month.scm b/module/html/view/calendar/month.scm
deleted file mode 100644
index 99640a22..00000000
--- a/module/html/view/calendar/month.scm
+++ /dev/null
@@ -1,117 +0,0 @@
-(define-module (html view calendar month)
- :use-module (util)
- :use-module (srfi srfi-1)
- :use-module (srfi srfi-41)
- :use-module (srfi srfi-41 util)
- :use-module (datetime)
- :use-module (html view calendar shared)
- :use-module (html config)
- :use-module (vcomponent)
- :use-module ((vcomponent datetime)
- :select (really-long-event?
- events-between))
- :use-module ((html vcomponent)
- :select (make-block))
- :use-module ((vcomponent group)
- :select (group-stream get-groups-between))
- )
-
-;; (stream event-group) -> sxml
-(define*-public (render-calendar-table key: events start-date end-date pre-start post-end #:allow-other-keys)
-
- (define-values (long-events short-events)
- ;; TODO should be really-long-event? or event-spanning-midnight
- (partition really-long-event? (stream->list (events-between pre-start post-end events))))
-
- (define short-event-groups
- (get-groups-between (group-stream (list->stream short-events))
- pre-start post-end))
-
- (define long-event-groups
- (map (lambda (s)
- (define e (date+ s (date day: 6)))
- (cons* s e
- (stream->list
- (events-between s e (list->stream long-events)))))
- (date-range pre-start post-end (date day: 7))))
-
- `((script "const VIEW='month';")
- (header (@ (class "table-head"))
- ,(string-titlecase (date->string start-date "~B ~Y")))
- (div (@ (class "caltable")
- (style "grid-template-rows: 2em"
- ,(string-concatenate
- (map (lambda (long-group)
- (format #f " [time] 15pt [long] ~amm [short] 1fr"
- (min 10 (* 4 (length (cddr long-group))))))
- long-event-groups))))
- ,@(map (lambda (d) `(div (@ (class "thead")) ,(string-titlecase (week-day-name d))))
- (weekday-list))
- ,@(map (lambda (group i)
- (let* (((s e . events) group))
- `(div (@ (class "cal-cell longevents event-container")
- (style "grid-area: long " ,i ";"
- "grid-column: 1 / span 7;")
- (data-start ,(date->string s))
- (data-end ,(date->string (add-day e))))
- ,@(lay-out-long-events
- s e events))))
- long-event-groups
- (iota (length long-event-groups) 1))
-
- ,@(caltable-time-cells start-date end-date
- pre-start post-end)
-
- ,@(stream->list
- (stream-map
- (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
- (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))))
- ))
-
-
-
-;;; Table output
-
-(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"))
- (a (@ (class "hidelink")
- (href "/week/" ,(date->string day-date "~Y-~m-~d")
- ".html#" ,(date->string day-date "~Y-~m-~d")))
- (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))))
diff --git a/module/html/view/calendar/shared.scm b/module/html/view/calendar/shared.scm
deleted file mode 100644
index d1f58460..00000000
--- a/module/html/view/calendar/shared.scm
+++ /dev/null
@@ -1,96 +0,0 @@
-(define-module (html view calendar shared)
- :use-module (util)
- :use-module (srfi srfi-1)
- :use-module (vcomponent)
- :use-module ((vcomponent datetime)
- :select (event-length
- overlapping?
- event-length/clamped))
- :use-module ((vcomponent datetime output)
- :select (format-summary))
- :use-module (util tree)
- :use-module (datetime)
- :use-module (html config)
- :use-module ((html components)
- :select (btn tabset))
- :use-module ((html vcomponent)
- :select (make-block) )
- )
-
-
-
-(define-public x-pos (make-object-property))
-(define-public width (make-object-property))
-
-
-;; Takes a list of vcomponents, sets their widths and x-positions to optimally
-;; fill out the space, without any overlaps.
-(define*-public (fix-event-widths! lst key: event-length-key (event-length-comperator date/-time>?))
- ;; The tree construction is greedy. This means
- ;; that if a smaller event preceeds a longer
- ;; event it would capture the longer event to
- ;; only find events which also overlaps the
- ;; smaller event.
-
- ;; @var{x} is how for left in the container we are.
- (let inner ((x 0)
- (tree (make-tree overlapping?
- (sort* lst event-length-comperator event-length-key
- ))))
- (unless (null? tree)
- (let ((w (/ (- 1 x)
- (+ 1 (length-of-longst-branch (left-subtree tree))))))
- (set! (width (car tree)) w
- (x-pos (car tree)) x)
- (inner (+ x w) (left-subtree tree))
- (inner x (right-subtree tree))))))
-
-
-(define-public (lay-out-long-events start end events)
- (fix-event-widths! events event-length-key: event-length
- event-length-comperator: date/-time>)
- (map (lambda (e) (create-top-block start end e))
- events))
-
-;; date{,time}-difference works in days, and days are simply multiplied by 24 to
-;; get hours. This means that a day is always assumed to be 24h, even when that's
-;; wrong. This might lead to some weirdness when the timezon switches (DST), but it
-;; makes everything else behave MUCH better.
-(define-public (create-top-block start-date end-date ev)
-
- (define total-length
- (* 24 (days-in-interval start-date end-date)))
-
- (define top (* 100 (x-pos ev)))
- (define height (* 100 (width ev)))
- (define left ; start time
- (* 100
- (let* ((dt (datetime date: start-date))
- (diff (datetime-difference
- (datetime-max dt (as-datetime (prop ev 'DTSTART)))
- dt)))
- (/ (datetime->decimal-hour diff start-date) total-length))))
-
- ;; Set length of event, which makes end time
- (define width*
- (* 100
- (/ (datetime->decimal-hour
- (as-datetime (event-length/clamped start-date end-date ev))
- start-date)
- total-length)))
-
- (define style
- (if (edit-mode)
- (format #f "top:calc(var(--editmode)*~,3f%);height:calc(var(--editmode)*~,3f%);left:~,3f%;width:~,3f%;"
- top height left width*)
- (format #f "top:~,3f%;height:~,3f%;left:~,3f%;width:~,3f%;"
- top height left width*)))
-
- (make-block
- ev `((class
- ,(when (date/-time< (prop ev 'DTSTART) start-date)
- " continued")
- ,(when (and (prop ev 'DTEND)
- (date/-time< (date+ end-date (date day: 1)) (prop ev 'DTEND)))
- " continuing"))
- (style ,style))))
diff --git a/module/html/view/calendar/week.scm b/module/html/view/calendar/week.scm
deleted file mode 100644
index 34e8eeb4..00000000
--- a/module/html/view/calendar/week.scm
+++ /dev/null
@@ -1,121 +0,0 @@
-(define-module (html view calendar week)
- :use-module (util)
- :use-module (srfi srfi-1)
- :use-module (srfi srfi-41)
- :use-module (datetime)
- :use-module (html view calendar shared)
- :use-module (html config)
- :use-module (html util)
- :use-module (vcomponent)
- :use-module ((vcomponent datetime)
- :select (long-event?
- event-length/day
- event-zero-length?
- events-between))
- :use-module ((html vcomponent)
- :select (make-block) )
- :use-module ((vcomponent group)
- :select (group-stream get-groups-between))
- )
-
-
-(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)))
- `((script "const VIEW='week';")
- (div (@ (class "calendar"))
- (div (@ (class "days"))
- ,@(time-marker-div)
- (div (@ (class "longevents event-container")
- (data-start ,(date->string start-date) )
- (data-end ,(date->string (add-day end-date)) )
- (style "grid-column-end: span " ,(days-in-interval start-date end-date)))
- ,@(lay-out-long-events start-date end-date long-events))
- ,@(map (lambda (day-date)
- `(div (@ (class "meta"))
- (span (@ (class "daydate"))
- ,(date->string day-date "~Y-~m-~d"))
- (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)))
-
- ,@(for event in (stream->list
- (events-between start-date end-date events))
- ((@ (html vcomponent ) popup) event (string-append "popup" (html-id event))))
-
- )))))
-
-
-
-(define (time-marker-div)
- ;; element to make rest of grid align correct.
- ;; Could be extended to contain something fun.
- `((div (@ (style "grid-row: 1 / span 2")))
- (div (@ (class "sideclock"))
- ,@(map (lambda (time)
- `(div (@ (class "clock clock-" ,time))
- (span (@ (class "clocktext"))
- ,time ":00")))
- (iota 12 0 2)))))
-
-;; Lay out complete day (graphical)
-;; (date . (events)) -> sxml
-(define (lay-out-day day)
- (let* (((day-date . events) day)
- (time-obj (datetime date: day-date))
- (zero-length-events short-events
- (partition event-zero-length? (stream->list events))))
-
- (fix-event-widths! short-events event-length-key:
- (lambda (e) (event-length/day day-date e)))
-
- `(div (@ (class "events event-container") (id ,(date-link day-date))
- (data-start ,(date->string day-date))
- (data-end ,(date->string (add-day day-date)) ))
- ,@(map (lambda (time)
- `(div (@ (class "clock clock-" ,time))))
- (iota 12 0 2))
- (div (@ (class "zero-width-events"))
- ,(map make-block zero-length-events))
- ,@(map (lambda (e) (create-block day-date e)) short-events))))
-
-
-
-;; Format single event for graphical display
-;; This is extremely simmilar to create-top-block, which currently recides in ./shared
-(define (create-block date ev)
- ;; (define time (date->time-utc day))
-
- (define left (* 100 (x-pos ev)))
- (define width* (* 100 (width ev)))
- (define top (if (date= date (as-date (prop ev 'DTSTART)))
- (* 100/24
- (time->decimal-hour
- (as-time (prop ev 'DTSTART))))
- 0))
- (define height (* 100/24 (time->decimal-hour (event-length/day date ev))))
-
-
- (define style
- ;; The calc's here is to enable an "edit-mode".
- ;; Setting --editmode ≈ 0.8 gives some whitespace to the right
- ;; of the events, alowing draging there for creating new events.
- (if (edit-mode)
- (format #f "left:calc(var(--editmode)*~,3f%);width:calc(var(--editmode)*~,3f%);top:~,3f%;height:~,3f%;"
-
- left width* top height)
- (format #f "left:~,3f%;width:~,3f%;top:~,3f%;height:~,3f%;"
- left width* top height)))
-
- (make-block
- ev `((class
- ,(when (date<? (as-date (prop ev 'DTSTART)) date)
- " continued")
- ,(when (and (prop ev 'DTEND) (date<? date (as-date (prop ev 'DTEND))))
- " continuing"))
- (style ,style))))
diff --git a/module/html/view/search.scm b/module/html/view/search.scm
deleted file mode 100644
index 12d8399f..00000000
--- a/module/html/view/search.scm
+++ /dev/null
@@ -1,38 +0,0 @@
-(define-module (html view search)
- :use-module (util)
- :use-module (vcomponent)
- :use-module (vcomponent search)
- :use-module ((ice-9 pretty-print) :select (pretty-print))
- :use-module ((html components)
- :select (xhtml-doc include-css))
- :use-module ((html vcomponent)
- :select (compact-event-list))
- )
-
-(define-public (search-result-page
- has-query? search-term search-result page paginator q=)
- (xhtml-doc
- (@ (lang sv))
- (head (title "Search results")
- ,(include-css "/static/style.css"))
- (body
- (h2 "Search term")
- (form
- (pre (textarea (@ (name "q") (rows 5) (spellcheck false)
- (style "width:100%"))
- ,(when has-query?
- (with-output-to-string
- (lambda () (pretty-print search-term))))))
- (input (@ (type submit))))
- (h2 "Result (page " ,page ")")
- (ul
- ,@(compact-event-list search-result))
- (div (@ (class "paginator"))
- ,@(paginator->list
- paginator
- (lambda (p) (if (= p page)
- `(span ,p)
- `(a (@ (href "?" ,q= "&p=" ,p)) ,p)))
- (lambda (p) `(a (@ (href "?" ,q= "&p=" ,p)) "»"))))
- )))
-
diff --git a/module/html/view/small-calendar.scm b/module/html/view/small-calendar.scm
deleted file mode 100644
index e6378176..00000000
--- a/module/html/view/small-calendar.scm
+++ /dev/null
@@ -1,19 +0,0 @@
-(define-module (html view small-calendar)
- :use-module ((html components) :select (xhtml-doc include-css))
- :use-module ((html caltable) :select (cal-table))
- :use-module ((datetime) :select (month- month+ remove-day date->string))
- )
-
-(define-public (render-small-calendar month standalone)
- (define table (cal-table
- start-date: month
- end-date: (remove-day (month+ month))
- next-start: month+
- prev-start: month-
- ))
- (if standalone
- (xhtml-doc
- (head (title ,(date->string month "~1"))
- ,(include-css "/static/smallcal.css"))
- (body ,table))
- table))