diff options
| -rw-r--r-- | util.scm | 7 | ||||
| -rw-r--r-- | vcalendar.scm | 13 | ||||
| -rw-r--r-- | vcalendar/recur.scm | 29 |
3 files changed, 22 insertions, 27 deletions
@@ -2,7 +2,8 @@ #:use-module (srfi srfi-1) #:export (destructure-lambda let-multi fold-lists catch-let for-each-in - define-quick-record define-quick-record!) + define-quick-record define-quick-record! + mod!) #:replace (let*) ) @@ -104,3 +105,7 @@ body ...)))] )) + +;; Like set!, but applies a transformer on the already present value. +(define-syntax-rule (mod! field transform-proc) + (set! field (transform-proc field))) diff --git a/vcalendar.scm b/vcalendar.scm index c664c1aa..143d9e79 100644 --- a/vcalendar.scm +++ b/vcalendar.scm @@ -9,8 +9,8 @@ "Parse all start times into scheme date objects." (for-each-in (children cal 'VEVENT) (lambda (ev) - (transform-attr! ev "DTSTART" parse-datetime) - (transform-attr! ev "DTEND" parse-datetime))) + (mod! (attr ev "DTSTART") parse-datetime) + (mod! (attr ev "DTEND") parse-datetime))) cal) (define-public (make-vcomponent path) @@ -57,15 +57,6 @@ (define-public push-child! %vcomponent-push-child!) (define-public attributes %vcomponent-attribute-list) -(define-public (transform-attr! ev field transformer) - "Apply transformer to field in ev, and store the result back." - ;; TODO make transform C primitive. - ;; Halfing the lookups. - (set! (attr ev field) - (transformer (attr ev field)))) - -;; { (attr ev field) := (transformer (attr ev field)) } - (define-public copy-vcomponent %vcomponent-shallow-copy) (define-public (search cal term) diff --git a/vcalendar/recur.scm b/vcalendar/recur.scm index 3a02aa73..4ca71f29 100644 --- a/vcalendar/recur.scm +++ b/vcalendar/recur.scm @@ -1,13 +1,11 @@ (define-module (vcalendar recur) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-8) ; Recieve #:use-module (srfi srfi-9 gnu) ; Records #:use-module (srfi srfi-19) ; Datetime #:use-module (srfi srfi-19 util) #:use-module (srfi srfi-26) ; Cut #:use-module (srfi srfi-41) ; Streams #:use-module (ice-9 curried-definitions) - ;; #:use-module (ice-9 match) #:use-module (vcalendar) #:use-module (vcalendar datetime) #:use-module (util) @@ -119,28 +117,29 @@ (string-split str #\;)))) (define (generate-next event rule) - (let ((new-event (copy-vcomponent event))) + (let ((ne (copy-vcomponent event))) ; new event (case (freq rule) ((WEEKLY) - (transform-attr! new-event "DTSTART" (cut time-add <> 1 weeks)) - (set! (attr new-event "DTEND") - (add-duration (attr new-event "DTSTART") - (attr new-event "DURATION"))) - (values new-event rule)) + (mod! (attr ne "DTSTART") (cut time-add <> 1 weeks)) + + (set! (attr ne "DTEND") + (add-duration (attr ne "DTSTART") + (attr ne "DURATION"))) + (values ne rule)) ((DAILY) - (transform-attr! new-event "DTSTART" (cut time-add <> 1 days)) - (set! (attr new-event "DTEND") - (add-duration (attr new-event "DTSTART") - (attr new-event "DURATION"))) - (values new-event rule)) + (mod! (attr ne "DTSTART") (cut time-add <> 1 days)) + + (set! (attr ne "DTEND") + (add-duration (attr ne "DTSTART") + (attr ne "DURATION"))) + (values ne rule)) (else (values '() rule))))) (define-stream (recur-event-stream event rule-obj) (stream-cons event - (receive (next-event next-rule) - (generate-next event rule-obj) + (let* ([next-event next-rule (generate-next event rule-obj)]) (if (null? next-event) stream-null (recur-event-stream next-event next-rule))))) |