diff options
Diffstat (limited to '')
-rw-r--r-- | module/calp/html/caltable.scm | 37 | ||||
-rw-r--r-- | module/calp/html/view/calendar.scm | 10 | ||||
-rw-r--r-- | module/calp/html/view/small-calendar.scm | 6 | ||||
-rw-r--r-- | static/_small-calendar.scss | 3 |
4 files changed, 50 insertions, 6 deletions
diff --git a/module/calp/html/caltable.scm b/module/calp/html/caltable.scm index 2f5a6d31..bb642959 100644 --- a/module/calp/html/caltable.scm +++ b/module/calp/html/caltable.scm @@ -3,6 +3,9 @@ :use-module (calp html util) :use-module (datetime) :use-module (srfi srfi-41) + :use-module (srfi srfi-41 util) + :use-module (vcomponent) + :use-module ((vcomponent datetime) :select (events-between)) ) ;; Small calendar similar to the one below. @@ -21,7 +24,17 @@ ;; 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*-public (cal-table key: start-date end-date next-start prev-start + (event-stream stream-null)) + + (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)) + + (define events + (events-between pre-start post-end event-stream)) + (define (->link date) (date->string date "~Y-~m-~d.html")) @@ -34,13 +47,25 @@ ;; 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"))) + (time (@ (class + ,(string-join + (stream->list + (stream-map + (lambda (e) (string-append + "CAL_" (html-attr (prop (parent e) 'NAME)))) + ;; TODO this overshoots, making sunday 00:00 events also + ;; part of saturday. + (events-between + date (add-day date) + events))) + " " 'infix)) + (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)) + (format (current-error-port) "~a events between ~a and ~a~%" + (stream-length events) + (date->string pre-start) + (date->string post-end)) `(div (@ (class "small-calendar")) diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm index a505b586..f908119e 100644 --- a/module/calp/html/view/calendar.scm +++ b/module/calp/html/view/calendar.scm @@ -187,6 +187,16 @@ (div ,(cal-table start-date: start-date end-date: end-date next-start: next-start prev-start: prev-start + event-stream: + ;; TODO propper lookup + (list->stream + (sort* + (children + (find (lambda (c) + (string=? "[alma/]" (prop c 'NAME))) + calendars)) + date/-time< + (extract 'DTSTART))) )) ;; next button diff --git a/module/calp/html/view/small-calendar.scm b/module/calp/html/view/small-calendar.scm index 80cbbaf2..78c7e30f 100644 --- a/module/calp/html/view/small-calendar.scm +++ b/module/calp/html/view/small-calendar.scm @@ -2,6 +2,10 @@ :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)) + + + :use-module ((vcomponent instance methods) :select (get-event-set)) + :use-module ((vcomponent instance) :select (global-event-object)) ) (define-public (render-small-calendar month standalone) @@ -10,6 +14,8 @@ end-date: (remove-day (month+ month)) next-start: month+ prev-start: month- + ;; TODO proper subset + event-stream: (get-event-set global-event-object) )) (if standalone (xhtml-doc diff --git a/static/_small-calendar.scss b/static/_small-calendar.scss index c4814285..6d5bb7ff 100644 --- a/static/_small-calendar.scss +++ b/static/_small-calendar.scss @@ -15,6 +15,9 @@ smaller */ padding: 5px; + + /* TODO different styles for different calendars */ + color: var(--color); } } > *:not(.column-head) { |