diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-23 23:22:10 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-23 23:22:10 +0200 |
commit | edaf758b80fed1f5f14cd4b192e661c8863e84bc (patch) | |
tree | 9baf17c11a6254e81f29a1c473e5eb86c072aa79 /module/html/caltable.scm | |
parent | Add rendering of standalone small-cal. (diff) | |
download | calp-edaf758b80fed1f5f14cd4b192e661c8863e84bc.tar.gz calp-edaf758b80fed1f5f14cd4b192e661c8863e84bc.tar.xz |
Move html modules under calp.
Diffstat (limited to 'module/html/caltable.scm')
-rw-r--r-- | module/html/caltable.scm | 89 |
1 files changed, 0 insertions, 89 deletions
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)))) |