diff options
Diffstat (limited to 'module/output/html.scm')
| -rw-r--r-- | module/output/html.scm | 15 |
1 files changed, 9 insertions, 6 deletions
diff --git a/module/output/html.scm b/module/output/html.scm index 23a7b9ac..1614bc31 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -186,7 +186,7 @@ ;; 22 23 24 25 26 27 28 ;; 29 30 ;; @end example -(define (cal-table date) +(define (cal-table date today) (let ((td (lambda (p) (lambda (d) `(td (@ ,p) ,d))))) `(table (@ (class "small-calendar")) (thead (tr ,@(map (lambda (d) `(td ,d)) '(MÅ TI ON TO FR LÖ SÖ)))) @@ -197,10 +197,12 @@ (month-start (week-day date))) (append (map (td '(class "prev")) (iota month-start (- prev-month-len month-start))) - (map (td '(class "cur")) - (map (lambda (d) `(a (@ (href "#" ,(date->string date "~Y-~m-") - ,(when (< d 10) 0) ,d) - (class "hidelink")) ,d)) + (map (lambda (p) `(td (@ ,@(assq-merge '((class " cur ")) (cdar p))) + ,@(cdr p))) + (map (lambda (d) `((@ (class ,(when (= d (date-day today)) "today"))) + (a (@ (href "#" ,(date->string date "~Y-~m-") + ,(when (< d 10) 0) ,d) + (class "hidelink")) ,d))) (iota month-len 1))) (map (td '(class "next")) (iota (modulo (- (* 7 5) month-len month-start) 7) 1)))))) @@ -248,6 +250,7 @@ ,@(stream->list (stream-map lay-out-day evs)))) (aside (@ (class "sideinfo")) (div (@ (class "about")) - (div ,(cal-table (parse-freeform-date "2019-05-01")))) + (div ,(cal-table (start-of-month start) + (current-date)))) (div (@ (class "eventlist")) ,@(stream->list (stream-map fmt-day evs))))))))) |