diff options
| author | Hugo Hörnquist <hugo@hornquist.se> | 2019-11-10 23:53:50 +0100 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-11-10 23:53:58 +0100 |
| commit | 394df06bb40acf307baaedca59778d12e27d6dac (patch) | |
| tree | e902cf87c49bae648114710a1482b0edfda3b273 /module | |
| parent | Work on HTML output. (diff) | |
| download | calp-394df06bb40acf307baaedca59778d12e27d6dac.tar.gz calp-394df06bb40acf307baaedca59778d12e27d6dac.tar.xz | |
Fix next and prev month buttons.
Diffstat (limited to 'module')
| -rw-r--r-- | module/output/html.scm | 14 | ||||
| -rw-r--r-- | module/srfi/srfi-19/util.scm | 13 |
2 files changed, 20 insertions, 7 deletions
diff --git a/module/output/html.scm b/module/output/html.scm index b3adefd6..cd983955 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -265,12 +265,16 @@ `(span "Version " (a (@ (href ,url)) ,hash))))) (aside (@ (class "sideinfo")) (div (@ (class "about")) - (div (@ (class "nav")) - (a (@ (href "#")) "«")) + (a (@ (href ,(date->string (set (date-month start) = (- 1)) "~Y-~m-~d") ".html") + (class "nav hidelink")) + (div (@ (class "nav")) + "«")) (div ,(cal-table (start-of-month start) (current-date))) - (div (@ (class "nav")) - (a (@ (href "#")) "»"))) + (a (@ (href ,(date->string (set (date-month start) = (+ 1)) "~Y-~m-~d") ".html") + (class "nav hidelink")) + (div (@ (class "nav")) + "»"))) (div (@ (class "eventlist")) ,@(stream->list (stream-map fmt-day evs))))))))) @@ -297,7 +301,7 @@ (let ((ms (month-stream start))) (stream-take 12 (stream-zip - ms (stream-map (lambda (d) (normalize-date** + ms (stream-map (lambda (d) (normalize-date (set (date-day d) = (- 1)))) (stream-cdr ms)))) ))) diff --git a/module/srfi/srfi-19/util.scm b/module/srfi/srfi-19/util.scm index e4439da5..09900bf2 100644 --- a/module/srfi/srfi-19/util.scm +++ b/module/srfi/srfi-19/util.scm @@ -120,7 +120,7 @@ attribute set to 0. Can also be seen as \"Start of day\"" (set (date-second next-date) 0)) ;; date x (date → date) → stream<date> -(define (date-increment-stream start-date transfer-proc) +(define (date-increment-stream* start-date transfer-proc) (stream-iterate (lambda (d) (drop-time @@ -130,9 +130,18 @@ attribute set to 0. Can also be seen as \"Start of day\"" (set (date-hour (transfer-proc d)) = (+ 1))))) (drop-time start-date))) +;; Just dropping timezones seems to work when we are dealing with months... +(define (date-increment-stream start-date transfer-proc) + (stream-iterate + (lambda (d) + (drop-time + (normalize-date + (transfer-proc d)))) + (drop-time start-date))) + ;; Returns a stream of date objects, one day appart, staring from start-day. (define-public (day-stream start-day) - (date-increment-stream start-day (lambda (d) (set (date-day d) = (+ 1))))) + (date-increment-stream* start-day (lambda (d) (set (date-day d) = (+ 1))))) (define-public (month-stream start-date) (date-increment-stream start-date (lambda (d) (set (date-month d) = (+ 1))))) |