diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-04-16 23:23:30 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-04-16 23:23:30 +0200 |
| commit | 82cd952aa2a8ef2ef83f8d4080d8ca124d3cc31c (patch) | |
| tree | bbcdb6b57d770d7ea577025ff0098adf8ee7578b /module/output/html.scm | |
| parent | Add datetime functions for working with week numbers. (diff) | |
| download | calp-82cd952aa2a8ef2ef83f8d4080d8ca124d3cc31c.tar.gz calp-82cd952aa2a8ef2ef83f8d4080d8ca124d3cc31c.tar.xz | |
Add week numbers to HTML small calendar.
Diffstat (limited to 'module/output/html.scm')
| -rw-r--r-- | module/output/html.scm | 16 |
1 files changed, 10 insertions, 6 deletions
diff --git a/module/output/html.scm b/module/output/html.scm index 8de7ad2d..06cd91ee 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -104,11 +104,13 @@ ;; Given a list, partitions it up into sublists of width length, ;;; each starting with 'tr. -(define (tablify list width) +(define* (tablify list width key: (proc identity) (wkst sun)) (unless (null? list) (let* ((row rest (split-at list width))) - (cons `(tr ,@row) - (tablify rest width))))) + (cons `(tr (td ,(week-number (car row) wkst)) ,@(map proc row)) + (tablify rest width + proc: proc + wkst: wkst))))) @@ -521,7 +523,9 @@ ,(day date)))) `(table (@ (class "small-calendar")) - (thead (tr ,@(map (lambda (d) `(td ,(string-titlecase (week-day-name d 2)))) + (thead (tr + (td "v.") + ,@(map (lambda (d) `(td ,(string-titlecase (week-day-name d 2)))) (weekday-list week-start)))) ((tbody ,@(let* ((last current next @@ -529,8 +533,8 @@ ;; it's safe to say that we are interested in the month which ;; start-date is part of (month-days (start-of-month start-date) week-start))) - (tablify (map td (append last current next)) - 7)))))) + (tablify (append last current next) + 7 proc: td wkst: week-start)))))) |