From 1484155c211fe8452344ffdc501e858706ecbc51 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Wed, 29 Sep 2021 23:36:21 +0200 Subject: Start rework on js setup. --- module/vcomponent/vdir/save-delete.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'module/vcomponent') diff --git a/module/vcomponent/vdir/save-delete.scm b/module/vcomponent/vdir/save-delete.scm index d17b595e..b3c7f9c5 100644 --- a/module/vcomponent/vdir/save-delete.scm +++ b/module/vcomponent/vdir/save-delete.scm @@ -11,7 +11,7 @@ (define-module (vcomponent vdir save-delete) :use-module (calp util) - :use-module ((calp util exceptions) :select (assert)) + :use-module ((calp util exceptions) :select (assert)) :use-module (vcomponent ical output) :use-module (vcomponent) :use-module ((calp util io) :select (with-atomic-output-to-file)) -- cgit v1.2.3 From bb59ca85ff27a51a2c532d330b3b5f947ac7fb9e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 4 Oct 2021 17:36:44 +0200 Subject: Work on calendar from event in frontend, broken. --- module/vcomponent/xcal/output.scm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'module/vcomponent') diff --git a/module/vcomponent/xcal/output.scm b/module/vcomponent/xcal/output.scm index 692b3ec2..095c61c2 100644 --- a/module/vcomponent/xcal/output.scm +++ b/module/vcomponent/xcal/output.scm @@ -121,7 +121,10 @@ ,(vline->value-tag vline)))]) (properties component)))) (unless (null? props) - `(properties ,@props))) + `(properties + ;; NOTE + (x-hnh-calendar-name (text ,(prop (parent component) 'NAME))) + ,@props))) ,(unless (null? (children component)) `(components ,@(map vcomponent->sxcal (children component))))))) -- cgit v1.2.3 From 6211166f3debf5bfaf647b64c50e5b98d8829bcb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 8 Nov 2021 18:26:30 +0100 Subject: Comment out x-hnh-calendar-name. It caused tests to crash, since it requires that all components have parents (which is obviously false for root components), and that all those parents have a NAME field. --- module/vcomponent/xcal/output.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'module/vcomponent') diff --git a/module/vcomponent/xcal/output.scm b/module/vcomponent/xcal/output.scm index 095c61c2..70288cba 100644 --- a/module/vcomponent/xcal/output.scm +++ b/module/vcomponent/xcal/output.scm @@ -123,7 +123,7 @@ (unless (null? props) `(properties ;; NOTE - (x-hnh-calendar-name (text ,(prop (parent component) 'NAME))) + ;; (x-hnh-calendar-name (text ,(prop (parent component) 'NAME))) ,@props))) ,(unless (null? (children component)) `(components ,@(map vcomponent->sxcal (children component))))))) -- cgit v1.2.3 From 1df15b2ceaef09b48a39aa6046b577da11ea2f72 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Fri, 26 Nov 2021 15:32:41 +0100 Subject: Got categories working. --- module/vcomponent/xcal/parse.scm | 43 +++++++++++++++++++++++++++++++++------- 1 file changed, 36 insertions(+), 7 deletions(-) (limited to 'module/vcomponent') diff --git a/module/vcomponent/xcal/parse.scm b/module/vcomponent/xcal/parse.scm index 124a91f4..48ce301e 100644 --- a/module/vcomponent/xcal/parse.scm +++ b/module/vcomponent/xcal/parse.scm @@ -171,11 +171,25 @@ ;; ignore empty fields ;; mostly for (unless (null? value) - (set! (prop* component tag*) - (make-vline tag* - (handle-tag - tag (handle-value type params value)) - params)))))] + (let () + (define vline + (make-vline tag* + (handle-tag + tag (handle-value type params value)) + params)) + (if (memv tag* '(ATTACH ATTENDEE CATEGORIES + COMMENT CONTACT EXDATE + REQUEST-STATUS RELATED-TO + RESOURCES RDATE + ;; x-prop + ;; iana-prop + )) + (aif (prop* component tag*) + (set! (prop* component tag*) (cons vline it)) + (set! (prop* component tag*) (list vline))) + ;; else + (set! (prop* component tag*) vline)) + ))))] [(tag (type value ...) ...) (for (type value) in (zip type value) @@ -184,7 +198,7 @@ (unless (null? value) (let ((params (make-hash-table)) (tag* (symbol-upcase tag))) - (set! (prop* component tag*) + (define vline (make-vline tag* (handle-tag tag (let ((v (handle-value type params value))) @@ -192,7 +206,22 @@ (if (eq? tag 'categories) (string-split v #\,) v))) - params)))))]))) + params)) + ;; + + (if (memv tag* '(ATTACH ATTENDEE CATEGORIES + COMMENT CONTACT EXDATE + REQUEST-STATUS RELATED-TO + RESOURCES RDATE + ;; x-prop + ;; iana-prop + )) + (aif (prop* component tag*) + (set! (prop* component tag*) (cons vline it)) + (set! (prop* component tag*) (list vline))) + ;; else + (set! (prop* component tag*) vline)) + )))]))) ;; children (awhen (assoc-ref sxcal 'components) -- cgit v1.2.3 From 6646b21d3f0f2e09a5450dd4be7b4935d146db2c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 6 Dec 2021 03:51:59 +0100 Subject: Add clarifying comments. --- module/vcomponent/recurrence/generate.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'module/vcomponent') diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm index 3b0f7083..1d262202 100644 --- a/module/vcomponent/recurrence/generate.scm +++ b/module/vcomponent/recurrence/generate.scm @@ -364,9 +364,9 @@ #f)) +;; -> (stream ) (define-public (generate-recurrence-set base-event) - (define duration ;; NOTE DTEND is an optional field. (let ((end (prop base-event 'DTEND))) -- cgit v1.2.3 From 8e93d53e6665e6ad782f94911032f043f9377ca4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 6 Dec 2021 03:55:47 +0100 Subject: Update xcal rrule parser to do as expected. --- module/vcomponent/xcal/parse.scm | 96 ++++++++++++++++++++++++++-------------- 1 file changed, 62 insertions(+), 34 deletions(-) (limited to 'module/vcomponent') diff --git a/module/vcomponent/xcal/parse.scm b/module/vcomponent/xcal/parse.scm index 48ce301e..c6a2122f 100644 --- a/module/vcomponent/xcal/parse.scm +++ b/module/vcomponent/xcal/parse.scm @@ -49,40 +49,68 @@ ((@ (vcomponent duration) parse-duration) duration))])] [(recur) - (apply (@ (vcomponent recurrence internal) make-recur-rule) - (concatenate - (for (k v) in value - (list (symbol->keyword k) - (case k - ((wkst) - ((@ (vcomponent recurrence parse) - rfc->datetime-weekday) - (string->symbol v))) - ((freq) (string->symbol v)) - ((until) - ;; RFC 6321 (xcal), p. 30 specifies type-until as - ;; type-until = element until { - ;; type-date | - ;; type-date-time - ;; } - ;; but doesn't bother defining type-date[-time]... - ;; This is acknowledged in errata 3315 [1], but - ;; it lacks a solution... - ;; Seeing as RFC 7265 (jcal) in Example 2 (p. 16) - ;; show the date as a direct string we will roll - ;; with that here to. - ;; [1]: https://www.rfc-editor.org/errata/eid3315 - (string->date/-time v)) - ((byday) #|TODO|# - (throw 'not-yet-implemented)) - ((count interval bysecond bymunite byhour - bymonthday byyearday byweekno - bymonth bysetpos) - (string->number v)) - (else (throw - 'key-error - "Invalid key ~a, with value ~a" - k v)))))))] + ;; RFC6221 (xcal) Appendix A 3.3.10 specifies that all components should + ;; come in a specified order, and by extension that all components of the + ;; same type should follow each other. Actually checking that is harder + ;; than to just accept anything in any order. It would also make us less + ;; robust for other implementations with other ideas. + (let ((parse-value-of-that-type + (lambda (type value) + (case type + ((wkst) + ((@ (vcomponent recurrence parse) + rfc->datetime-weekday) + (string->symbol value))) + ((freq) (string->symbol value)) + ((until) + ;; RFC 6321 (xcal), p. 30 specifies type-until as + ;; type-until = element until { + ;; type-date | + ;; type-date-time + ;; } + ;; but doesn't bother defining type-date[-time]... + ;; This is acknowledged in errata 3315 [1], but + ;; it lacks a solution... + ;; Seeing as RFC 7265 (jcal) in Example 2 (p. 16) + ;; show the date as a direct string we will roll + ;; with that here to. + ;; [1]: https://www.rfc-editor.org/errata/eid3315 + (string->date/-time value)) + ((byday) ((@@ (vcomponent recurrence parse) parse-day-spec) value)) + ((count interval bysecond bymunite byhour + bymonthday byyearday byweekno + bymonth bysetpos) + (string->number value)) + (else (throw + 'key-error + "Invalid type ~a, with value ~a" + type value)))))) + + ;; freq until count interval wkst + + (apply (@ (vcomponent recurrence internal) make-recur-rule) + (concatenate + (filter identity + (for key in '(bysecond byminute byhour byday bymonthday + byyearday byweekno bymonth bysetpos + freq until count interval wkst) + (define values (assoc-ref-all value key)) + (if (null? values) + #f + (case key + ;; These fields all have zero or one value + ((freq until count interval wkst) + (list (symbol->keyword key) + (parse-value-of-that-type + key (car (map car values))))) + ;; these fields take lists + ((bysecond byminute byhour byday bymonthday + byyearday byweekno bymonth bysetpos) + (list (symbol->keyword key) + (map (lambda (v) (parse-value-of-that-type key v)) + (map car values))) + ) + (else (throw 'error)))))))))] [(time) (parse-iso-time (car value))] -- cgit v1.2.3 From 7ae9afa8d6e85199975054810f7e2f8e87b56d96 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 6 Dec 2021 15:59:47 +0100 Subject: Add delete-{parameter,property}! --- module/vcomponent/base.scm | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'module/vcomponent') diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm index 9066b257..ab2121a2 100644 --- a/module/vcomponent/base.scm +++ b/module/vcomponent/base.scm @@ -110,6 +110,11 @@ get-prop* set-prop*!)) +(define-public (delete-property! component key) + (hashq-remove! (get-component-properties component) + (as-symb key))) + + ;; vcomponent x (or str symb) → value (define (get-prop component key) (let ((props (get-prop* component key))) @@ -139,6 +144,12 @@ (hashq-set! (get-vline-parameters vline) (as-symb parameter-key) val)))) + +(define-public (delete-parameter! vline parameter-key) + (hashq-remove! (get-vline-parameters vline) + (as-symb parameter-key))) + + ;; Returns the parameters of a property as an assoc list. ;; @code{(map car <>)} leads to available parameters. (define-public (parameters vline) -- cgit v1.2.3 From 380e4e86066ea0ca0096f8080faf3bc6739b93fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 12 Dec 2021 20:37:05 +0100 Subject: Add TODO about broken color files. --- module/vcomponent/vdir/parse.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'module/vcomponent') diff --git a/module/vcomponent/vdir/parse.scm b/module/vcomponent/vdir/parse.scm index 7b10af07..6bbd1329 100644 --- a/module/vcomponent/vdir/parse.scm +++ b/module/vcomponent/vdir/parse.scm @@ -25,6 +25,7 @@ ;; themselves. Therefore, a simple comparison should work, ;; and then the TZOFFSETTO properties can be subtd. (define-public (parse-vdir path) + ;; TODO empty files here cause "#" to appear in the output XML, which is *really* bad. (let ((color (catch 'system-error (lambda () (call-with-input-file (path-append path "color") read-line)) -- cgit v1.2.3