From 715e36ab81389ebf53ea158027d0a83f144eee0e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 30 Jun 2020 01:58:19 +0200 Subject: Finished renamining attribute to property. --- config.scm | 2 +- module/entry-points/import.scm | 4 +- module/entry-points/server.scm | 4 +- module/output/html.scm | 90 ++++++++++++------------ module/output/ical.scm | 16 ++--- module/output/terminal.scm | 32 ++++----- module/vcomponent.scm | 14 ++-- module/vcomponent/base.scm | 44 ++++++------ module/vcomponent/control.scm | 12 ++-- module/vcomponent/datetime.scm | 112 +++++++++++++++--------------- module/vcomponent/group.scm | 12 ++-- module/vcomponent/parse.scm | 28 ++++---- module/vcomponent/parse/component.scm | 10 +-- module/vcomponent/parse/xcal.scm | 4 +- module/vcomponent/recurrence/generate.scm | 30 ++++---- module/vcomponent/recurrence/internal.scm | 6 +- tests/prop.scm | 10 +-- tests/recurrence.scm | 20 +++--- tests/recurring.scm | 6 +- tests/vcomponent-control.scm | 18 ++--- tests/vcomponent.scm | 8 +-- tests/xcal.scm | 4 +- 22 files changed, 241 insertions(+), 245 deletions(-) diff --git a/config.scm b/config.scm index fb09deb3..460f678e 100644 --- a/config.scm +++ b/config.scm @@ -61,7 +61,7 @@ (set-config! 'description-filter (lambda (ev str) - (cond [(member (attr (parent ev) 'NAME) + (cond [(member (prop (parent ev) 'NAME) '("D-sektionens officiella kalender" "LiTHe kod")) (parse-html (regexp-substitute/global #f "
" str diff --git a/module/entry-points/import.scm b/module/entry-points/import.scm index 3d372f8a..cc67b448 100644 --- a/module/entry-points/import.scm +++ b/module/entry-points/import.scm @@ -30,7 +30,7 @@ (let* ((calendars (getf 'calendars)) (calendar (and cal-name - (find (lambda (c) (string=? cal-name (attr c 'NAME))) + (find (lambda (c) (string=? cal-name (prop c 'NAME))) (getf 'calendars))))) (unless calendar @@ -41,7 +41,7 @@ (format #t "About to the following ~a events into ~a~%~{~a~^~%~}~%" (length (children new-events)) - (attr calendar 'NAME) + (prop calendar 'NAME) (map (extract 'SUMMARY) (children new-events))) (format #t "Continue? [Y/n] ") diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm index f6d273ba..4810dc0c 100644 --- a/module/entry-points/server.scm +++ b/module/entry-points/server.scm @@ -118,7 +118,7 @@ ;; but you can only query for existance. ;; also, the default output gives everything. (let ((calendar - (find (lambda (c) (string=? cal (attr c 'NAME))) + (find (lambda (c) (string=? cal (prop c 'NAME))) (getf 'calendars)))) (unless calendar @@ -147,7 +147,7 @@ (format #f "~?~%" fmt args))))) (format (current-error-port) - "Event inserted ~a~%" (attr event 'UID)) + "Event inserted ~a~%" (prop event 'UID)) (return '((content-type text/plain)) "Event inserted\r\n")))) diff --git a/module/output/html.scm b/module/output/html.scm index 5c963482..f462db56 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -76,8 +76,8 @@ ;; TODO currently not guaranteed to be unique (define (UID ev) (string-append - (datetime->string (as-datetime (attr ev 'DTSTART)) "~Y~m~d~H~M~S") - (html-attr (attr ev 'UID)))) + (datetime->string (as-datetime (prop ev 'DTSTART)) "~Y~m~d~H~M~S") + (html-attr (prop ev 'UID)))) ;; Retuns an HTML-safe version of @var{str}. (define (html-attr str) @@ -87,9 +87,9 @@ ;; Takes an event, and returns a pretty string for the time interval ;; the event occupies. (define (fmt-time-span ev) - (cond [(attr ev 'DTSTART) date? + (cond [(prop ev 'DTSTART) date? => (lambda (s) - (cond [(attr ev 'DTEND) + (cond [(prop ev 'DTEND) => (lambda (e) (if (date= e (date+ s (date day: 1))) (date->string s) ; start = end, only return one value @@ -98,8 +98,8 @@ ;; no end value, just return start [else (date->string s)]))] [else ; guaranteed datetime - (let ((s (attr ev 'DTSTART)) - (e (attr ev 'DTEND))) + (let ((s (prop ev 'DTSTART)) + (e (prop ev 'DTEND))) (if e (let ((fmt-str (if (date= (get-date s) (get-date e)) "~H:~M" "~Y-~m-~d ~H:~M"))) @@ -138,7 +138,7 @@ (define (popup ev id) `(div (@ (class "popup-container") (id ,id)) (div (@ (class "popup")) - (nav (@ (class "popup-control CAL_" ,(html-attr (or (attr (parent ev) 'NAME) + (nav (@ (class "popup-control CAL_" ,(html-attr (or (prop (parent ev) 'NAME) "unknown")))) ,(btn "×" title: "Stäng" @@ -147,7 +147,7 @@ ) ,(btn "📅" title: "Ladda ner" - href: (string-append "/calendar/" (attr ev 'UID) ".ics"))) + href: (string-append "/calendar/" (prop ev 'UID) ".ics"))) ,(fmt-single-event ev)))) @@ -189,22 +189,22 @@ (class "hidelink")) (div (@ ,@(assq-merge extra-attributes - `((class "event CAL_" ,(html-attr (or (attr (parent ev) 'NAME) + `((class "event CAL_" ,(html-attr (or (prop (parent ev) 'NAME) "unknown")) - ,(when (and (attr ev 'PARTSTAT) - (eq? 'TENTATIVE (attr ev 'PARTSTAT))) + ,(when (and (prop ev 'PARTSTAT) + (eq? 'TENTATIVE (prop ev 'PARTSTAT))) " tentative")) (data-tipped-options ,(format #f "inline: '~a'" popup-id))))) ,(when (debug) `(script (@ (type "application/calendar+xml")) ,((@ (output xcal) vcomponent->sxcal) ev))) - ,(when (attr ev 'RRULE) + ,(when (prop ev 'RRULE) `(span (@ (class "repeating")) "↺")) - ,((get-config 'summary-filter) ev (attr ev 'SUMMARY)) - ,(when (attr ev 'LOCATION) + ,((get-config 'summary-filter) ev (prop ev 'SUMMARY)) + ,(when (prop ev 'LOCATION) `(span (@ (class "location")) ,(string-map (lambda (c) (if (char=? c #\,) #\newline c)) - (attr ev 'LOCATION)))))) + (prop ev 'LOCATION)))))) ,(popup ev popup-id))) ;; Format single event for graphical display @@ -221,10 +221,10 @@ (* 100 (width ev)) ; width ;; top - (if (date= date (as-date (attr ev 'DTSTART))) + (if (date= date (as-date (prop ev 'DTSTART))) (* 100/24 (time->decimal-hour - (as-time (attr ev 'DTSTART)))) + (as-time (prop ev 'DTSTART)))) 0) ;; height @@ -232,9 +232,9 @@ (make-block ev `((class - ,(when (datedecimal-hour diff start-date) total-length))) @@ -273,10 +273,10 @@ (make-block ev `((class - ,(when (date/-time< (attr ev 'DTSTART) start-date) + ,(when (date/-time< (prop ev 'DTSTART) start-date) " continued") - ,(when (and (attr ev 'DTEND) - (date/-time< (date+ end-date (date day: 1)) (attr ev 'DTEND))) + ,(when (and (prop ev 'DTEND) + (date/-time< (date+ end-date (date day: 1)) (prop ev 'DTEND))) " continuing")) (style ,style)))) @@ -351,8 +351,8 @@ `(span (@ (class "rrule")) "Upprepas " ,((@ (vcomponent recurrence display) format-recurrence-rule) - (attr ev 'RRULE)) - ,@(awhen (attr* ev 'EXDATE) + (prop ev 'RRULE)) + ,@(awhen (prop* ev 'EXDATE) (list ", undantaget " (add-enumeration-punctuation @@ -363,7 +363,7 @@ ;; NOTE only show time when it's different than the start time? ;; or possibly only when FREQ is hourly or lower. (if (memv ((@ (vcomponent recurrence internal) freq) - (attr ev 'RRULE)) + (prop ev 'RRULE)) '(HOURLY MINUTELY SECONDLY)) (datetime->string d "~e ~b ~k:~M") (datetime->string d "~e ~b")))) @@ -381,34 +381,34 @@ (define* (fmt-single-event ev optional: (attributes '()) key: (fmt-header list)) - ;; (format (current-error-port) "fmt-single-event: ~a~%" (attr ev 'X-HNH-FILENAME)) + ;; (format (current-error-port) "fmt-single-event: ~a~%" (prop ev 'X-HNH-FILENAME)) `(article (@ ,@(assq-merge attributes `((class "eventtext CAL_bg_" - ,(html-attr (or (attr (parent ev) 'NAME) "unknown")) - ,(when (and (attr ev 'PARTSTAT) - (eq? 'TENTATIVE (attr ev 'PARTSTAT))) + ,(html-attr (or (prop (parent ev) 'NAME) "unknown")) + ,(when (and (prop ev 'PARTSTAT) + (eq? 'TENTATIVE (prop ev 'PARTSTAT))) " tentative"))))) (h3 ,(fmt-header - (when (attr ev 'RRULE) + (when (prop ev 'RRULE) `(span (@ (class "repeating")) "↺")) - (attr ev 'SUMMARY))) + (prop ev 'SUMMARY))) (div ,(call-with-values (lambda () (fmt-time-span ev)) (case-lambda [(start) `(div ,start)] [(start end) `(div ,start " — " ,end)])) - ,(when (and=> (attr ev 'LOCATION) (negate string-null?)) + ,(when (and=> (prop ev 'LOCATION) (negate string-null?)) `(div (b "Plats: ") (div (@ (class "location")) ,(string-map (lambda (c) (if (char=? c #\,) #\newline c)) - (attr ev 'LOCATION))))) - ,(and=> (attr ev 'DESCRIPTION) + (prop ev 'LOCATION))))) + ,(and=> (prop ev 'DESCRIPTION) (lambda (str) (format-description ev str))) - ,(awhen (attr ev 'RRULE) + ,(awhen (prop ev 'RRULE) (format-recurrence-rule ev)) - ,(when (attr ev 'LAST-MODIFIED) + ,(when (prop ev 'LAST-MODIFIED) `(span (@ (class "last-modified")) "Senast ändrad " - ,(datetime->string (attr ev 'LAST-MODIFIED) "~1 ~H:~M"))) + ,(datetime->string (prop ev 'LAST-MODIFIED) "~1 ~H:~M"))) ))) @@ -425,7 +425,7 @@ ev `((id ,(UID ev))) fmt-header: (lambda body - `(a (@ (href "#" ,(date-link (as-date (attr ev 'DTSTART)))) + `(a (@ (href "#" ,(date-link (as-date (prop ev 'DTSTART)))) (class "hidelink")) ,@body)))) (stream-filter @@ -434,7 +434,7 @@ ;; This removes all descriptions from ;; events for previous days, ;; solving duplicates. - (date/-time<=? date (attr ev 'DTSTART))) + (date/-time<=? date (prop ev 'DTSTART))) events)))))) @@ -625,9 +625,9 @@ (script (@ (src "/static/script.js")) "") (style ,(format #f "~:{.CAL_~a { background-color: ~a; color: ~a }~%.CAL_bg_~a { border-color: ~a }~%~}" (map (lambda (c) - (let* ((name (html-attr (attr c 'NAME))) - (bg-color (attr c 'COLOR)) - (fg-color (and=> (attr c 'COLOR) + (let* ((name (html-attr (prop c 'NAME))) + (bg-color (prop c 'COLOR)) + (fg-color (and=> (prop c 'COLOR) calculate-fg-color))) (list name (or bg-color 'white) (or fg-color 'black) name (or bg-color 'black)))) @@ -740,8 +740,8 @@ (ul ,@(map (lambda (calendar) `(li (@ (class "CAL_bg_" - ,(html-attr (attr calendar 'NAME)))) - ,(attr calendar 'NAME))) + ,(html-attr (prop calendar 'NAME)))) + ,(prop calendar 'NAME))) calendars)))) ;; List of events diff --git a/module/output/ical.scm b/module/output/ical.scm index de6a351d..7e514c99 100644 --- a/module/output/ical.scm +++ b/module/output/ical.scm @@ -155,7 +155,7 @@ (format #t "END:~a\r\n" (type component)) ;; If we have alternatives, splice them in here. - (cond [(attr component 'X-HNH-ALTERNATIVES) + (cond [(prop component 'X-HNH-ALTERNATIVES) => (lambda (alts) (hash-map->list (lambda (_ comp) (component->ical-string comp)) alts))])) @@ -164,23 +164,23 @@ (define (write-event-to-file event calendar-path) (define cal (make-vcomponent 'VCALENDAR)) - (set! (attr cal 'PRODID) (@ (global) *prodid*) - (attr cal 'VERSION) "2.0" - (attr cal 'CALSCALE) "GREGORIAN") + (set! (prop cal 'PRODID) (@ (global) *prodid*) + (prop cal 'VERSION) "2.0" + (prop cal 'CALSCALE) "GREGORIAN") (add-child! cal event) - (awhen (param (attr* event 'DTSTART) 'TZID) + (awhen (param (prop* event 'DTSTART) 'TZID) ;; TODO this is broken (add-child! cal (zoneinfo->vtimezone (getf 'zoneinfo) it))) - (unless (attr event 'UID) - (set! (attr event 'UID) + (unless (prop event 'UID) + (set! (prop event 'UID) (generate-uuid))) (with-output-to-file (glob (format #f "~a/~a.ics" calendar-path - (attr event 'UID))) + (prop event 'UID))) (lambda () (component->ical-string cal)))) diff --git a/module/output/terminal.scm b/module/output/terminal.scm index 92afe7a6..14777437 100644 --- a/module/output/terminal.scm +++ b/module/output/terminal.scm @@ -41,26 +41,26 @@ (lambda (ev i) (display (string-append - (if (datetime? (attr ev 'DTSTART)) - (datetime->string (attr ev 'DTSTART) "~Y-~m-~d ~H:~M:~S") + (if (datetime? (prop ev 'DTSTART)) + (datetime->string (prop ev 'DTSTART) "~Y-~m-~d ~H:~M:~S") ((@ (texinfo string-utils) center-string) - (date->string (attr ev 'DTSTART)) + (date->string (prop ev 'DTSTART)) 19)) " │ " (if (= i cur-event) "\x1b[7m" "") - (color-escape (attr (parent ev) 'COLOR)) + (color-escape (prop (parent ev) 'COLOR)) ;; Summary filter is a hook for the user - (let ((dirty (attr ev 'X-HNH-DIRTY))) + (let ((dirty (prop ev 'X-HNH-DIRTY))) (string-append (if dirty "* " "") ;; TODO reintroduce summary-filter - (trim-to-width (attr ev 'SUMMARY) (- summary-width + (trim-to-width (prop ev 'SUMMARY) (- summary-width (if dirty 2 0))))) STR-RESET " │ " - (if (attr ev 'LOCATION) "" "\x1b[1;30m") + (if (prop ev 'LOCATION) "" "\x1b[1;30m") (trim-to-width - (or (attr ev 'LOCATION) "INGEN LOKAL") location-width) + (or (prop ev 'LOCATION) "INGEN LOKAL") location-width) STR-RESET "\n"))) events @@ -108,22 +108,22 @@ (unless (null? events) (let ((ev (list-ref events cur-event))) (format #t "~a~%~% ~a~%~%~a\x1b[1mStart:\x1b[m ~a \x1b[1mSlut:\x1b[m ~a~%~%~a~%" - (attr ev 'X-HNH-FILENAME) - (attr ev 'SUMMARY) - (or (and=> (attr ev 'LOCATION) + (prop ev 'X-HNH-FILENAME) + (prop ev 'SUMMARY) + (or (and=> (prop ev 'LOCATION) (cut string-append "\x1b[1mPlats:\x1b[m " <> "\n")) "") ;; NOTE RFC 5545 says that DTSTART and DTEND MUST ;; have the same type. However we believe that is ;; another story. - (let ((start (attr ev 'DTSTART))) + (let ((start (prop ev 'DTSTART))) (if (datetime? start) - (datetime->string (attr ev 'DTSTART) "~Y-~m-~d ~H:~M:~S") + (datetime->string (prop ev 'DTSTART) "~Y-~m-~d ~H:~M:~S") (date->string start))) - (let ((end (attr ev 'DTEND))) + (let ((end (prop ev 'DTEND))) (if (datetime? end) - (datetime->string (attr ev 'DTEND) "~Y-~m-~d ~H:~M:~S") + (datetime->string (prop ev 'DTEND) "~Y-~m-~d ~H:~M:~S") (date->string end))) - (unlines (take-to (flow-text (or (attr ev 'DESCRIPTION) "") + (unlines (take-to (flow-text (or (prop ev 'DESCRIPTION) "") #:width (min 70 width)) (- height 8 5 (length events) 5)))))) 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 @@ ;;; ;;; -;; The type is a bit to many times refered to as a attr ptr. (define-record-type (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-timedtstart 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/-timehash-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) diff --git a/tests/prop.scm b/tests/prop.scm index 60831e14..cec0a8e2 100644 --- a/tests/prop.scm +++ b/tests/prop.scm @@ -1,6 +1,6 @@ ;;; TODO rename this file to param.scm -(((vcomponent base) param attr* parameters) +(((vcomponent base) param prop* parameters) ((vcomponent parse) parse-calendar) ((util) sort*)) @@ -10,10 +10,10 @@ KEY;A=1;B=2:Some text END:DUMMY" parse-calendar)) -(test-equal '("1") (param (attr* v 'KEY) 'A)) -(test-equal '("2") (param (attr* v 'KEY) 'B)) -(test-equal #f (param (attr* v 'KEY) 'C)) +(test-equal '("1") (param (prop* v 'KEY) 'A)) +(test-equal '("2") (param (prop* v 'KEY) 'B)) +(test-equal #f (param (prop* v 'KEY) 'C)) -(test-equal '(A B) (sort* (map car (parameters (attr* v 'KEY))) +(test-equal '(A B) (sort* (map car (parameters (prop* v 'KEY))) stringstring)) diff --git a/tests/recurrence.scm b/tests/recurrence.scm index 3abe7b1e..fad8e7dc 100644 --- a/tests/recurrence.scm +++ b/tests/recurrence.scm @@ -9,7 +9,7 @@ ((vcomponent recurrence generate) generate-recurrence-set) ((vcomponent recurrence display) format-recurrence-rule) ((vcomponent recurrence internal) count until) - ((vcomponent base) make-vcomponent attr attr* extract) + ((vcomponent base) make-vcomponent prop prop* extract) ((datetime) parse-ics-datetime datetime time date) ((util) -> mod!) ((guile) set!) @@ -20,18 +20,18 @@ (define (run-test comp) - (test-equal (string-append "RSET: " (attr comp 'SUMMARY)) - (attr comp 'X-SET) + (test-equal (string-append "RSET: " (prop comp 'SUMMARY)) + (prop comp 'X-SET) (let ((r (generate-recurrence-set comp))) (map (extract 'DTSTART) - (if (or (until (attr comp 'RRULE)) - (count (attr comp 'RRULE))) + (if (or (until (prop comp 'RRULE)) + (count (prop comp 'RRULE))) (stream->list r) (stream->list 20 r))))) - (test-equal (string-append "STR: " (attr comp 'SUMMARY)) - (attr comp 'X-SUMMARY) - (format-recurrence-rule (attr comp 'RRULE)))) + (test-equal (string-append "STR: " (prop comp 'SUMMARY)) + (prop comp 'X-SUMMARY) + (format-recurrence-rule (prop comp 'RRULE)))) (define (vevent . rest) @@ -43,14 +43,14 @@ keyword->string string-upcase string->symbol))) - (set! (attr v symb) + (set! (prop v symb) (case symb [(DTSTART EXDATE) (parse-ics-datetime (cadr rem))] [(RRULE) (parse-recurrence-rule (cadr rem))] [else (cadr rem)])) ;; hack for multi valued fields (when (eq? symb 'EXDATE) - (mod! (attr* v symb) list))) + (mod! (prop* v symb) list))) (loop (cddr rem)))) v) diff --git a/tests/recurring.scm b/tests/recurring.scm index c5ae43c6..3922f1b6 100644 --- a/tests/recurring.scm +++ b/tests/recurring.scm @@ -1,6 +1,6 @@ (((srfi srfi-41) stream-take stream-map stream->list stream-car) ((datetime util) day-stream) - ((vcomponent base) extract attr) + ((vcomponent base) extract prop) ((vcomponent) parse-calendar) ((vcomponent recurrence) generate-recurrence-set)) @@ -27,7 +27,7 @@ END:VEVENT" (generate-recurrence-set ev))) (stream->list 5 (day-stream - (attr ev 'DTSTART)))) + (prop ev 'DTSTART)))) ;; We run the exact same thing a secound time, since I had an error with ;; that during development. @@ -40,7 +40,7 @@ END:VEVENT" (stream->list (stream-take 5 (day-stream - (attr ev 'DTSTART))))) + (prop ev 'DTSTART))))) (define ev diff --git a/tests/vcomponent-control.scm b/tests/vcomponent-control.scm index 318c4335..8cc87a0a 100644 --- a/tests/vcomponent-control.scm +++ b/tests/vcomponent-control.scm @@ -1,6 +1,6 @@ -(((vcomponent control) with-replaced-attrs) +(((vcomponent control) with-replaced-properties) ((vcomponent) parse-calendar) - ((vcomponent base) attr)) + ((vcomponent base) prop)) @@ -11,15 +11,15 @@ END:DUMMY" parse-calendar)) ;; Test that temoraries are set and restored -(test-equal "value" (attr ev 'KEY)) -(with-replaced-attrs (ev (KEY "other")) - (test-equal "other" (attr ev 'KEY))) -(test-equal "value" (attr ev 'KEY)) +(test-equal "value" (prop ev 'KEY)) +(with-replaced-properties (ev (KEY "other")) + (test-equal "other" (prop ev 'KEY))) +(test-equal "value" (prop ev 'KEY)) ;; Test that they are restored on non-local exit (catch #t (lambda () - (with-replaced-attrs (ev (KEY "other")) - (throw 'any))) + (with-replaced-properties (ev (KEY "other")) + (throw 'any))) (lambda _ - (test-equal "value" (attr ev 'KEY)))) + (test-equal "value" (prop ev 'KEY)))) diff --git a/tests/vcomponent.scm b/tests/vcomponent.scm index 7a392e9e..0d81ab0e 100644 --- a/tests/vcomponent.scm +++ b/tests/vcomponent.scm @@ -1,4 +1,4 @@ -(((vcomponent base) attr) +(((vcomponent base) prop) ((vcomponent) parse-calendar)) (define ev (call-with-input-string @@ -7,6 +7,6 @@ KEY:value END:DUMMY" parse-calendar)) -(test-assert (eq? #f (attr ev 'MISSING))) -(test-assert (attr ev 'KEY)) -(test-equal "value" (attr ev 'KEY)) +(test-assert (eq? #f (prop ev 'MISSING))) +(test-assert (prop ev 'KEY)) +(test-equal "value" (prop ev 'KEY)) diff --git a/tests/xcal.scm b/tests/xcal.scm index 78e7e7df..88c708f4 100644 --- a/tests/xcal.scm +++ b/tests/xcal.scm @@ -3,7 +3,7 @@ ((output xcal) vcomponent->sxcal) ((util) ->) ((vcomponent base) - parameters attr* children) + parameters prop* children) ) ;;; Some different types, same parameters @@ -41,5 +41,5 @@ END:VCALENDAR" (test-equal "xcal parameters" '((X-TEST-PARAM "10")) - (parameters (attr* (car (children twice-converted)) + (parameters (prop* (car (children twice-converted)) 'STATUS))) -- cgit v1.2.3