From 7c81b056a56eb0f142b99423509994fa2ed4cf71 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Fri, 8 Mar 2019 10:42:59 +0100 Subject: Got DAILY repeating event! --- vcalendar/recur.scm | 33 ++++++++++++++++----------------- 1 file changed, 16 insertions(+), 17 deletions(-) (limited to 'vcalendar') diff --git a/vcalendar/recur.scm b/vcalendar/recur.scm index 15afdd26..a480d946 100644 --- a/vcalendar/recur.scm +++ b/vcalendar/recur.scm @@ -10,7 +10,7 @@ #:use-module (vcalendar) #:use-module (vcalendar datetime) #:use-module (util) - #:export ( build-recur-rules)) + #:export ( build-recur-rules recur-event)) (define-immutable-record-type (make-recur-rules @@ -122,29 +122,28 @@ (define (generate-next event rule) - (match rule - (($ freq until count interval bysecond byminute byhour wkst) - (case freq - ((WEEKLY) - ;; TODO implement copy-event - (let ((new-event (copy-event event))) - (transform-attr! new-event "DTSTART" - (cut date-add <> 1 weeks))))) - - )) - - ) + (let ((new-event (copy-vcomponent event))) + (match rule + (($ freq until count interval bysecond byminute byhour wkst) + (case freq + ((WEEKLY) (transform-attr! new-event "DTSTART" (cut date-add <> 1 weeks)) + (values new-event rule)) + ((DAILY) (transform-attr! new-event "DTSTART" (cut date-add <> 1 days)) + (values new-event rule)) + (else (values '() rule)))) + (_ (values event rule))))) (define-stream (recur-event-stream event rule-obj) (stream-cons event - (receive (next-event next-rule) (generate-next event rule-obj) - (recur-event-stream next-event next-rule)))) + (receive (next-event next-rule) + (generate-next event rule-obj) + (if (null? next-event) + stream-null + (recur-event-stream next-event next-rule))))) (define (recur-event event) (recur-event-stream event (build-recur-rules (get-attr event "RRULE")))) - - (define tzero (make-time time-utc 0 0)) (define dzero (time-utc->date tzero)) -- cgit v1.2.3