From 394df06bb40acf307baaedca59778d12e27d6dac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 10 Nov 2019 23:53:50 +0100 Subject: Fix next and prev month buttons. --- module/srfi/srfi-19/util.scm | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) (limited to 'module/srfi/srfi-19') 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 -(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))))) -- cgit v1.2.3