diff options
Diffstat (limited to '')
-rw-r--r-- | module/vcomponent.scm | 14 | ||||
-rw-r--r-- | module/vcomponent/base.scm | 44 | ||||
-rw-r--r-- | module/vcomponent/control.scm | 12 | ||||
-rw-r--r-- | module/vcomponent/datetime.scm | 112 | ||||
-rw-r--r-- | module/vcomponent/group.scm | 12 | ||||
-rw-r--r-- | module/vcomponent/parse.scm | 28 | ||||
-rw-r--r-- | module/vcomponent/parse/component.scm | 10 | ||||
-rw-r--r-- | module/vcomponent/parse/xcal.scm | 4 | ||||
-rw-r--r-- | module/vcomponent/recurrence/generate.scm | 30 | ||||
-rw-r--r-- | module/vcomponent/recurrence/internal.scm | 6 |
10 files changed, 134 insertions, 138 deletions
diff --git a/module/vcomponent.scm b/module/vcomponent.scm index 01640bb8..5616394c 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -59,12 +59,12 @@ (setf 'uid-map (let ((ht (make-hash-table))) - (for-each (lambda (event) (hash-set! ht (attr event 'UID) event)) (getf 'events)) + (for-each (lambda (event) (hash-set! ht (prop event 'UID) event)) (getf 'events)) ht))) (define-method (fixed-events-in-range start end) (filter-sorted (lambda (ev) ((in-date-range? start end) - (as-date (attr ev 'DTSTART)))) + (as-date (prop ev 'DTSTART)))) (getf 'fixed-events))) (define-method (get-event-by-uid uid) @@ -88,23 +88,23 @@ (define / file-name-separator-string) (define-public (calendar-import calendar event) - (case (attr calendar 'X-HNH-SOURCETYPE) + (case (prop calendar 'X-HNH-SOURCETYPE) [(file) (error "Importing into direct calendar files not supported")] [(vdir) - (let* ((uid (or (attr event 'UID) (uuidgen))) + (let* ((uid (or (prop event 'UID) (uuidgen))) ;; copy to enusre writable string - (tmpfile (string-copy (string-append (attr calendar 'X-HNH-DIRECTORY) + (tmpfile (string-copy (string-append (prop calendar 'X-HNH-DIRECTORY) / ".calp-" uid "XXXXXX"))) (port (mkstemp! tmpfile))) - (set! (attr event 'UID) uid) + (set! (prop event 'UID) uid) (with-output-to-port port (lambda () (print-components-with-fake-parent (list event)))) ;; does close flush? (force-output port) (close-port port) - (rename-file tmpfile (string-append (attr calendar 'X-HNH-DIRECTORY) + (rename-file tmpfile (string-append (prop calendar 'X-HNH-DIRECTORY) / uid ".ics")) uid)] diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm index e5bca46e..6b9363b6 100644 --- a/module/vcomponent/base.scm +++ b/module/vcomponent/base.scm @@ -22,7 +22,6 @@ ;;; </vcomponent> ;;; -;; The <vline> type is a bit to many times refered to as a attr ptr. (define-record-type <vline> (make-vline% key value parameters) vline? @@ -106,38 +105,35 @@ (make-procedure-with-setter get-vline-value set-vline-value!)) -;;; TODO all these set-attr should be set-prop, but -;;; set-prop is already used by what should be set-param. - ;; vcomponent x (or str symb) → vline -(define (get-attr* component attr) +(define (get-prop* component prop) (hashq-ref (get-component-properties component) - (as-symb attr))) + (as-symb prop))) -(define (set-attr*! component key value) +(define (set-prop*! component key value) (hashq-set! (get-component-properties component) (as-symb key) value)) -(define-public attr* +(define-public prop* (make-procedure-with-setter - get-attr* - set-attr*!)) + get-prop* + set-prop*!)) ;; vcomponent x (or str symb) → value -(define (get-attr component key) - (let ((attrs (get-attr* component key))) - (cond [(not attrs) #f] - [(list? attrs) (map value attrs)] - [else (value attrs)]))) +(define (get-prop component key) + (let ((props (get-prop* component key))) + (cond [(not props) #f] + [(list? props) (map value props)] + [else (value props)]))) ;; TODO do something sensible here -(define (set-attr! component key value) +(define (set-prop! component key value) (set-property! component (as-symb key) value)) -(define-public attr +(define-public prop (make-procedure-with-setter - get-attr - set-attr!)) + get-prop + set-prop!)) (define-public param @@ -152,11 +148,11 @@ (hashq-set! (get-vline-parameters vline) (as-symb parameter-key) val)))) -;; Returns the properties of attribute as an assoc list. +;; Returns the parameters of a property as an assoc list. ;; @code{(map car <>)} leads to available properties. ;; TODO shouldn't this be called parameters? -(define-public (parameters attrptr) - (hash-map->list list (get-vline-parameters attrptr))) +(define-public (parameters vline) + (hash-map->list list (get-vline-parameters vline))) (define-public (properties component) (get-component-properties component)) @@ -184,10 +180,10 @@ (get-component-properties component))))) (define-public (extract field) - (lambda (e) (attr e field))) + (lambda (e) (prop e field))) (define-public (extract* field) - (lambda (e) (attr* e field))) + (lambda (e) (prop* e field))) (define-public (key=? k1 k2) (eq? (as-symb k1) diff --git a/module/vcomponent/control.scm b/module/vcomponent/control.scm index b9f7bd19..6003c7ca 100644 --- a/module/vcomponent/control.scm +++ b/module/vcomponent/control.scm @@ -1,7 +1,7 @@ (define-module (vcomponent control) #:use-module (util) #:use-module (vcomponent) - #:export (with-replaced-attrs)) + #:export (with-replaced-properties)) (eval-when (expand load) ; No idea why I must have load here. @@ -10,19 +10,19 @@ (define (set-temp-values! table component kvs) (for-each (lambda (kv) (let* (((key val) kv)) - (when (attr component key) - (set! (href table key) (attr component key)) - (set! (attr component key) val)))) + (when (prop component key) + (set! (href table key) (prop component key)) + (set! (prop component key) val)))) kvs)) (define (restore-values! table component keys) (for-each (lambda (key) (and=> (href table key) (lambda (val) - (set! (attr component key) val)))) + (set! (prop component key) val)))) keys))) -(define-syntax with-replaced-attrs +(define-syntax with-replaced-properties (syntax-rules () [(_ (component (key val) ...) body ...) diff --git a/module/vcomponent/datetime.scm b/module/vcomponent/datetime.scm index f4f517eb..79ebb5f5 100644 --- a/module/vcomponent/datetime.scm +++ b/module/vcomponent/datetime.scm @@ -28,22 +28,22 @@ (define (event-overlaps? event begin end) "Returns if the event overlaps the timespan. -Event must have the DTSTART and DTEND attribute set." - (timespan-overlaps? (attr event 'DTSTART) - (or (attr event 'DTEND) (attr event 'DTSTART)) +Event must have the DTSTART and DTEND protperty set." + (timespan-overlaps? (prop event 'DTSTART) + (or (prop event 'DTEND) (prop event 'DTSTART)) begin end)) (define (overlapping? event-a event-b) - (timespan-overlaps? (attr event-a 'DTSTART) - (or (attr event-a 'DTEND) - (if (date? (attr event-a 'DTSTART)) - (date+ (attr event-a 'DTSTART) (date day: 1)) - (attr event-a 'DTSTART))) - (attr event-b 'DTSTART) - (or (attr event-b 'DTEND) - (if (date? (attr event-b 'DTSTART)) - (date+ (attr event-b 'DTSTART) (date day: 1)) - (attr event-b 'DTSTART))))) + (timespan-overlaps? (prop event-a 'DTSTART) + (or (prop event-a 'DTEND) + (if (date? (prop event-a 'DTSTART)) + (date+ (prop event-a 'DTSTART) (date day: 1)) + (prop event-a 'DTSTART))) + (prop event-b 'DTSTART) + (or (prop event-b 'DTEND) + (if (date? (prop event-b 'DTSTART)) + (date+ (prop event-b 'DTSTART) (date day: 1)) + (prop event-b 'DTSTART))))) (define (event-contains? ev date/-time) "Does event overlap the date that contains time." @@ -52,49 +52,49 @@ Event must have the DTSTART and DTEND attribute set." (event-overlaps? ev start end))) (define-public (event-zero-length? ev) - (and (datetime? (attr ev 'DTSTART)) - (not (attr ev 'DTEND)))) + (and (datetime? (prop ev 'DTSTART)) + (not (prop ev 'DTEND)))) (define-public (ev-time<? a b) - (date/-time<? (attr a 'DTSTART) - (attr b 'DTSTART))) + (date/-time<? (prop a 'DTSTART) + (prop b 'DTSTART))) ;; Returns length of the event @var{e}, as a time-duration object. (define-public (event-length e) - (if (not (attr e 'DTEND)) - (if (date? (attr e 'DTSTART)) + (if (not (prop e 'DTEND)) + (if (date? (prop e 'DTSTART)) (date day: 1) (datetime)) - ((if (date? (attr e 'DTSTART)) + ((if (date? (prop e 'DTSTART)) date-difference datetime-difference) - (attr e 'DTEND) (attr e 'DTSTART)))) + (prop e 'DTEND) (prop e 'DTSTART)))) (define-public (event-length/clamped start-date end-date e) - (let ((end (or (attr e 'DTEND) - (if (date? (attr e 'DTSTART)) - (date+ (attr e 'DTSTART) (date day: 1)) - (attr e 'DTSTART))))) - (if (date? (attr e 'DTSTART)) + (let ((end (or (prop e 'DTEND) + (if (date? (prop e 'DTSTART)) + (date+ (prop e 'DTSTART) (date day: 1)) + (prop e 'DTSTART))))) + (if (date? (prop e 'DTSTART)) (date-difference (date-min (date+ end-date (date day: 1)) end) (date-max start-date - (attr e 'DTSTART))) + (prop e 'DTSTART))) (datetime-difference (datetime-min (datetime date: (date+ end-date (date day: 1))) end) (datetime-max (datetime date: start-date) - (attr e 'DTSTART)))))) + (prop e 'DTSTART)))))) ;; Returns the length of the part of @var{e} which is within the day ;; starting at the time @var{start-of-day}. ;; currently the secund argument is a date, but should possibly be changed ;; to a datetime to allow for more explicit TZ handling? (define-public (event-length/day date e) - (if (not (attr e 'DTEND)) - (if (date? (attr e 'DTSTART)) + (if (not (prop e 'DTEND)) + (if (date? (prop e 'DTSTART)) #24:00:00 (time)) - (let ((start (attr e 'DTSTART)) - (end (attr e 'DTEND))) + (let ((start (prop e 'DTSTART)) + (end (prop e 'DTEND))) (cond [(date= date (as-date start) (as-date end)) (time- (as-time end) (as-time start))] ;; Starts today, end in future day @@ -116,11 +116,11 @@ Event must have the DTSTART and DTEND attribute set." ;; For practical purposes, an event being long means that it shouldn't be rendered as a part ;; of a regular day. (define-public (long-event? ev) - (if (date? (attr ev 'DTSTART)) + (if (date? (prop ev 'DTSTART)) #t - (aif (attr ev 'DTEND) + (aif (prop ev 'DTEND) (datetime<= (datetime date: (date day: 1)) - (datetime-difference it (attr ev 'DTSTART))) + (datetime-difference it (prop ev 'DTSTART))) #f))) @@ -128,11 +128,11 @@ Event must have the DTSTART and DTEND attribute set." ;; event → (or datetime #f) (define (final-spanned-time event) (if (not ((@ (vcomponent recurrence) repeating?) event)) - (or (attr event 'DTEND) (attr event 'DTSTART)) + (or (prop event 'DTEND) (prop event 'DTSTART)) (let ((final ((@ (vcomponent recurrence generate) final-event-occurence) event))) (if final - (aif (attr event 'DTEND) + (aif (prop event 'DTEND) (datetime+ (as-datetime final) (as-datetime it)) (as-datetime final)) #f)))) @@ -141,14 +141,14 @@ Event must have the DTSTART and DTEND attribute set." (define-public (events-between start-date end-date events) (define (overlaps e) (timespan-overlaps? start-date (date+ end-date (date day: 1)) - (attr e 'DTSTART) (or (attr e 'DTEND) - (attr e 'DTSTART)))) + (prop e 'DTSTART) (or (prop e 'DTEND) + (prop e 'DTSTART)))) ((@ (srfi srfi-41) stream-filter) overlaps ((@ (srfi srfi-41 util) get-stream-interval) overlaps - (lambda (e) (not (date< end-date (as-date (attr e 'DTSTART))))) + (lambda (e) (not (date< end-date (as-date (prop e 'DTSTART))))) events))) @@ -159,11 +159,11 @@ Event must have the DTSTART and DTEND attribute set." ;; by checking if zone-entry-until isn't before our DTSTART. (define ((relevant-zone-entry? event) zone-entry) (aif (zone-entry-until zone-entry) - (datetime<? (as-datetime (attr event 'DTSTART)) it) + (datetime<? (as-datetime (prop event 'DTSTART)) it) #t)) (define ((relevant-zone-rule? event) rule) - (define start (attr event 'DTSTART)) + (define start (prop event 'DTSTART)) ;; end := datetime | #f (define end (final-spanned-time event)) @@ -201,7 +201,7 @@ Event must have the DTSTART and DTEND attribute set." (define vtimezone (make-vcomponent 'VTIMEZONE)) (define last-until (datetime date: #1000-01-01)) (define last-offset (timespec-zero)) - (set! (attr vtimezone 'TZID) zone-name) + (set! (prop vtimezone 'TZID) zone-name) (for zone-entry in (filter (relevant-zone-entry? event) (get-zone zoneinfo zone-name)) (cond [(zone-entry-rule zone-entry) timespec? @@ -210,10 +210,10 @@ Event must have the DTSTART and DTEND attribute set." (new-timespec (timespec-add (zone-entry-stdoff zone-entry) inline-rule))) - (set! (attr component 'DTSTART) last-until - (attr component 'TZOFFSETFROM) last-offset - (attr component 'TZOFFSETTO) new-timespec - (attr component 'TZNAME) (zone-entry-format zone-entry) + (set! (prop component 'DTSTART) last-until + (prop component 'TZOFFSETFROM) last-offset + (prop component 'TZOFFSETTO) new-timespec + (prop component 'TZNAME) (zone-entry-format zone-entry) last-until (zone-entry-until zone-entry) last-offset new-timespec) (add-child! vtimezone component)))] @@ -235,10 +235,10 @@ Event must have the DTSTART and DTEND attribute set." (zone-entry-stdoff zone-entry) (rule-save rule)))) - (set! (attr component 'DTSTART) (rule->dtstart rule) - (attr component 'TZOFFSETFROM) last-offset - (attr component 'TZOFFSETTO) new-timespec - (attr component 'TZNAME) (zone-format + (set! (prop component 'DTSTART) (rule->dtstart rule) + (prop component 'TZOFFSETFROM) last-offset + (prop component 'TZOFFSETTO) new-timespec + (prop component 'TZNAME) (zone-format (zone-entry-format zone-entry) (rule-letters rule)) ;; NOTE this can both be a number or the @@ -247,7 +247,7 @@ Event must have the DTSTART and DTEND attribute set." last-offset new-timespec) (awhen (rule->rrule rule) - (set! (attr component 'RRULE) it)) + (set! (prop component 'RRULE) it)) (add-child! vtimezone component))) ;; some of the rules might not apply to us since we only @@ -262,10 +262,10 @@ Event must have the DTSTART and DTEND attribute set." [else ; no rule (let ((component (make-vcomponent 'STANDARD))) ;; DTSTART MUST be a datetime in local time - (set! (attr component 'DTSTART) last-until - (attr component 'TZOFFSETFROM) last-offset - (attr component 'TZOFFSETTO) (zone-entry-stdoff zone-entry) - (attr component 'TZNAME) (zone-entry-format zone-entry) + (set! (prop component 'DTSTART) last-until + (prop component 'TZOFFSETFROM) last-offset + (prop component 'TZOFFSETTO) (zone-entry-stdoff zone-entry) + (prop component 'TZNAME) (zone-entry-format zone-entry) last-until (zone-entry-until zone-entry) last-offset (zone-entry-stdoff zone-entry)) (add-child! vtimezone component))])) diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm index 72acbce9..76aed2fd 100644 --- a/module/vcomponent/group.scm +++ b/module/vcomponent/group.scm @@ -13,7 +13,7 @@ (if (stream-null? in-stream) stream-null - (let loop ((days (day-stream (as-date (attr (stream-car in-stream) 'DTSTART)))) + (let loop ((days (day-stream (as-date (prop (stream-car in-stream) 'DTSTART)))) (stream in-stream)) (let* ((day (stream-car days)) (tomorow (stream-car (stream-cdr days)))) @@ -27,11 +27,11 @@ ;; object which begins tomorow (after midnight, exclusize). (filter-sorted-stream* (lambda (e) (date/-time<? tomorow - (or (attr e 'DTEND) - (if (date? (attr e 'DTSTART)) - (date+ (attr e 'DTSTART) (date day: 1)) - (attr e 'DTSTART))))) - (lambda (e) (date/-time<=? tomorow (attr e 'DTSTART))) + (or (prop e 'DTEND) + (if (date? (prop e 'DTSTART)) + (date+ (prop e 'DTSTART) (date day: 1)) + (prop e 'DTSTART))))) + (lambda (e) (date/-time<=? tomorow (prop e 'DTSTART))) stream))) diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm index b20fcfc8..7b2d7fc5 100644 --- a/module/vcomponent/parse.scm +++ b/module/vcomponent/parse.scm @@ -26,7 +26,7 @@ ;; All VTIMEZONE's seem to be in "local" time in relation to ;; themselves. Therefore, a simple comparison should work, -;; and then the TZOFFSETTO attribute can be subtd. +;; and then the TZOFFSETTO properties can be subtd. (define (parse-vdir path) (let ((/ (lambda args (string-join args file-name-separator-string 'infix)))) (let ((color @@ -48,8 +48,8 @@ (assert (eq? 'VCALENDAR (type item))) (for child in (children item) - (set! (attr child 'X-HNH-FILENAME) - (attr (parent child) 'X-HNH-FILENAME))) + (set! (prop child 'X-HNH-FILENAME) + (prop (parent child) 'X-HNH-FILENAME))) ;; NOTE The vdir standard says that each file should contain ;; EXACTLY one event. It can however contain multiple VEVENT @@ -61,7 +61,7 @@ ;; the standard. Section 3.8.4.4. (case (length events) [(0) (warning "No events in component~%~a" - (attr item 'X-HNH-FILENAME))] + (prop item 'X-HNH-FILENAME))] [(1) (let ((child (car events))) (assert (memv (type child) '(VTIMEZONE VEVENT))) @@ -78,7 +78,7 @@ events)) (rest (delete head events eq?))) - (set! (attr head 'X-HNH-ALTERNATIVES) + (set! (prop head 'X-HNH-ALTERNATIVES) (alist->hash-table (map cons (map (extract 'RECURRENCE-ID) rest) @@ -96,9 +96,9 @@ (let ((fullname (/ path fname))) (let ((cal (call-with-input-file fullname parse-calendar))) - (set! (attr cal 'COLOR) color - (attr cal 'NAME) name - (attr cal 'X-HNH-FILENAME) fullname) + (set! (prop cal 'COLOR) color + (prop cal 'NAME) name + (prop cal 'X-HNH-FILENAME) fullname) cal))) (scandir path (lambda (s) (and (not (string= "." (string-take s 1))) (string= "ics" (string-take-right s 3)))))))))) @@ -111,20 +111,20 @@ (case (stat:type st) [(regular) (let ((comp (call-with-input-file path parse-calendar))) - (set! (attr comp 'X-HNH-SOURCETYPE) 'file) + (set! (prop comp 'X-HNH-SOURCETYPE) 'file) comp) ] [(directory) (report-time! "Parsing ~a" path) (let ((comp (parse-vdir path))) - (set! (attr comp 'X-HNH-SOURCETYPE) 'vdir - (attr comp 'X-HNH-DIRECTORY) path) + (set! (prop comp 'X-HNH-SOURCETYPE) 'vdir + (prop comp 'X-HNH-DIRECTORY) path) comp)] [(block-special char-special fifo socket unknown symlink) => (lambda (t) (error "Can't parse file of type " t))])) - (unless (attr cal "NAME") - (set! (attr cal "NAME") - (or (attr cal "X-WR-CALNAME") + (unless (prop cal "NAME") + (set! (prop cal "NAME") + (or (prop cal "X-WR-CALNAME") (string-append "[" (basename path) "]")))) cal) diff --git a/module/vcomponent/parse/component.scm b/module/vcomponent/parse/component.scm index 64942625..25d2642d 100644 --- a/module/vcomponent/parse/component.scm +++ b/module/vcomponent/parse/component.scm @@ -284,11 +284,11 @@ ;; x-prop ;; iana-prop )) - (aif (attr* (car stack) key) - (set! (attr* (car stack) key) (cons vline it)) - (set! (attr* (car stack) key) (list vline))) + (aif (prop* (car stack) key) + (set! (prop* (car stack) key) (cons vline it)) + (set! (prop* (car stack) key) (list vline))) ;; else - (set! (attr* (car stack) key) vline)))))) + (set! (prop* (car stack) key) vline)))))) (loop (cdr lst) stack)]))) (lambda (err fmt . args) @@ -304,6 +304,6 @@ (get-file linedata)) (current-error-port)) (let* ((key value params (parse-itemline head))) - (set! (attr* (car stack) key) + (set! (prop* (car stack) key) (make-vline key value params)) (loop (cdr lst) stack))))))))) diff --git a/module/vcomponent/parse/xcal.scm b/module/vcomponent/parse/xcal.scm index e67a8239..19d7286a 100644 --- a/module/vcomponent/parse/xcal.scm +++ b/module/vcomponent/parse/xcal.scm @@ -125,7 +125,7 @@ (let ((params (handle-parameters parameters)) (tag* (symbol-upcase tag))) (for (type value) in (zip type value) - (set! (attr* component tag*) + (set! (prop* component tag*) (make-vline tag* (handle-tag tag (handle-value type params value)) @@ -135,7 +135,7 @@ (for (type value) in (zip type value) (let ((params (make-hash-table)) (tag* (symbol-upcase tag))) - (set! (attr* component tag*) + (set! (prop* component tag*) (make-vline tag* (handle-tag tag (handle-value type params value)) diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm index 53de1726..3da26272 100644 --- a/module/vcomponent/recurrence/generate.scm +++ b/module/vcomponent/recurrence/generate.scm @@ -317,28 +317,28 @@ rrule start-date))) (define-stream (rrule-instances event) - (define rrule (attr event 'RRULE)) + (define rrule (prop event 'RRULE)) ;; 3.8.5.1 exdate are evaluated AFTER rrule (and rdate) (let ((date-stream (stream-remove - (aif (attr* event 'EXDATE) + (aif (prop* event 'EXDATE) (cut member <> (map value it)) (const #f)) ;; Some expanders can produce dates before our start time. ;; For example FREQ=WEEKLY;BYDAY=MO where DTSTART is ;; anything after monday. This filters these out. (stream-drop-while - (lambda (d) (date/-time< d (attr event 'DTSTART))) - (generate-posibilities rrule (attr event 'DTSTART))) + (lambda (d) (date/-time< d (prop event 'DTSTART))) + (generate-posibilities rrule (prop event 'DTSTART))) ;; TODO ideally I should merge the limited recurrence set ;; with the list of rdates here. However, I have never - ;; sen an event with an RDATE attribute, so I wont worry + ;; sen an event with an RDATE property, so I wont worry ;; about it for now. ;; (stream-merge (list->stream (#|rdate's|#)) ))) (cond [(count rrule) => (lambda (c) (stream-take c date-stream))] [(until rrule) => (lambda (end) (stream-take-while - (cut (if (date? (attr event 'DTSTART)) + (cut (if (date? (prop event 'DTSTART)) date<= datetime<=) <> end) date-stream))] [else date-stream]))) @@ -347,7 +347,7 @@ (define-public (final-event-occurence event) - (define rrule (attr event 'RRULE)) + (define rrule (prop event 'RRULE)) (if (or (count rrule) (until rrule)) (let ((instances (rrule-instances event))) @@ -360,38 +360,38 @@ (define duration ;; NOTE DTEND is an optional field. - (let ((end (attr base-event 'DTEND))) + (let ((end (prop base-event 'DTEND))) (if end (if (date? end) - (date-difference end (attr base-event 'DTSTART)) - (datetime-difference end (attr base-event 'DTSTART))) + (date-difference end (prop base-event 'DTSTART)) + (datetime-difference end (prop base-event 'DTSTART))) #f))) (define rrule-stream (rrule-instances base-event)) (stream-map - (aif (attr base-event 'X-HNH-ALTERNATIVES) + (aif (prop base-event 'X-HNH-ALTERNATIVES) (lambda (dt) (aif (hash-ref it dt) it ; RECURRENCE-ID objects come with their own DTEND (let ((ev (copy-vcomponent base-event))) - (set! (attr ev 'DTSTART) dt) + (set! (prop ev 'DTSTART) dt) (when 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! (attr ev 'DTEND) ((cond [(date? dt) date+] + (set! (prop ev 'DTEND) ((cond [(date? dt) date+] [(datetime? dt) datetime+] [else (error "Bad type")]) dt duration))) ev))) (lambda (dt) (let ((ev (copy-vcomponent base-event))) - (set! (attr ev 'DTSTART) dt) + (set! (prop ev 'DTSTART) dt) (when duration - (set! (attr ev 'DTEND) ((cond [(date? dt) date+] + (set! (prop ev 'DTEND) ((cond [(date? dt) date+] [(datetime? dt) datetime+] [else (error "Bad type")]) dt duration))) diff --git a/module/vcomponent/recurrence/internal.scm b/module/vcomponent/recurrence/internal.scm index 738c80de..40195895 100644 --- a/module/vcomponent/recurrence/internal.scm +++ b/module/vcomponent/recurrence/internal.scm @@ -2,7 +2,7 @@ #:export (repeating? format-recur-rule make-recur-rule) #:use-module (srfi srfi-88) ; better keywords - #:use-module ((vcomponent base) :select (attr)) + #:use-module ((vcomponent base) :select (prop)) #:use-module (datetime util) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) @@ -13,8 +13,8 @@ ;; but that property alone don't create a recuring event. (define (repeating? ev) "Does this event repeat?" - (or (attr ev 'RRULE) - (attr ev 'RDATE))) + (or (prop ev 'RRULE) + (prop ev 'RDATE))) ;; weekday := [0, 7) |