From edaf758b80fed1f5f14cd4b192e661c8863e84bc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Sun, 23 Aug 2020 23:22:10 +0200
Subject: Move html modules under calp.

---
 module/calp/entry-points/html.scm         |   8 +-
 module/calp/html/caltable.scm             |  89 +++++++++
 module/calp/html/components.scm           | 127 +++++++++++++
 module/calp/html/config.scm               |  18 ++
 module/calp/html/util.scm                 |  46 +++++
 module/calp/html/vcomponent.scm           | 229 +++++++++++++++++++++++
 module/calp/html/view/calendar.scm        | 289 ++++++++++++++++++++++++++++++
 module/calp/html/view/calendar/month.scm  | 117 ++++++++++++
 module/calp/html/view/calendar/shared.scm |  96 ++++++++++
 module/calp/html/view/calendar/week.scm   | 121 +++++++++++++
 module/calp/html/view/search.scm          |  38 ++++
 module/calp/html/view/small-calendar.scm  |  19 ++
 module/calp/server/routes.scm             |  12 +-
 module/html/caltable.scm                  |  89 ---------
 module/html/components.scm                | 127 -------------
 module/html/config.scm                    |  18 --
 module/html/util.scm                      |  46 -----
 module/html/vcomponent.scm                | 229 -----------------------
 module/html/view/calendar.scm             | 289 ------------------------------
 module/html/view/calendar/month.scm       | 117 ------------
 module/html/view/calendar/shared.scm      |  96 ----------
 module/html/view/calendar/week.scm        | 121 -------------
 module/html/view/search.scm               |  38 ----
 module/html/view/small-calendar.scm       |  19 --
 24 files changed, 1199 insertions(+), 1199 deletions(-)
 create mode 100644 module/calp/html/caltable.scm
 create mode 100644 module/calp/html/components.scm
 create mode 100644 module/calp/html/config.scm
 create mode 100644 module/calp/html/util.scm
 create mode 100644 module/calp/html/vcomponent.scm
 create mode 100644 module/calp/html/view/calendar.scm
 create mode 100644 module/calp/html/view/calendar/month.scm
 create mode 100644 module/calp/html/view/calendar/shared.scm
 create mode 100644 module/calp/html/view/calendar/week.scm
 create mode 100644 module/calp/html/view/search.scm
 create mode 100644 module/calp/html/view/small-calendar.scm
 delete mode 100644 module/html/caltable.scm
 delete mode 100644 module/html/components.scm
 delete mode 100644 module/html/config.scm
 delete mode 100644 module/html/util.scm
 delete mode 100644 module/html/vcomponent.scm
 delete mode 100644 module/html/view/calendar.scm
 delete mode 100644 module/html/view/calendar/month.scm
 delete mode 100644 module/html/view/calendar/shared.scm
 delete mode 100644 module/html/view/calendar/week.scm
 delete mode 100644 module/html/view/search.scm
 delete mode 100644 module/html/view/small-calendar.scm

(limited to 'module')

diff --git a/module/calp/entry-points/html.scm b/module/calp/entry-points/html.scm
index abaa5f13..b2f613ea 100644
--- a/module/calp/entry-points/html.scm
+++ b/module/calp/entry-points/html.scm
@@ -8,11 +8,11 @@
   :use-module ((ice-9 regex) :select (string-match regexp-substitute))
 
   :use-module ((srfi srfi-41) :select (stream-take stream-for-each))
