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/html/view/calendar/month.scm | 117 ------------------------------------
 1 file changed, 117 deletions(-)
 delete mode 100644 module/html/view/calendar/month.scm

(limited to 'module/html/view/calendar/month.scm')

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))))
-- 
cgit v1.2.3