diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-23 23:12:30 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-29 15:14:46 +0200 |
commit | 4d0b44375f1e869f6fa69dc09f029e9bf7574c1d (patch) | |
tree | 1ef2214a2a1882c0399c9c23b7560aa27d651965 /module/calp/html/caltable.scm | |
parent | Minor fixes to 'html --help'. (diff) | |
download | calp-4d0b44375f1e869f6fa69dc09f029e9bf7574c1d.tar.gz calp-4d0b44375f1e869f6fa69dc09f029e9bf7574c1d.tar.xz |
Basic support for events in small calendar.
Diffstat (limited to 'module/calp/html/caltable.scm')
-rw-r--r-- | module/calp/html/caltable.scm | 37 |
1 files changed, 31 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")) |