diff options
Diffstat (limited to 'module/vcomponent/recurrence/generate.scm')
| -rw-r--r-- | module/vcomponent/recurrence/generate.scm | 54 |
1 files changed, 26 insertions, 28 deletions
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm index 07305647..936c2631 100644 --- a/module/vcomponent/recurrence/generate.scm +++ b/module/vcomponent/recurrence/generate.scm @@ -119,7 +119,7 @@ (branching-fold (lambda (rule dt) (let* ((key value (car+cdr rule)) - (d (if (date? dt) dt (get-date dt))) + (d (if (date? dt) dt (datetime-date dt))) ;; NOTE It's proably an error to give BYHOUR, BYMINUTE, and BYSECOND ;; rules for a date object. This doesn't warn if those are given, but ;; instead silently discards them. @@ -128,8 +128,8 @@ (if (date? dt) (if (date? o) o d) (if (date? o) - (datetime date: o time: t tz: (get-timezone dt)) - (datetime date: d time: o tz: (get-timezone dt))))))) + (datetime date: o time: t tz: (tz dt)) + (datetime date: d time: o tz: (tz dt))))))) (case key [(BYMONTH) (if (and (eq? 'YEARLY (freq rrule)) @@ -141,11 +141,11 @@ (concatenate (map (lambda (wday) (all-wday-in-month - wday (start-of-month (set (month d) value)))) + wday (start-of-month (month d value)))) (map cdr (byday rrule))))) ;; else - (to-dt (set (month d) value)))] + (to-dt (month d value)))] [(BYDAY) (let* ((offset value (car+cdr value))) @@ -201,12 +201,12 @@ [(BYYEARDAY) (to-dt (date+ (start-of-year d) (date day: (1- value))))] [(BYMONTHDAY) - (to-dt (set (day d) + (to-dt (day d (if (positive? value) value (+ 1 value (days-in-month d)))))] - [(BYHOUR) (to-dt (set (hour t) value))] - [(BYMINUTE) (to-dt (set (minute t) value))] - [(BYSECOND) (to-dt (set (second t) value))] + [(BYHOUR) (to-dt (hour t value))] + [(BYMINUTE) (to-dt (minute t value))] + [(BYSECOND) (to-dt (second t value))] [else (scm-error 'wrong-type-arg "update" "Unrecognized by-extender ~s" key #f)]))) @@ -254,7 +254,7 @@ (extend-recurrence-set rrule (if (date? base-date) - (date+ base-date (get-date (make-date-increment rrule))) + (date+ base-date (datetime-date (make-date-increment rrule))) (datetime+ base-date (make-date-increment rrule)))))) (define ((month-mod d) value) @@ -273,7 +273,7 @@ #t (let ((key values (car+cdr (car remaining))) (t (as-time dt)) - (d (if (date? dt) dt (get-date dt)))) + (d (if (date? dt) dt (datetime-date dt)))) (and (case key [(BYMONTH) (memv (month d) values)] [(BYMONTHDAY) (memv (day d) (map (month-mod d) values))] @@ -339,10 +339,10 @@ (rrule-instances-raw rrule (prop event 'DTSTART)))) (else stream-null))) (rdates - (cond ((prop* event 'RDATE) => (lambda (v) (map value v))) + (cond ((prop* event 'RDATE) => (lambda (v) (map vline-value v))) (else '()))) (exdates - (cond ((prop* event 'EXDATE) => (lambda (v) (map value v))) + (cond ((prop* event 'EXDATE) => (lambda (v) (map vline-value v))) (else #f)))) (let ((items (interleave-streams @@ -418,21 +418,19 @@ => (lambda (ht) (aif (hash-ref ht dt) it ; RECURRENCE-ID objects come with their own DTEND - (let ((ev (copy-vcomponent base-event))) - (set! (prop ev 'DTSTART) dt) - (when duration ; (and (not (prop ev 'DTEND)) duration) - ;; p. 123 (3.8.5.3 Recurrence Rule) - ;; specifies that the DTEND should be updated to match how the - ;; initial dtend related to the initial DTSTART. It also notes - ;; that an event of 1 day in length might be longer or shorter - ;; than 24h depending on timezone shifts. - (set! (prop ev 'DTEND) (get-endtime dt duration))) - ev)))) + (let ((ev (prop base-event 'DTSTART dt))) + (if duration ; (and (not (prop ev 'DTEND)) duration) + ;; p. 123 (3.8.5.3 Recurrence Rule) + ;; specifies that the DTEND should be updated to match how the + ;; initial dtend related to the initial DTSTART. It also notes + ;; that an event of 1 day in length might be longer or shorter + ;; than 24h depending on timezone shifts. + (prop ev 'DTEND (get-endtime dt duration)) + ev))))) (else - (let ((ev (copy-vcomponent base-event))) - (set! (prop ev 'DTSTART) dt) - (when duration - (set! (prop ev 'DTEND) (get-endtime dt duration))) - ev)))) + (let ((ev (prop base-event 'DTSTART dt))) + (if duration + (prop ev 'DTEND (get-endtime dt duration)) + ev))))) rrule-stream)) |