diff options
| author | Hugo Hörnquist <hugo@hornquist.se> | 2019-05-06 16:16:30 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-05-06 17:58:37 +0200 |
| commit | 740277522010a739b5927407a207a4cae4f49730 (patch) | |
| tree | 4b8721c2169af0b2c3a41eb3f0f8265b35f3cbce /module/output | |
| parent | Add missing leading zeroes in minical. (diff) | |
| download | calp-740277522010a739b5927407a207a4cae4f49730.tar.gz calp-740277522010a739b5927407a207a4cae4f49730.tar.xz | |
Add marker on today in small calendar.
Diffstat (limited to 'module/output')
| -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))))))))) |