diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2019-03-08 10:42:59 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-03-08 10:42:59 +0100 |
commit | 7c81b056a56eb0f142b99423509994fa2ed4cf71 (patch) | |
tree | 94d17346d50beaeeab5c29b393c8191267df62c7 /vcalendar | |
parent | Varius minor fixes. (diff) | |
download | calp-7c81b056a56eb0f142b99423509994fa2ed4cf71.tar.gz calp-7c81b056a56eb0f142b99423509994fa2ed4cf71.tar.xz |
Got DAILY repeating event!
Diffstat (limited to 'vcalendar')
-rw-r--r-- | vcalendar/recur.scm | 33 |
1 files changed, 16 insertions, 17 deletions
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 (<recur-rule> build-recur-rules)) + #:export (<recur-rule> build-recur-rules recur-event)) (define-immutable-record-type <recur-rule> (make-recur-rules @@ -122,29 +122,28 @@ (define (generate-next event rule) - (match rule - (($ <recur-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 + (($ <recur-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)) |