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/srfi | |
| 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/srfi')
| -rw-r--r-- | module/srfi/srfi-19/util.scm | 13 |
1 files changed, 11 insertions, 2 deletions
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))))) |