-  :use-module ((html view calendar) :select (html-generate))
-  :use-module ((html view calendar week)
+  :use-module ((calp html view calendar) :select (html-generate))
+  :use-module ((calp html view calendar week)
                :select (render-calendar)
                :renamer (lambda _ 'render-calendar-wide))
-  :use-module ((html view calendar month)
+  :use-module ((calp html view calendar month)
                :select (render-calendar-table))
   :use-module ((vcomponent instance methods)
                 :select (get-calendars get-event-set))
@@ -144,7 +144,7 @@
          (lambda ()
            (sxml->xml
             (re-root-static
-             ((@ (html view small-calendar) render-small-calendar)
+             ((@ (calp html view small-calendar) render-small-calendar)
               start standalone))))))]
 
     [(wide)
diff --git a/module/calp/html/caltable.scm b/module/calp/html/caltable.scm
new file mode 100644
index 00000000..65a70252
--- /dev/null
+++ b/module/calp/html/caltable.scm
@@ -0,0 +1,89 @@
+(define-module (calp html caltable)
+  :use-module (util)
+  :use-module (calp html util)
+  :use-module (datetime)
+  :use-module (srfi srfi-41)
+  )
+
+;; Small calendar similar to the one below.
+;; TODO highlight days depending on which events they contain
+;; TODO run this standalone, for embedding in other websites.
+;; @example
+;; må ti on to fr lö sö
+;;  1  2  3  4  5  6  7
+;;  8  9 10 11 12 13 14
+;; 15 16 17 18 19 20 21
+;; 22 23 24 25 26 27 28
+;; 29 30
+;; @end example
+;; 
+;; start-date : <date>
+;; end-date   : <date>
+;; next-start : <date> → <date>
+;; prev-start : <date> → <date>
+(define*-public (cal-table key: start-date end-date next-start prev-start)
+
+  (define (->link date)
+    (date->string date "~Y-~m-~d.html"))
+
+  ;; (<date> → sxml-attributes) → <date> → sxml
+  (define (td attr)
+    (lambda (date)
+      `(a (@ ,@(attr date))
+          ;; NOTE This time object is the correct place to show the existance
+          ;; of an event on a given day in this small calendar. For example
+          ;; making the text red for all holidays, or creating a yellow background
+          ;; for events from a specific source.
+          (time (@ (datetime ,(date->string date "~Y-~m-~d")))
+                ,(day date)))))
+
+  (define month-start (start-of-month start-date))
+  (define pre-start (start-of-week month-start))
+  (define month-end (end-of-month start-date))
+  (define post-end (end-of-week month-end))
+
+  `(div (@ (class "small-calendar"))
+
+        ;; Cell 0, 0. The letter v. for week number
+        (div (@ (class "column-head row-head")) "v.")
+
+        ;; top row, names of week days
+        ,@(map (lambda (d) `(div (@ (class "column-head"))
+                            ,(string-titlecase (week-day-name d 2))))
+               (weekday-list))
+
+        ;; left columun, week numbers
+        ,@(map (lambda (v) `(div (@ (class "row-head")) ,v))
+               (map week-number
+                    (stream->list
+                     (stream-take-while (lambda (s) (date<= s post-end))
+                                        (week-stream pre-start)))))
+
+        ;; actual days
+
+        ,@(map (td (lambda (date)
+                     `((class "prev")
+                       (href ,(->link
+                               ;; (prev-start date)
+                               (iterate
+                                prev-start
+                                (lambda (d) (date<= d date (next-start d)))
+                                start-date))
+                             "#" ,(date-link date)))))
+               (date-range pre-start (remove-day start-date)))
+
+
+        ,@(map (td (lambda (date) `((href "#" ,(date-link date)))))
+               (date-range start-date end-date))
+
+
+        ,@(map (td (lambda (date)
+                     `((class "next")
+                       (href ,(->link
+                               ;; (next-start date)
+                               (iterate
+                                next-start
+                                (lambda (d) (and (date<= d date)
+                                            (date< date (next-start d))))
+                                start-date)) "#" ,(date-link date)))))
+               (date-range (add-day end-date) post-end))))
diff --git a/module/calp/html/components.scm b/module/calp/html/components.scm
new file mode 100644
index 00000000..49f00e52
--- /dev/null
+++ b/module/calp/html/components.scm
@@ -0,0 +1,127 @@
+(define-module (calp html components)
+  :use-module (util)
+  :use-module (util exceptions)
+  :export (xhtml-doc)
+  )
+
+;; Wraps a number of sxml forms into a valid sxhtml-tree.
+(define-syntax xhtml-doc
+  (syntax-rules (@)
+    ((_ (@ attr ...) body ...)
+     `(*TOP*
+       (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+       (html (@ (xmlns "http://www.w3.org/1999/xhtml") attr ...)
+             body ...)))
+    ((_ body ...)
+     (xhtml-doc (@) body ...))))
+
+
+;; Add a slider with an associated number input. Keeps the two in check.
+;; Uses the js function setVar (which must be provided elsewhere)
+;; set the the value of @var{variable}.
+(define*-public (slider-input key: variable
+                              (min 0)
+                              (max 10)
+                              (step 1)
+                              (value 1)
+                              (unit ""))
+  (let ((groupname (symbol->string (gensym "slider"))))
+    `(div (@ (class "input-group"))
+          (script
+           "function " ,groupname "fn (value) {"
+           "setVar('" ,variable "', value + '" ,unit "');"
+           "for (let el of document.getElementsByClassName('" ,groupname "')) {"
+           "    el.value = value;"
+           "}}")
+          (input (@ (type "range")
+                    (class ,groupname)
+                    (min ,min)
+                    (max ,max)
+                    (step ,step)
+                    (value ,value)
+                    (oninput ,groupname "fn(this.value)")
+                    ))
+          (input (@ (type "number")
+                    (class ,groupname)
+                    (min ,min)
+                    (max ,max)
+                    (step ,step)
+                    (value ,value)
+                    (oninput ,groupname "fn(this.value)"))
+                 ))))
+
+;; Generates a button or button-like link.
+;; TODO <div/> inside <button/> isn't valid.
+(define*-public (btn key: onclick href (class '())
+              allow-other-keys:
+              rest: args)
+  (when (and onclick href)
+    (error "Only give one of onclick, href and submit."))
+
+  (let ((body #f))
+    `(,(cond [href 'a]
+             [else 'button])
+      (@ (class ,(string-join (cons "btn" class) " "))
+         ,@(cond [onclick `((onclick ,onclick))]
+                 [href `((href ,href))]
+                 [else '()])
+         ,@(let loop ((rem args))
+             (cond
+              [(null? rem) '()]
+              [(memv (car rem) '(onclick: href: class:))
+               (loop (cddr rem))]
+              [(keyword? (car rem))
+               (cons* `(,(keyword->symbol (car rem))
+                        ,(cadr rem))
+                      (loop (cddr rem)))]
+              [else
+               (set! body (car rem))
+               (loop (cdr rem))])))
+      (div ,body))))
+
+
+;; Creates a group of tabs from a given specification. The specification
+;; @var{elements} should be a list, where each element is a sublist on
+;; the form
+;; @example
+;; ("tab icon" arguments ... tab-body)
+;; @end example
+;; where arguments are zero or more pairs of keyword arguments. For example:
+;; @example
+;; ("📅" title: "Översikt" ,(fmt-single-event ev))
+;; @end example
+;; Creates a tab with an calendar emoji as icon, "Översikt" is sent as the
+;; extra argument #:title, and the body is the return from fmt-single-event.
+(define-public (tabset elements)
+  (define tabgroup (symbol->string (gensym "tabgroup")))
+
+  `(div (@ (class "tabgroup"))
+        ,@(for (i (key args ... body)) in (enumerate elements)
+               (define id (symbol->string (gensym "tab")))
+               `(div (@ (class "tab"))
+                     (input (@ (type "radio") (id ,id) (name ,tabgroup)
+                               ,@(when (zero? i) '((checked)))))
+                     ;; It would be preferable to place the labels in a separate
+                     ;; div and set that to have fixed position, since we could
+                     ;; then just flow them. That hovever doesn't work since we
+                     ;; need a css-selector for the label to the selected radio
+                     ;; option.
+                     (label (@ ,@(assq-merge `((for ,id)
+                                               (style "top: calc(var(--tab-size) * " ,i ")"))
+                                             (kvlist->assq args)))
+                            ,key)
+                     (div (@ (class "content")) ,body)))))
+
+
+(define-public (include-css path . extra-attributes)
+  `(link (@ (type "text/css")
+            (rel "stylesheet")
+            (href ,path)
+            ,@extra-attributes)))
+
+
+(define-public (include-alt-css path . extra-attributes)
+  `(link (@ (type "text/css")
+            (rel "alternate stylesheet")
+            (href ,path)
+            ,@extra-attributes)))
diff --git a/module/calp/html/config.scm b/module/calp/html/config.scm
new file mode 100644
index 00000000..6f156c98
--- /dev/null
+++ b/module/calp/html/config.scm
@@ -0,0 +1,18 @@
+(define-module (calp html config)
+  :use-module (util)
+  :use-module (util config)
+  )
+
+(define-public debug (make-parameter #f))
+(define-config debug #f
+  description: "Places the generated thingy in debug mode"
+  post: debug)
+
+
+;;; NOTE edit mode should preferably depend on login-status of the user
+;;; but this works for the time being.
+(define-public edit-mode (make-parameter #t))
+(define-config edit-mode #t
+  description: "Makes the document editable"
+  post: edit-mode)
+
diff --git a/module/calp/html/util.scm b/module/calp/html/util.scm
new file mode 100644
index 00000000..8410472c
--- /dev/null
+++ b/module/calp/html/util.scm
@@ -0,0 +1,46 @@
+(define-module (calp html util)
+  :use-module ((base64) :select (base64encode base64decode))
+  :use-module (util))
+
+;;; @var{html-attr} & @var{html-unattr} used to just strip any
+;;; attributes not valid in css. That allowed a human reader to
+;;; quickly see what data it was. The downside was that it was one
+;;; way. The new base64 based system supports both an encode and a
+;;; decode without problem.
+;;;
+;;; The encoded string substitutes { + => å, / => ä, = => ö } to be
+;;; valid CSS selector names.
+
+;; Retuns an HTML-safe version of @var{str}.
+(define-public (html-attr str)
+  (string-map (lambda (c)
+                (case c
+                  ((#\+) #\å)
+                  ((#\/) #\ä)
+                  ((#\=) #\ö)
+                  (else c)))
+              (base64encode str)))
+
+(define-public (html-unattr str)
+  (base64decode
+    (string-map (lambda (c)
+                  (case c
+                    ((#\å) #\+)
+                    ((#\ä) #\/)
+                    ((#\ö) #\=)
+                    (else c)))
+                str)))
+
+
+(define-public (date-link date)
+  ((@ (datetime) date->string) date "~Y-~m-~d"))
+
+
+
+;; Generate an html id for an event.
+;; TODO? same event placed multiple times, when spanning multiple cells
+(define-public html-id
+  (let ((id (make-object-property)))
+    (lambda (ev)
+      (or (id ev)
+          (set/r! (id ev) (symbol->string (gensym "__html_id_")))))))
diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm
new file mode 100644
index 00000000..be6b6166
--- /dev/null
+++ b/module/calp/html/vcomponent.scm
@@ -0,0 +1,229 @@
+(define-module (calp html vcomponent)
+  :use-module (util)
+  :use-module (vcomponent)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-41)
+  :use-module (datetime)
+  :use-module (calp html util)
+  :use-module ((calp html config) :select (edit-mode))
+  :use-module ((calp html components) :select (btn tabset))
+  :use-module ((util color) :select (calculate-fg-color))
+  :use-module ((vcomponent datetime output)
+               :select (fmt-time-span
+                        format-description
+                        format-summary
+                        format-recurrence-rule
+                                      ))
+  )
+
+(define-public (compact-event-list list)
+
+  (define calendars
+   (delete-duplicates!
+    (filter (lambda (x) (eq? 'VCALENDAR (type x)))
+            (map parent list))
+    eq?))
+
+  (define (summary event)
+    `(summary (div (@ (class "summary-line "))
+                   (span (@ (class "square CAL_"
+                              ,(html-attr
+                                (or (prop (parent event)
+                                          'NAME)
+                                    "unknown")))))
+                   (time ,(let ((dt (prop event 'DTSTART)))
+                            (if (datetime? dt)
+                                (datetime->string dt "~Y-~m-~d ~H:~M")
+                                (date->string dt "~Y-~m-~d" ))))
+                   (span ,(prop event 'SUMMARY)))))
+  (cons
+   (calendar-styles calendars)
+   (for event in list
+        `(details
+          ,(summary event)
+          ;; TODO better format, add show in calendar button
+          ,(fmt-single-event event)))))
+
+;; Format event as text.
+;; Used in
+;; - sidebar
+;; - popup overwiew tab
+;; - search result (event details)
+(define*-public (fmt-single-event ev
+                                  optional: (attributes '())
+                                  key: (fmt-header list))
+  ;; (format (current-error-port) "fmt-single-event: ~a~%" (prop ev 'X-HNH-FILENAME))
+  `(div (@ ,@(assq-merge
+              attributes
+              `((class " eventtext "
+                  ,(when (and (prop ev 'PARTSTAT)
+                              (eq? 'TENTATIVE (prop ev 'PARTSTAT)))
+                     " tentative ")))))
+        (h3 ,(fmt-header
+              (when (prop ev 'RRULE)
+                `(span (@ (class "repeating")) "↺"))
+              `(span (@ (class "summary")) ,(prop ev 'SUMMARY))))
+        (div
+         ,(call-with-values (lambda () (fmt-time-span ev))
+            (case-lambda [(start)
+                          `(div (time (@ (class "dtstart")
+                                         (data-fmt ,(string-append "~L" start))
+                                         (datetime ,(datetime->string
+                                                     (as-datetime (prop ev 'DTSTART))
+                                                     "~1T~3")))
+                                      ,(datetime->string
+                                        (as-datetime (prop ev 'DTSTART))
+                                        start)))]
+                         [(start end)
+                          `(div (time (@ (class "dtstart")
+                                         (data-fmt ,(string-append "~L" start))
+                                         (datetime ,(datetime->string
+                                                     (as-datetime (prop ev 'DTSTART))
+                                                     "~1T~3")))
+                                      ,(datetime->string (as-datetime (prop ev 'DTSTART))
+                                                         start))
+                                " — "
+                                (time (@ (class "dtend")
+                                         (data-fmt ,(string-append "~L" end))
+                                         (datetime ,(datetime->string
+                                                     (as-datetime (prop ev 'DTSTART))
+                                                     "~1T~3")))
+                                      ,(datetime->string (as-datetime (prop ev 'DTEND))
+                                                         end)))]))
+         ,(when (and=> (prop ev 'LOCATION) (negate string-null?))
+            `(div (b "Plats: ")
+                  (div (@ (class "location"))
+                       ,(string-map (lambda (c) (if (char=? c #\,) #\newline c))
+                                    (prop ev 'LOCATION)))))
+         ,(awhen (prop ev 'DESCRIPTION)
+                 `(span (@ (class "description"))
+                        ,(format-description ev it)))
+         ,(awhen (prop ev 'RRULE)
+                 `(span (@ (class "rrule"))
+                        ,@(format-recurrence-rule ev)))
+         ,(when (prop ev 'LAST-MODIFIED)
+            `(span (@ (class "last-modified")) "Senast ändrad "
+                   ,(datetime->string (prop ev 'LAST-MODIFIED) "~1 ~H:~M")))
+
+         )))
+
+
+;; Single event in side bar (text objects)
+(define-public (fmt-day day)
+  (let* (((date . events) day))
+    `(section (@ (class "text-day"))
+              (header (h2 ,(let ((s (date->string date "~Y-~m-~d")))
+                             `(a (@ (href "#" ,s)
+                                    (class "hidelink")) ,s))))
+              ,@(stream->list
+                 (stream-map
+                  (lambda (ev)
+                    (fmt-single-event
+                      ev `((id ,(html-id ev))
+                           (class "CAL_" ,(html-attr (or (prop (parent ev) 'NAME) "unknown"))))
+                      fmt-header:
+                      (lambda body
+                        `(a (@ (href "#" ,(html-id ev) #; (date-link (as-date (prop 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 (prop ev 'DTSTART)))
+                   events))))))
+
+
+(define-public (calendar-styles calendars)
+  `(style
+     ,(format #f "~:{.CAL_~a { --color: ~a; --complement: ~a }~%~}"
+              (map (lambda (c)
+                     (let* ((name (html-attr (prop c 'NAME)))
+                            (bg-color (prop c 'COLOR))
+                            (fg-color (and=> (prop c 'COLOR)
+                                             calculate-fg-color)))
+                       (list name (or bg-color 'white) (or fg-color 'black))))
+                   calendars))))
+
+;; "Physical" block in calendar view
+(define*-public (make-block ev optional: (extra-attributes '()))
+
+  `((a (@ (href "#" ,(html-id ev))
+          (class "hidelink"))
+       (div (@ ,@(assq-merge
+                  extra-attributes
+                  `((id ,(html-id ev))
+                    (data-calendar ,(html-attr (or (prop (parent ev) 'NAME) "unknown")))
+                    (class "event CAL_" ,(html-attr (or (prop (parent ev) 'NAME)
+                                                        "unknown"))
+                      ,(when (and (prop ev 'PARTSTAT)
+                                  (eq? 'TENTATIVE (prop ev 'PARTSTAT)))
+                         " tentative")
+                      ,(when (and (prop ev 'TRANSP)
+                                  (eq? 'TRANSPARENT (prop ev 'TRANSP)))
+                         " transparent")
+                      )
+                    (onclick "toggle_popup('popup' + this.id)")
+                    )))
+            ;; Inner div to prevent overflow. Previously "overflow: none"
+            ;; was set on the surounding div, but the popup /needs/ to
+            ;; overflow (for the tabs?).
+            (div (@ (class "event-body"))
+             ,(when (prop ev 'RRULE)
+                `(span (@ (class "repeating")) "↺"))
+             (span (@ (class "summary"))
+                   ,(format-summary  ev (prop ev 'SUMMARY)))
+             ,(when (prop ev 'LOCATION)
+                `(span (@ (class "location"))
+                       ,(string-map (lambda (c) (if (char=? c #\,) #\newline c))
+                                    (prop ev 'LOCATION)))))
+            (div (@ (style "display:none !important;"))
+                 ,((@ (vcomponent xcal output) ns-wrap)
+                   ((@ (vcomponent xcal output) vcomponent->sxcal)
+                    ev)))))))
+
+
+(define (repeat-info event)
+  `(div (@ (class "eventtext"))
+        (h2 "Upprepningar")
+        (pre ,(prop event 'RRULE))))
+
+
+(define-public (popup ev id)
+  `(div (@ (id ,id) (class "popup-container CAL_" 
+                           ,(html-attr (or (prop (parent ev) 'NAME)
+                                           "unknown"))) 
+           (onclick "event.stopPropagation()"))
+        ;; TODO all (?) code uses .popup-container as the popup, while .popup sits and does nothing.
+        ;; Do something about this?
+        (div (@ (class "popup"))
+             (nav (@ (class "popup-control"))
+                  ,(btn "×"
+                        title: "Stäng"
+                        onclick: "close_popup(document.getElementById(this.closest('.popup-container').id))"
+                        class: '("close-tooltip"))
+                  ,(when (edit-mode)
+                     (list
+                      (btn "🖊️"
+                           title: "Redigera"
+                           onclick: "place_in_edit_mode(document.getElementById(this.closest('.popup-container').id.substr(5)))")
+                      (btn "🗑"
+                           title: "Ta bort"
+                           onclick: "remove_event(document.getElementById(this.closest('.popup-container').id.substr(5)))"))))
+
+             ,(tabset
+                `(("📅" title: "Översikt"
+                   ,(fmt-single-event ev))
+                  ("⤓" title: "Nedladdning"
+                   (div (@ (class "eventtext") (style "font-family:sans"))
+                        (h2 "Ladda ner")
+                        (ul (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".ics"))
+                                   "som iCal"))
+                            (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".xcs"))
+                                   "som xCal")))))
+                  ,@(when (prop ev 'RRULE)
+                      `(("↺" title: "Upprepningar" class: "repeating"
+                         ,(repeat-info ev)))))))))
diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm
new file mode 100644
index 00000000..67a1a7b5
--- /dev/null
+++ b/module/calp/html/view/calendar.scm
@@ -0,0 +1,289 @@
+(define-module (calp 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 (calp html components)
+  :use-module ((calp html vcomponent)
+               :select (popup
+                        calendar-styles
+                        fmt-day
+                        make-block
+                        fmt-single-event
+                                          ))
+  :use-module (calp html config)
+  :use-module (calp html util)
+  :use-module ((calp 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/calp/html/view/calendar/month.scm b/module/calp/html/view/calendar/month.scm
new file mode 100644
index 00000000..ce8957da
--- /dev/null
+++ b/module/calp/html/view/calendar/month.scm
@@ -0,0 +1,117 @@
+(define-module (calp 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 (calp html view calendar shared)
+  :use-module (calp html config)
+  :use-module (vcomponent)
+  :use-module ((vcomponent datetime)
+               :select (really-long-event?
+                        events-between))
+  :use-module ((calp 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))
+           ((@ (calp html vcomponent) popup) event
+            (string-append "popup" ((@ (calp 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/calp/html/view/calendar/shared.scm b/module/calp/html/view/calendar/shared.scm
new file mode 100644
index 00000000..73698060
--- /dev/null
+++ b/module/calp/html/view/calendar/shared.scm
@@ -0,0 +1,96 @@
+(define-module (calp 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 (calp html config)
+  :use-module ((calp html components)
+               :select (btn tabset))
+  :use-module ((calp 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/calp/html/view/calendar/week.scm b/module/calp/html/view/calendar/week.scm
new file mode 100644
index 00000000..ca6aa9f8
--- /dev/null
+++ b/module/calp/html/view/calendar/week.scm
@@ -0,0 +1,121 @@
+(define-module (calp html view calendar week)
+  :use-module (util)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-41)
+  :use-module (datetime)
+  :use-module (calp html view calendar shared)
+  :use-module (calp html config)
+  :use-module (calp html util)
+  :use-module (vcomponent)
+  :use-module ((vcomponent datetime)
+               :select (long-event?
+                        event-length/day
+                        event-zero-length?
+                        events-between))
+  :use-module ((calp 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))
+                       ((@ (calp 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/calp/html/view/search.scm b/module/calp/html/view/search.scm
new file mode 100644
index 00000000..faefe6dc
--- /dev/null
+++ b/module/calp/html/view/search.scm
@@ -0,0 +1,38 @@
+(define-module (calp html view search)
+  :use-module (util)
+  :use-module (vcomponent)
+  :use-module (vcomponent search)
+  :use-module ((ice-9 pretty-print) :select (pretty-print))
+  :use-module ((calp html components)
+               :select (xhtml-doc include-css))
+  :use-module ((calp 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/calp/html/view/small-calendar.scm b/module/calp/html/view/small-calendar.scm
new file mode 100644
index 00000000..80cbbaf2
--- /dev/null
+++ b/module/calp/html/view/small-calendar.scm
@@ -0,0 +1,19 @@
+(define-module (calp html view small-calendar)
+  :use-module ((calp html components) :select (xhtml-doc include-css))
+  :use-module ((calp 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))
diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm
index 02bbd123..51e5acb2 100644
--- a/module/calp/server/routes.scm
+++ b/module/calp/server/routes.scm
@@ -17,7 +17,7 @@
   :use-module (sxml namespace)
 
 
-  :use-module ((html util) :select (html-unattr))
+  :use-module ((calp html util) :select (html-unattr))
 
   :use-module (web http make-routes)
 
@@ -28,8 +28,8 @@
 
   :autoload (vcomponent instance) (global-event-object)
 
-  :use-module (html view calendar)
-  :use-module ((html view search) :select (search-result-page))
+  :use-module (calp html view calendar)
+  :use-module ((calp html view search) :select (search-result-page))
 
 
   )
@@ -109,7 +109,7 @@
                                       end-date: (date+ start-date (date day: 6))
                                       next-start: (lambda (d) (date+ d (date day: 7)))
                                       prev-start: (lambda (d) (date- d (date day: 7)))
-                                      render-calendar: (@ (html view calendar week) render-calendar)
+                                      render-calendar: (@ (calp html view calendar week) render-calendar)
                                       intervaltype: 'week
                                       )))))))
 
@@ -127,7 +127,7 @@
                                                        (date day: 1))
                                       next-start: month+
                                       prev-start: month-
-                                      render-calendar: (@ (html view calendar month)
+                                      render-calendar: (@ (calp html view calendar month)
                                                           render-calendar-table)
                                       pre-start: (start-of-week start-date)
                                       post-end: (end-of-week (end-of-month start-date))
@@ -156,7 +156,7 @@
 
    ;; TODO this fails when dtstart is <date>.
    ;; @var{cal} should be the name of the calendar encoded with
-   ;; modified base64. See (html util).
+   ;; modified base64. See (calp html util).
    (POST "/insert" (cal data)
 
          (unless (and cal data)
diff --git a/module/html/caltable.scm b/module/html/caltable.scm
deleted file mode 100644
index fb2cbe02..00000000
--- a/module/html/caltable.scm
+++ /dev/null
@@ -1,89 +0,0 @@
-(define-module (html caltable)
-  :use-module (util)
-  :use-module (html util)
-  :use-module (datetime)
-  :use-module (srfi srfi-41)
-  )
-
-;; Small calendar similar to the one below.
-;; TODO highlight days depending on which events they contain
-;; TODO run this standalone, for embedding in other websites.
-;; @example
-;; må ti on to fr lö sö
-;;  1  2  3  4  5  6  7
-;;  8  9 10 11 12 13 14
-;; 15 16 17 18 19 20 21
-;; 22 23 24 25 26 27 28
-;; 29 30
-;; @end example
-;; 
-;; start-date : <date>
-;; end-date   : <date>
-;; next-start : <date> → <date>
-;; prev-start : <date> → <date>
-(define*-public (cal-table key: start-date end-date next-start prev-start)
-
-  (define (->link date)
-    (date->string date "~Y-~m-~d.html"))
-
-  ;; (<date> → sxml-attributes) → <date> → sxml
-  (define (td attr)
-    (lambda (date)
-      `(a (@ ,@(attr date))
-          ;; NOTE This time object is the correct place to show the existance
-          ;; of an event on a given day in this small calendar. For example
-          ;; making the text red for all holidays, or creating a yellow background
-          ;; for events from a specific source.
-          (time (@ (datetime ,(date->string date "~Y-~m-~d")))
-                ,(day date)))))
-
-  (define month-start (start-of-month start-date))
-  (define pre-start (start-of-week month-start))
-  (define month-end (end-of-month start-date))
-  (define post-end (end-of-week month-end))
-
-  `(div (@ (class "small-calendar"))
-
-        ;; Cell 0, 0. The letter v. for week number
-        (div (@ (class "column-head row-head")) "v.")
-
-        ;; top row, names of week days
-        ,@(map (lambda (d) `(div (@ (class "column-head"))
-                            ,(string-titlecase (week-day-name d 2))))
-               (weekday-list))
-
-        ;; left columun, week numbers
-        ,@(map (lambda (v) `(div (@ (class "row-head")) ,v))
-               (map week-number
-                    (stream->list
-                     (stream-take-while (lambda (s) (date<= s post-end))
-                                        (week-stream pre-start)))))
-
-        ;; actual days
-
-        ,@(map (td (lambda (date)
-                     `((class "prev")
-                       (href ,(->link
-                               ;; (prev-start date)
-                               (iterate
-                                prev-start
-                                (lambda (d) (date<= d date (next-start d)))
-                                start-date))
-                             "#" ,(date-link date)))))
-               (date-range pre-start (remove-day start-date)))
-
-
-        ,@(map (td (lambda (date) `((href "#" ,(date-link date)))))
-               (date-range start-date end-date))
-
-
-        ,@(map (td (lambda (date)
-                     `((class "next")
-                       (href ,(->link
-                               ;; (next-start date)
-                               (iterate
-                                next-start
-                                (lambda (d) (and (date<= d date)
-                                            (date< date (next-start d))))
-                                start-date)) "#" ,(date-link date)))))
-               (date-range (add-day end-date) post-end))))
diff --git a/module/html/components.scm b/module/html/components.scm
deleted file mode 100644
index 2580ea55..00000000
--- a/module/html/components.scm
+++ /dev/null
@@ -1,127 +0,0 @@
-(define-module (html components)
-  :use-module (util)
-  :use-module (util exceptions)
-  :export (xhtml-doc)
-  )
-
-;; Wraps a number of sxml forms into a valid sxhtml-tree.
-(define-syntax xhtml-doc
-  (syntax-rules (@)
-    ((_ (@ attr ...) body ...)
-     `(*TOP*
-       (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
-       (html (@ (xmlns "http://www.w3.org/1999/xhtml") attr ...)
-             body ...)))
-    ((_ body ...)
-     (xhtml-doc (@) body ...))))
-
-
-;; Add a slider with an associated number input. Keeps the two in check.
-;; Uses the js function setVar (which must be provided elsewhere)
-;; set the the value of @var{variable}.
-(define*-public (slider-input key: variable
-                              (min 0)
-                              (max 10)
-                              (step 1)
-                              (value 1)
-                              (unit ""))
-  (let ((groupname (symbol->string (gensym "slider"))))
-    `(div (@ (class "input-group"))
-          (script
-           "function " ,groupname "fn (value) {"
-           "setVar('" ,variable "', value + '" ,unit "');"
-           "for (let el of document.getElementsByClassName('" ,groupname "')) {"
-           "    el.value = value;"
-           "}}")
-          (input (@ (type "range")
-                    (class ,groupname)
-                    (min ,min)
-                    (max ,max)
-                    (step ,step)
-                    (value ,value)
-                    (oninput ,groupname "fn(this.value)")
-                    ))
-          (input (@ (type "number")
-                    (class ,groupname)
-                    (min ,min)
-                    (max ,max)
-                    (step ,step)
-                    (value ,value)
-                    (oninput ,groupname "fn(this.value)"))
-                 ))))
-
-;; Generates a button or button-like link.
-;; TODO <div/> inside <button/> isn't valid.
-(define*-public (btn key: onclick href (class '())
-              allow-other-keys:
-              rest: args)
-  (when (and onclick href)
-    (error "Only give one of onclick, href and submit."))
-
-  (let ((body #f))
-    `(,(cond [href 'a]
-             [else 'button])
-      (@ (class ,(string-join (cons "btn" class) " "))
-         ,@(cond [onclick `((onclick ,onclick))]
-                 [href `((href ,href))]
-                 [else '()])
-         ,@(let loop ((rem args))
-             (cond
-              [(null? rem) '()]
-              [(memv (car rem) '(onclick: href: class:))
-               (loop (cddr rem))]
-              [(keyword? (car rem))
-               (cons* `(,(keyword->symbol (car rem))
-                        ,(cadr rem))
-                      (loop (cddr rem)))]
-              [else
-               (set! body (car rem))
-               (loop (cdr rem))])))
-      (div ,body))))
-
-
-;; Creates a group of tabs from a given specification. The specification
-;; @var{elements} should be a list, where each element is a sublist on
-;; the form
-;; @example
-;; ("tab icon" arguments ... tab-body)
-;; @end example
-;; where arguments are zero or more pairs of keyword arguments. For example:
-;; @example
-;; ("📅" title: "Översikt" ,(fmt-single-event ev))
-;; @end example
-;; Creates a tab with an calendar emoji as icon, "Översikt" is sent as the
-;; extra argument #:title, and the body is the return from fmt-single-event.
-(define-public (tabset elements)
-  (define tabgroup (symbol->string (gensym "tabgroup")))
-
-  `(div (@ (class "tabgroup"))
-        ,@(for (i (key args ... body)) in (enumerate elements)
-               (define id (symbol->string (gensym "tab")))
-               `(div (@ (class "tab"))
-                     (input (@ (type "radio") (id ,id) (name ,tabgroup)
-                               ,@(when (zero? i) '((checked)))))
-                     ;; It would be preferable to place the labels in a separate
-                     ;; div and set that to have fixed position, since we could
-                     ;; then just flow them. That hovever doesn't work since we
-                     ;; need a css-selector for the label to the selected radio
-                     ;; option.
-                     (label (@ ,@(assq-merge `((for ,id)
-                                               (style "top: calc(var(--tab-size) * " ,i ")"))
-                                             (kvlist->assq args)))
-                            ,key)
-                     (div (@ (class "content")) ,body)))))
-
-
-(define-public (include-css path . extra-attributes)
-  `(link (@ (type "text/css")
-            (rel "stylesheet")
-            (href ,path)
-            ,@extra-attributes)))
-
-
-(define-public (include-alt-css path . extra-attributes)
-  `(link (@ (type "text/css")
-            (rel "alternate stylesheet")
-            (href ,path)
-            ,@extra-attributes)))
diff --git a/module/html/config.scm b/module/html/config.scm
deleted file mode 100644
index 03e18db7..00000000
--- a/module/html/config.scm
+++ /dev/null
@@ -1,18 +0,0 @@
-(define-module (html config)
-  :use-module (util)
-  :use-module (util config)
-  )
-
-(define-public debug (make-parameter #f))
-(define-config debug #f
-  description: "Places the generated thingy in debug mode"
-  post: debug)
-
-
-;;; NOTE edit mode should preferably depend on login-status of the user
-;;; but this works for the time being.
-(define-public edit-mode (make-parameter #t))
-(define-config edit-mode #t
-  description: "Makes the document editable"
-  post: edit-mode)
-
diff --git a/module/html/util.scm b/module/html/util.scm
deleted file mode 100644
index 4e15356a..00000000
--- a/module/html/util.scm
+++ /dev/null
@@ -1,46 +0,0 @@
-(define-module (html util)
-  :use-module ((base64) :select (base64encode base64decode))
-  :use-module (util))
-
-;;; @var{html-attr} & @var{html-unattr} used to just strip any
-;;; attributes not valid in css. That allowed a human reader to
-;;; quickly see what data it was. The downside was that it was one
-;;; way. The new base64 based system supports both an encode and a
-;;; decode without problem.
-;;;
-;;; The encoded string substitutes { + => å, / => ä, = => ö } to be
-;;; valid CSS selector names.
-
-;; Retuns an HTML-safe version of @var{str}.
-(define-public (html-attr str)
-  (string-map (lambda (c)
-                (case c
-                  ((#\+) #\å)
-                  ((#\/) #\ä)
-                  ((#\=) #\ö)
-                  (else c)))
-              (base64encode str)))
-
-(define-public (html-unattr str)
-  (base64decode
-    (string-map (lambda (c)
-                  (case c
-                    ((#\å) #\+)
-                    ((#\ä) #\/)
-                    ((#\ö) #\=)
-                    (else c)))
-                str)))
-
-
-(define-public (date-link date)
-  ((@ (datetime) date->string) date "~Y-~m-~d"))
-
-
-
-;; Generate an html id for an event.
-;; TODO? same event placed multiple times, when spanning multiple cells
-(define-public html-id
-  (let ((id (make-object-property)))
-    (lambda (ev)
-      (or (id ev)
-          (set/r! (id ev) (symbol->string (gensym "__html_id_")))))))
diff --git a/module/html/vcomponent.scm b/module/html/vcomponent.scm
deleted file mode 100644
index c0bbe8e1..00000000
--- a/module/html/vcomponent.scm
+++ /dev/null
@@ -1,229 +0,0 @@
-(define-module (html vcomponent)
-  :use-module (util)
-  :use-module (vcomponent)
-  :use-module (srfi srfi-1)
-  :use-module (srfi srfi-41)
-  :use-module (datetime)
-  :use-module (html util)
-  :use-module ((html config) :select (edit-mode))
-  :use-module ((html components) :select (btn tabset))
-  :use-module ((util color) :select (calculate-fg-color))
-  :use-module ((vcomponent datetime output)
-               :select (fmt-time-span
-                        format-description
-                        format-summary
-                        format-recurrence-rule
-                                      ))
-  )
-
-(define-public (compact-event-list list)
-
-  (define calendars
-   (delete-duplicates!
-    (filter (lambda (x) (eq? 'VCALENDAR (type x)))
-            (map parent list))
-    eq?))
-
-  (define (summary event)
-    `(summary (div (@ (class "summary-line "))
-                   (span (@ (class "square CAL_"
-                              ,(html-attr
-                                (or (prop (parent event)
-                                          'NAME)
-                                    "unknown")))))
-                   (time ,(let ((dt (prop event 'DTSTART)))
-                            (if (datetime? dt)
-                                (datetime->string dt "~Y-~m-~d ~H:~M")
-                                (date->string dt "~Y-~m-~d" ))))
-                   (span ,(prop event 'SUMMARY)))))
-  (cons
-   (calendar-styles calendars)
-   (for event in list
-        `(details
-          ,(summary event)
-          ;; TODO better format, add show in calendar button
-          ,(fmt-single-event event)))))
-
-;; Format event as text.
-;; Used in
-;; - sidebar
-;; - popup overwiew tab
-;; - search result (event details)
-(define*-public (fmt-single-event ev
-                                  optional: (attributes '())
-                                  key: (fmt-header list))
-  ;; (format (current-error-port) "fmt-single-event: ~a~%" (prop ev 'X-HNH-FILENAME))
-  `(div (@ ,@(assq-merge
-              attributes
-              `((class " eventtext "
-                  ,(when (and (prop ev 'PARTSTAT)
-                              (eq? 'TENTATIVE (prop ev 'PARTSTAT)))
-                     " tentative ")))))
-        (h3 ,(fmt-header
-              (when (prop ev 'RRULE)
-                `(span (@ (class "repeating")) "↺"))
-              `(span (@ (class "summary")) ,(prop ev 'SUMMARY))))
-        (div
-         ,(call-with-values (lambda () (fmt-time-span ev))
-            (case-lambda [(start)
-                          `(div (time (@ (class "dtstart")
-                                         (data-fmt ,(string-append "~L" start))
-                                         (datetime ,(datetime->string
-                                                     (as-datetime (prop ev 'DTSTART))
-                                                     "~1T~3")))
-                                      ,(datetime->string
-                                        (as-datetime (prop ev 'DTSTART))
-                                        start)))]
-                         [(start end)
-                          `(div (time (@ (class "dtstart")
-                                         (data-fmt ,(string-append "~L" start))
-                                         (datetime ,(datetime->string
-                                                     (as-datetime (prop ev 'DTSTART))
-                                                     "~1T~3")))
-                                      ,(datetime->string (as-datetime (prop ev 'DTSTART))
-                                                         start))
-                                " — "
-                                (time (@ (class "dtend")
-                                         (data-fmt ,(string-append "~L" end))
-                                         (datetime ,(datetime->string
-                                                     (as-datetime (prop ev 'DTSTART))
-                                                     "~1T~3")))
-                                      ,(datetime->string (as-datetime (prop ev 'DTEND))
-                                                         end)))]))
-         ,(when (and=> (prop ev 'LOCATION) (negate string-null?))
-            `(div (b "Plats: ")
-                  (div (@ (class "location"))
-                       ,(string-map (lambda (c) (if (char=? c #\,) #\newline c))
-                                    (prop ev 'LOCATION)))))
-         ,(awhen (prop ev 'DESCRIPTION)
-                 `(span (@ (class "description"))
-                        ,(format-description ev it)))
-         ,(awhen (prop ev 'RRULE)
-                 `(span (@ (class "rrule"))
-                        ,@(format-recurrence-rule ev)))
-         ,(when (prop ev 'LAST-MODIFIED)
-            `(span (@ (class "last-modified")) "Senast ändrad "
-                   ,(datetime->string (prop ev 'LAST-MODIFIED) "~1 ~H:~M")))
-
-         )))
-
-
-;; Single event in side bar (text objects)
-(define-public (fmt-day day)
-  (let* (((date . events) day))
-    `(section (@ (class "text-day"))
-              (header (h2 ,(let ((s (date->string date "~Y-~m-~d")))
-                             `(a (@ (href "#" ,s)
-                                    (class "hidelink")) ,s))))
-              ,@(stream->list
-                 (stream-map
-                  (lambda (ev)
-                    (fmt-single-event
-                      ev `((id ,(html-id ev))
-                           (class "CAL_" ,(html-attr (or (prop (parent ev) 'NAME) "unknown"))))
-                      fmt-header:
-                      (lambda body
-                        `(a (@ (href "#" ,(html-id ev) #; (date-link (as-date (prop 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 (prop ev 'DTSTART)))
-                   events))))))
-
-
-(define-public (calendar-styles calendars)
-  `(style
-     ,(format #f "~:{.CAL_~a { --color: ~a; --complement: ~a }~%~}"
-              (map (lambda (c)
-                     (let* ((name (html-attr (prop c 'NAME)))
-                            (bg-color (prop c 'COLOR))
-                            (fg-color (and=> (prop c 'COLOR)
-                                             calculate-fg-color)))
-                       (list name (or bg-color 'white) (or fg-color 'black))))
-                   calendars))))
-
-;; "Physical" block in calendar view
-(define*-public (make-block ev optional: (extra-attributes '()))
-
-  `((a (@ (href "#" ,(html-id ev))
-          (class "hidelink"))
-       (div (@ ,@(assq-merge
-                  extra-attributes
-                  `((id ,(html-id ev))
-                    (data-calendar ,(html-attr (or (prop (parent ev) 'NAME) "unknown")))
-                    (class "event CAL_" ,(html-attr (or (prop (parent ev) 'NAME)
-                                                        "unknown"))
-                      ,(when (and (prop ev 'PARTSTAT)
-                                  (eq? 'TENTATIVE (prop ev 'PARTSTAT)))
-                         " tentative")
-                      ,(when (and (prop ev 'TRANSP)
-                                  (eq? 'TRANSPARENT (prop ev 'TRANSP)))
-                         " transparent")
-                      )
-                    (onclick "toggle_popup('popup' + this.id)")
-                    )))
-            ;; Inner div to prevent overflow. Previously "overflow: none"
-            ;; was set on the surounding div, but the popup /needs/ to
-            ;; overflow (for the tabs?).
-            (div (@ (class "event-body"))
-             ,(when (prop ev 'RRULE)
-                `(span (@ (class "repeating")) "↺"))
-             (span (@ (class "summary"))
-                   ,(format-summary  ev (prop ev 'SUMMARY)))
-             ,(when (prop ev 'LOCATION)
-                `(span (@ (class "location"))
-                       ,(string-map (lambda (c) (if (char=? c #\,) #\newline c))
-                                    (prop ev 'LOCATION)))))
-            (div (@ (style "display:none !important;"))
-                 ,((@ (vcomponent xcal output) ns-wrap)
-                   ((@ (vcomponent xcal output) vcomponent->sxcal)
-                    ev)))))))
-
-
-(define (repeat-info event)
-  `(div (@ (class "eventtext"))
-        (h2 "Upprepningar")
-        (pre ,(prop event 'RRULE))))
-
-
-(define-public (popup ev id)
-  `(div (@ (id ,id) (class "popup-container CAL_" 
-                           ,(html-attr (or (prop (parent ev) 'NAME)
-                                           "unknown"))) 
-           (onclick "event.stopPropagation()"))
-        ;; TODO all (?) code uses .popup-container as the popup, while .popup sits and does nothing.
-        ;; Do something about this?
-        (div (@ (class "popup"))
-             (nav (@ (class "popup-control"))
-                  ,(btn "×"
-                        title: "Stäng"
-                        onclick: "close_popup(document.getElementById(this.closest('.popup-container').id))"
-                        class: '("close-tooltip"))
-                  ,(when (edit-mode)
-                     (list
-                      (btn "🖊️"
-                           title: "Redigera"
-                           onclick: "place_in_edit_mode(document.getElementById(this.closest('.popup-container').id.substr(5)))")
-                      (btn "🗑"
-                           title: "Ta bort"
-                           onclick: "remove_event(document.getElementById(this.closest('.popup-container').id.substr(5)))"))))
-
-             ,(tabset
-                `(("📅" title: "Översikt"
-                   ,(fmt-single-event ev))
-                  ("⤓" title: "Nedladdning"
-                   (div (@ (class "eventtext") (style "font-family:sans"))
-                        (h2 "Ladda ner")
-                        (ul (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".ics"))
-                                   "som iCal"))
-                            (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".xcs"))
-                                   "som xCal")))))
-                  ,@(when (prop ev 'RRULE)
-                      `(("↺" title: "Upprepningar" class: "repeating"
-                         ,(repeat-info ev)))))))))
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))
-- 
cgit v1.2.3