diff options
Diffstat (limited to 'module/vcomponent/util/instance/methods.scm')
| -rw-r--r-- | module/vcomponent/util/instance/methods.scm | 110 |
1 files changed, 67 insertions, 43 deletions
diff --git a/module/vcomponent/util/instance/methods.scm b/module/vcomponent/util/instance/methods.scm index 7a1d2fc8..6bafb274 100644 --- a/module/vcomponent/util/instance/methods.scm +++ b/module/vcomponent/util/instance/methods.scm @@ -10,10 +10,12 @@ ;; :use-module (vcomponent parse) :use-module ((vcomponent util parse-cal-path) :select (parse-cal-path)) :use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?)) - :use-module ((vcomponent datetime) :select (ev-time<?)) + :use-module ((vcomponent datetime) :select (ev-time<? event-overlaps?)) :use-module (oop goops) :use-module (calp translation) + :use-module ((vcomponent recurrence internal) :select (until count) + :renamer (symbol-prefix-proc (symbol #\r #\r #\:))) :export (add-event remove-event @@ -22,6 +24,7 @@ get-event-by-uid fixed-events-in-range + repeating-events-in-range get-calendar-by-name @@ -60,6 +63,7 @@ (define (make-instance calendar-files) (make <events> calendar-files: calendar-files)) + (define-method (get-event-by-uid (this <events>) uid) (hash-ref (slot-ref this 'uid-map) uid)) @@ -70,10 +74,24 @@ (define-method (fixed-events-in-range (this <events>) start end) + ;; TODO why not use events-between here? (filter-sorted (lambda (ev) ((in-date-range? start end) (as-date (prop ev 'DTSTART)))) (slot-ref this 'fixed-events))) +(define-method (repeating-events-in-range (this <events>) start end) + (filter (lambda (ev) + (cond ((date/-time< end (prop ev 'DTSTART)) #f) + ((and=> (prop ev 'RRULE) rr:until) => (lambda (u) (date/-time< u start))) + ((prop ev 'RRULE) + => (lambda (rr) + (or (not (or (rr:until rr) (rr:count rr))) + ;; else if recurrence set overlaps interval + ;; TODO check this with tests/annoying-events.scm + (stream-find (lambda (instance) (event-overlaps? instance start end)) + (generate-recurrence-set ev))))))) + (slot-ref this 'repeating-events))) + (define-method (initialize (this <events>) args) (next-method) @@ -85,6 +103,7 @@ (let ((calendars (load-calendars (slot-ref this 'calendar-files)))) (apply add-calendars this calendars))) + (define-method (add-calendars (this <events>) . calendars) (slot-set! this 'calendars (append calendars (slot-ref this 'calendars))) @@ -166,61 +185,66 @@ (prop event 'UID))) (slot-ref this 'event-set))) - (hash-set! (slot-ref this 'uid-map) (prop event 'UID) - #f)) + (remove-child! (parent event) event) + (hash-remove! (slot-ref this 'uid-map) (prop event 'UID))) -(define-method (add-and-save-event (this <events>) calendar event) - (cond - [(get-event-by-uid this (prop event 'UID)) - => (lambda (old-event) +(define-method (update-and-save-event (this <events>) calendar old-event) + ;; remove old instance of event from runtime + (remove-event this old-event) - ;; remove old instance of event from runtime - (remove-event this old-event) - (remove-child! (parent old-event) old-event) + ;; Add new event to runtime, + ;; MUST be done after since the two events SHOULD share UID. + ;; NOTE that this can emit warnings + (add-event this calendar old-event) + (remove-child! (parent old-event) old-event) - ;; Add new event to runtime, - ;; MUST be done after since the two events SHOULD share UID. - ;; NOTE that this can emit warnings - (add-event this calendar event) + (set! (prop old-event 'LAST-MODIFIED) + (current-datetime)) - (set! (prop event 'LAST-MODIFIED) - (current-datetime)) + ;; NOTE Posibly defer save to a later point. + ;; That would allow better asyncronous preformance. - ;; NOTE Posibly defer save to a later point. - ;; That would allow better asyncronous preformance. + ;; save-event sets -X-HNH-FILENAME from the UID. This is fine + ;; since the two events are guaranteed to have the same UID. + (unless ((@ (vcomponent formats vdir save-delete) save-event) old-event) + (throw 'misc-error (_ "Saving event to disk failed."))) - ;; save-event sets -X-HNH-FILENAME from the UID. This is fine - ;; since the two events are guaranteed to have the same UID. - (unless ((@ (vcomponent formats vdir save-delete) save-event) event) - (throw 'misc-error (_ "Saving event to disk failed."))) + (unless (eq? calendar (parent old-event)) + ;; change to a new calendar + (format (current-error-port) + (_ "Unlinking old event from ~a~%") + (prop old-event '-X-HNH-FILENAME)) + ;; NOTE that this may fail, leading to a duplicate event being + ;; created (since we save beforehand). This is just a minor problem + ;; which either a better atomic model, or a propper error + ;; recovery log would solve. + ((@ (vcomponent formats vdir save-delete) remove-event) old-event)) - (unless (eq? calendar (parent old-event)) - ;; change to a new calendar - (format (current-error-port) - (_ "Unlinking old event from ~a~%") - (prop old-event '-X-HNH-FILENAME)) - ;; NOTE that this may fail, leading to a duplicate event being - ;; created (since we save beforehand). This is just a minor problem - ;; which either a better atomic model, or a propper error - ;; recovery log would solve. - ((@ (vcomponent formats vdir save-delete) remove-event) old-event)) + (format (current-error-port) + (_ "Event updated ~a~%") (prop old-event 'UID))) - (format (current-error-port) - (_ "Event updated ~a~%") (prop event 'UID)))] - [else - (add-event this calendar event) +;; Add a new event, which isn't already in the event object +(define-method (add-new-event (this <events>) calendar event) + (add-event this calendar event) - (set! (prop event 'LAST-MODIFIED) (current-datetime)) + (set! (prop event 'LAST-MODIFIED) (current-datetime)) - ;; NOTE Posibly defer save to a later point. - ;; That would allow better asyncronous preformance. - (unless ((@ (vcomponent formats vdir save-delete) save-event) event) - (throw 'misc-error (_ "Saving event to disk failed."))) + ;; NOTE Posibly defer save to a later point. + ;; That would allow better asyncronous preformance. + (unless ((@ (vcomponent formats vdir save-delete) save-event) event) + (throw 'misc-error (_ "Saving event to disk failed."))) - (format (current-error-port) - (_ "Event inserted ~a~%") (prop event 'UID))])) + (format (current-error-port) + (_ "Event inserted ~a~%") (prop event 'UID)) + ) + +(define-method (add-and-save-event (this <events>) calendar event) + (cond + [(get-event-by-uid this (prop event 'UID)) + => (lambda (old-event) (update-and-save-event this calendar old-event))] + [else (add-new-event this calendar event)])) |