Really start breaking apart HTML.

8 files changed, 758 insertions, 663 deletions

diff --git a/module/html/config.scm b/module/html/config.scm
new file mode 100644
index 00000000..3ae0e1da
--- /dev/null
+++ b/module/html/config.scm
@@ -0,0 +1,18 @@
+(define-module (html config)
+  :use-module (util)
+  :use-module (util config)
+  )
+
+(define-public debug (make-parameter #f))
+(define-config debug #f
+  "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
+  "Makes the document editable"
+  post: edit-mode)
+
diff --git a/module/html/vcomponent.scm b/module/html/vcomponent.scm
index 5e17932c..f9c24ecd 100644
--- a/module/html/vcomponent.scm
+++ b/module/html/vcomponent.scm
@@ -5,10 +5,12 @@
   :use-module (srfi srfi-41)
   :use-module (datetime)
   :use-module (html util)
+  :use-module ((html components) :select (btn tabset))
   :use-module ((output general) :select (calculate-fg-color))
   :use-module ((vcomponent datetime output)
                :select (fmt-time-span
                         format-description
+                        format-summary
                         format-recurrence-rule
                                       ))
   )
@@ -126,3 +128,63 @@
                   (list name (or bg-color 'white) (or fg-color 'black)
                         name (or bg-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))
+                    (class "event CAL_" ,(html-attr (or (prop (parent ev) 'NAME)
+                                                        "unknown"))
+                      ,(when (and (prop ev 'PARTSTAT)
+                                  (eq? 'TENTATIVE (prop ev 'PARTSTAT)))
+                         " tentative"))
+                    (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;"))
+                 ,((@ (output xcal) ns-wrap)
+                   ((@ (output xcal) vcomponent->sxcal)
+                    ev)))))))
+
+
+
+(define-public (popup ev id)
+  `(div (@ (class "popup-container") (id ,id)
+           (onclick "event.stopPropagation()"))
+        (div (@ (class "popup"))
+             (nav (@ (class "popup-control CAL_"
+                       ,(html-attr (or (prop (parent ev) 'NAME)
+                                       "unknown"))))
+                  ,(btn "×"
+                        title: "Stäng"
+                        onclick: "close_popup(document.getElementById(this.closest('.popup-container').id))"
+                        class: '("close-tooltip"))
+                  ,(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 (@ (style "font-family:sans"))
+                       (p "Ladda ner")
+                       (ul (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".ics"))
+                                  "som iCal"))
+                           (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".xcs"))
+                                  "som xCal"))))))))))
diff --git a/module/html/view/calendar.scm b/module/html/view/calendar.scm
new file mode 100644
index 00000000..da1d6c9b
--- /dev/null
+++ b/module/html/view/calendar.scm
@@ -0,0 +1,335 @@
+(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 (util config)
+  :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 (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))
+  :use-module ((git)
+               :select (get-git-version))
+  )
+
+;; date should be start of month
+;; @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
+;; date - a date in the month to display
+;; week-start - which day the week begins on, see (datetime util)
+(define* (cal-table key: start-date end-date next-start prev-start
+                    (week-start (get-config 'week-start)))
+
+  (define (td date)
+    `(a (@ ,@(cond
+              ;; We are before our time interval
+              [(date< date start-date)
+               ;; TODO find a prettier way to generate links to previous and next time intervals
+               `((class "prev")
+                 (href ,(date->string
+                         (stream-find (lambda (d) (date<= d date (next-start d)))
+                                      (stream-iterate prev-start start-date))
+                         "~Y-~m-~d.html")
+                       "#" ,(date-link date)))]
+              ;; We are after our time interval
+              [(date< end-date date)
+               `((class "next")
+                 (href ,(date->string
+                         (stream-find (lambda (d) (and (date<= d date)
+                                                  (date< date (next-start d))))
+                                      (stream-iterate next-start start-date))
+                         "~Y-~m-~d.html")
+                       "#" ,(date-link date)))]
+              ;; We are in our time interval
+              [else `((href "#" ,(date-link 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))))
+
+  (let* ((last-months current next
+                      (month-days (start-of-month start-date) week-start))
+         (events (append last-months current next)))
+    `(div (@ (class "small-calendar"))
+          (div (@ (class "column-head row-head")) "v.")
+          ,@(map (lambda (d) `(div (@ (class "column-head"))
+                              ,(string-titlecase (week-day-name d 2))))
+                 (weekday-list week-start))
+          ,@(let ((first (start-of-week (car events) week-start))
+                  (last (start-of-week (last events) week-start)))
+              (map (lambda (v) `(div (@ (class "row-head")) ,v))
+                   (map (lambda (d) (week-number d week-start))
+                        (stream->list
+                         (stream-take-while (lambda (s) (date<= s last))
+                                            (week-stream first))))))
+          ,@(map td events
+                 ))))
+
+
+
+
+;;; 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.
+
+(define repo-url (make-parameter "https://git.hornquist.se"))
+
+(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"))
+
+  ;; (display "<!doctype HTML>\n")
+  (;;(@ (ice-9 pretty-print) pretty-print)
+   (@ (sxml simple) sxml->xml)
+   (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=true;")
+
+     (style ,(format #f "html {
+    --editmode: 1.0;
+    --event-font-size: 8pt;
+    --gray: #757575;
+    --btn-height: 0.5ex;
+}"))
+
+     ,(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
+                              )
+
+           ,@(for event in (stream->list
+                            (events-between pre-start post-end events))
+                  (popup event (string-append "popup" (html-id event)))))
+
+          ;; Page footer
+          (footer
+           (@ (style "grid-area: footer"))
+           (span "Page generated " ,(date->string (current-date)))
+           (span (a (@ (href ,(repo-url) "/calparse"))
+                    "Source Code"))
+           ,(let* ((long-hash short-hash (get-git-version))
+                   (url (format #f "~a/calparse/commit/?id=~a"
+                                (repo-url) long-hash)))
+              `(span "Version " (a (@ (href ,url)) ,short-hash))))
+
+          ;; 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 (get-config 'week-start))
+                                     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_bg_"
+                                           ,(html-attr (prop calendar 'NAME))))
+                                      ,(prop calendar '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"))
+                        ,@(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: "New Event"))))
+              (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
new file mode 100644
index 00000000..f02a10d6
--- /dev/null
+++ b/module/html/view/calendar/month.scm
@@ -0,0 +1,110 @@
+(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 (util 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))))
+
+  `((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 (get-config 'week-start)))
+         ,@(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)
+             )))))
+
+
+
+;;; 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
new file mode 100644
index 00000000..d1f58460
--- /dev/null
+++ b/module/html/view/calendar/shared.scm
@@ -0,0 +1,96 @@
+(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
new file mode 100644
index 00000000..7da186e1
--- /dev/null
+++ b/module/html/view/calendar/week.scm
@@ -0,0 +1,114 @@
+(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)))
+    `((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))))))))
+
+
+
+(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/output/html.scm b/module/output/html.scm
index 3125f38b..86b684bc 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -4,16 +4,15 @@
   #:use-module (srfi srfi-41)
   #:use-module (srfi srfi-41 util)
   #:use-module (vcomponent)
-  #:use-module (vcomponent group)
+  ;; #:use-module (vcomponent group)
   #:use-module (vcomponent datetime)
-  #:use-module (vcomponent build)
   #:use-module (util)
   #:use-module (util exceptions)
   #:use-module (util config)
-  #:use-module (util tree)
+  ;; #:use-module (util tree)
   #:duplicates (last)
   #:use-module (datetime)
-  #:use-module (ice-9 curried-definitions)
+  ;; #:use-module (ice-9 curried-definitions)
   #:use-module (ice-9 match)
   #:use-module (text util)
   #:use-module (vcomponent datetime output)
@@ -21,668 +20,17 @@
   #:use-module (html components)
   #:use-module (html util)
   #:use-module (html vcomponent)
+  #:use-module ((html view calendar)
+                :select (html-generate))
 
-  #:autoload (vcomponent instance) (global-event-object)
-
-  #:use-module (git)
-  ;; #:use-module (module config all)
-  )
-
-(define debug (make-parameter #f))
-(define-config debug #f
-  "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 edit-mode (make-parameter #t))
-(define-config edit-mode #t
-  "Makes the document editable"
-  post: edit-mode)
-
-
-
-
-(define (popup ev id)
-  `(div (@ (class "popup-container") (id ,id)
-           (onclick "event.stopPropagation()"))
-        (div (@ (class "popup"))
-             (nav (@ (class "popup-control CAL_"
-                       ,(html-attr (or (prop (parent ev) 'NAME)
-                                       "unknown"))))
-                  ,(btn "×"
-                        title: "Stäng"
-                        onclick: "close_popup(document.getElementById(this.closest('.popup-container').id))"
-                        class: '("close-tooltip"))
-                  ,(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 (@ (style "font-family:sans"))
-                       (p "Ladda ner")
-                       (ul (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".ics"))
-                                  "som iCal"))
-                           (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".xcs"))
-                                  "som xCal"))))))))))
-
-
-
-;;; Procedures for wide output
-
-
-(define x-pos (make-object-property))
-(define 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* (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* (make-block ev optional: (extra-attributes '()))
-
-  `((a (@ (href "#" ,(html-id ev))
-          (class "hidelink"))
-       (div (@ ,@(assq-merge
-                  extra-attributes
-                  `((id ,(html-id ev))
-                    (class "event CAL_" ,(html-attr (or (prop (parent ev) 'NAME)
-                                                        "unknown"))
-                      ,(when (and (prop ev 'PARTSTAT)
-                                  (eq? 'TENTATIVE (prop ev 'PARTSTAT)))
-                         " tentative"))
-                    (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;"))
-                 ,((@ (output xcal) ns-wrap)
-                   ((@ (output xcal) vcomponent->sxcal)
-                    ev)))))))
-
-;; Format single event for graphical display
-(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))))
-
-;; 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 (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))))
-
-
-;; 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))))
-
-
-(define (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))
-
-
-(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)))))
-
-
-(define*-public (render-calendar key: events start-date end-date #:allow-other-keys)
-  (let* ((long-events short-events (partition long-event? (stream->list (events-between start-date end-date events))))
-         (range (date-range start-date end-date)))
-    `((div (@ (class "calendar"))
-           (div (@ (class "days"))
-                ,@(time-marker-div)
-                (div (@ (class "longevents 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))))))))
-
-
-
-;;; 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))))
-
-;; Natural numbers from 1 and up, each number repeated 7 times.
-(define (repeating-naturals from repeats)
-  (stream-unfold
-   cdr                      ; map
-   (const #t)               ; continue?
-   (lambda (x)                   ; gen next
-     (if (= (1- repeats) (car x))
-         (cons 0 (1+ (cdr x)))
-         (cons (1+ (car x)) (cdr x))))
-   (cons 0 from)))
+  #:use-module ((html view calendar week)
+                :select (render-calendar))
 
-;; (stream event-group) -> sxml
-(define*-public (render-calendar-table key: events start-date end-date pre-start post-end #:allow-other-keys)
+  #:use-module ((html view calendar month)
+                :select (render-calendar-table))
 
-  (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))))
-
-  `((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 (get-config 'week-start)))
-         ,@(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)
-             )))))
-
-
-
-
-
-;; date should be start of month
-;; @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
-;; date - a date in the month to display
-;; week-start - which day the week begins on, see (datetime util)
-(define* (cal-table key: start-date end-date next-start prev-start
-                    (week-start (get-config 'week-start)))
-
-  (define (td date)
-    `(a (@ ,@(cond
-              ;; We are before our time interval
-              [(date< date start-date)
-               ;; TODO find a prettier way to generate links to previous and next time intervals
-               `((class "prev")
-                 (href ,(date->string
-                         (stream-find (lambda (d) (date<= d date (next-start d)))
-                                      (stream-iterate prev-start start-date))
-                         "~Y-~m-~d.html")
-                       "#" ,(date-link date)))]
-              ;; We are after our time interval
-              [(date< end-date date)
-               `((class "next")
-                 (href ,(date->string
-                         (stream-find (lambda (d) (and (date<= d date)
-                                                  (date< date (next-start d))))
-                                      (stream-iterate next-start start-date))
-                         "~Y-~m-~d.html")
-                       "#" ,(date-link date)))]
-              ;; We are in our time interval
-              [else `((href "#" ,(date-link 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))))
-
-  (let* ((last-months current next
-                      (month-days (start-of-month start-date) week-start))
-         (events (append last-months current next)))
-    `(div (@ (class "small-calendar"))
-          (div (@ (class "column-head row-head")) "v.")
-          ,@(map (lambda (d) `(div (@ (class "column-head"))
-                              ,(string-titlecase (week-day-name d 2))))
-                 (weekday-list week-start))
-          ,@(let ((first (start-of-week (car events) week-start))
-                  (last (start-of-week (last events) week-start)))
-              (map (lambda (v) `(div (@ (class "row-head")) ,v))
-                   (map (lambda (d) (week-number d week-start))
-                        (stream->list
-                         (stream-take-while (lambda (s) (date<= s last))
-                                            (week-stream first))))))
-          ,@(map td events
-                 ))))
-
-
-
-;;; 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.
-
-(define repo-url (make-parameter "https://git.hornquist.se"))
-
-(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"))
-
-  ;; (display "<!doctype HTML>\n")
-  (;;(@ (ice-9 pretty-print) pretty-print)
-   (@ (sxml simple) sxml->xml)
-   (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=true;")
-
-     (style ,(format #f "html {
-    --editmode: 1.0;
-    --event-font-size: 8pt;
-    --gray: #757575;
-    --btn-height: 0.5ex;
-}"))
-
-     ,(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
-                              )
-
-           ,@(for event in (stream->list
-                            (events-between pre-start post-end events))
-                  (popup event (string-append "popup" (html-id event)))))
-
-          ;; Page footer
-          (footer
-           (@ (style "grid-area: footer"))
-           (span "Page generated " ,(date->string (current-date)))
-           (span (a (@ (href ,(repo-url) "/calparse"))
-                    "Source Code"))
-           ,(let* ((long-hash short-hash (get-git-version))
-                   (url (format #f "~a/calparse/commit/?id=~a"
-                                (repo-url) long-hash)))
-              `(span "Version " (a (@ (href ,url)) ,short-hash))))
-
-          ;; 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 (get-config 'week-start))
-                                     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_bg_"
-                                           ,(html-attr (prop calendar 'NAME))))
-                                      ,(prop calendar '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"))
-                        ,@(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: "New Event"))))
-              (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 ")))))
-           (div (@ (class "template") (id "popup-template"))
-                ,(popup event (string-append "popup" (html-id event))))))))))
+  #:autoload (vcomponent instance) (global-event-object)
+  )
 
 
 
diff --git a/module/srfi/srfi-41/util.scm b/module/srfi/srfi-41/util.scm
index 51671985..eda379a7 100644
--- a/module/srfi/srfi-41/util.scm
+++ b/module/srfi/srfi-41/util.scm
@@ -77,6 +77,18 @@
 (define-public (stream->values stream)
   (apply values (stream->list stream)))
 
+
+;; Natural numbers from 1 and up, each number repeated 7 times.
+(define-public (repeating-naturals from repeats)
+  (stream-unfold
+   cdr                      ; map
+   (const #t)               ; continue?
+   (lambda (x)                   ; gen next
+     (if (= (1- repeats) (car x))
+         (cons 0 (1+ (cdr x)))
+         (cons (1+ (car x)) (cdr x))))
+   (cons 0 from)))
+
 ;; Returns two values. A stream of all the elements in stream
 ;; which satisfiy @var{pred}, and a stream of those elements
 ;; that don't. @var{pred} is called once per value in the