From 7539f8c8804849294e100c5442e0397f4f4d2c40 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 1 Oct 2019 23:39:00 +0200 Subject: Disabled bunch of old stuff, new stuff kinda builds. --- module/vcomponent.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'module/vcomponent.scm') diff --git a/module/vcomponent.scm b/module/vcomponent.scm index cc79b646..fc360486 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -1,5 +1,5 @@ (define-module (vcomponent) - #:use-module ((vcomponent primitive) :select (%vcomponent-make)) + #:use-module ((vcomponent primitive) :select (parse-path make-vcomponent)) #:use-module (vcomponent datetime) #:use-module (vcomponent recurrence) #:use-module (vcomponent timezone) @@ -81,8 +81,8 @@ (define* (make-vcomponent #:optional path) (if (not path) - (%vcomponent-make) - (let* ((root (%vcomponent-make path)) + (make-vcomponent) + (let* ((root (parse-path path)) (component (case (string->symbol (or (attr root "X-HNH-SOURCETYPE") "no-type")) ;; == Single ICS file == -- cgit v1.2.3 From 1c3bd94c328df0c8b4293bc42a25b2d7c851fd0c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Wed, 2 Oct 2019 23:05:01 +0200 Subject: Made parser work again (for single files). --- module/vcomponent.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'module/vcomponent.scm') diff --git a/module/vcomponent.scm b/module/vcomponent.scm index fc360486..a106d993 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -1,5 +1,5 @@ (define-module (vcomponent) - #:use-module ((vcomponent primitive) :select (parse-path make-vcomponent)) + #:use-module ((vcomponent primitive) :select (parse-cal-path make-vcomponent)) #:use-module (vcomponent datetime) #:use-module (vcomponent recurrence) #:use-module (vcomponent timezone) @@ -82,7 +82,7 @@ (define* (make-vcomponent #:optional path) (if (not path) (make-vcomponent) - (let* ((root (parse-path path)) + (let* ((root (parse-cal-path path)) (component (case (string->symbol (or (attr root "X-HNH-SOURCETYPE") "no-type")) ;; == Single ICS file == -- cgit v1.2.3 From e13f6bb201dff690208b9cc951b5c098b0d63356 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 3 Oct 2019 00:46:01 +0200 Subject: Slowly going through and fixing everything. --- module/vcomponent.scm | 113 +++++++++++++++++++++++++------------------------- 1 file changed, 57 insertions(+), 56 deletions(-) (limited to 'module/vcomponent.scm') diff --git a/module/vcomponent.scm b/module/vcomponent.scm index a106d993..93449c4b 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -82,59 +82,60 @@ (define* (make-vcomponent #:optional path) (if (not path) (make-vcomponent) - (let* ((root (parse-cal-path path)) - (component - (case (string->symbol (or (attr root "X-HNH-SOURCETYPE") "no-type")) - ;; == Single ICS file == - ;; Remove the abstract ROOT component, - ;; returning the wanted VCALENDAR component - ((file) - ;; TODO test this when an empty file is given. - (car (children root))) - - ;; == Assume vdir == - ;; Also removes the abstract ROOT component, but also - ;; merges all VCALENDAR's children into the a newly - ;; created VCALENDAR component, and return that component. - ;; - ;; TODO the other VCALENDAR components might not get thrown away, - ;; this since I protect them from the GC in the C code. - ((vdir) - (let ((accum (make-vcomponent)) - (ch (children root))) - (set! (type accum) "VCALENDAR") - - (unless (null? ch) - (for key in (attributes (car ch)) - (set! (attr accum key) (attr (car ch) key)))) - - (for cal in ch - (for component in (children cal) - (case (type component) - ((VTIMEZONE) - (unless (find (lambda (z) - (string=? (attr z "TZID") - (attr component "TZID"))) - (children accum 'VTIMEZONE)) - (push-child! accum component))) - (else (push-child! accum component))))) - ;; return - accum)) - - ((no-type) (throw 'no-type)) - - (else (throw 'something))))) - - (parse-dates! component) - - (unless (attr component "NAME") - (set! (attr component "NAME") - (or (attr component "X-WR-CALNAME") - (attr root "NAME")))) - - (unless (attr component "COLOR") - (set! (attr component "COLOR") - (attr root "COLOR"))) - - ;; return - component))) + (let ((root (parse-cal-path path))) + (format #t "root = ~a~%" root ) + (let* ((component + (case (string->symbol (or (attr root "X-HNH-SOURCETYPE") "no-type")) + ;; == Single ICS file == + ;; Remove the abstract ROOT component, + ;; returning the wanted VCALENDAR component + ((file) + ;; TODO test this when an empty file is given. + (display "Hello\n") + (car (children root))) + + ;; == Assume vdir == + ;; Also removes the abstract ROOT component, but also + ;; merges all VCALENDAR's children into the a newly + ;; created VCALENDAR component, and return that component. + ;; + ;; TODO the other VCALENDAR components might not get thrown away, + ;; this since I protect them from the GC in the C code. + ((vdir) + (let ((accum (make-vcomponent)) + (ch (children root))) + (set! (type accum) "VCALENDAR") + + (unless (null? ch) + (for key in (attributes (car ch)) + (set! (attr accum key) (attr (car ch) key)))) + + (for cal in ch + (for component in (children cal) + (case (type component) + ((VTIMEZONE) + (unless (find (lambda (z) + (string=? (attr z "TZID") + (attr component "TZID"))) + (children accum 'VTIMEZONE)) + (push-child! accum component))) + (else (push-child! accum component))))) + ;; return + accum)) + + ((no-type) (throw 'no-type))))) + + (display "Here?\n") + (parse-dates! component) + + (unless (attr component "NAME") + (set! (attr component "NAME") + (or (attr component "X-WR-CALNAME") + (attr root "NAME")))) + + (unless (attr component "COLOR") + (set! (attr component "COLOR") + (attr root "COLOR"))) + + ;; return + component)))) -- cgit v1.2.3 From 785f70a3d16e549e36b8ef17f081829fe492a193 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 3 Oct 2019 22:02:03 +0200 Subject: Locate bug with DTEND. --- module/vcomponent.scm | 37 +++++++++++++++++++++++++------------ 1 file changed, 25 insertions(+), 12 deletions(-) (limited to 'module/vcomponent.scm') diff --git a/module/vcomponent.scm b/module/vcomponent.scm index 93449c4b..c2e65d19 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -1,5 +1,5 @@ (define-module (vcomponent) - #:use-module ((vcomponent primitive) :select (parse-cal-path make-vcomponent)) + #:use-module ((vcomponent primitive) :select (parse-cal-path (make-vcomponent . primitive-make-vcomponent))) #:use-module (vcomponent datetime) #:use-module (vcomponent recurrence) #:use-module (vcomponent timezone) @@ -26,7 +26,9 @@ (define (parse-dates! cal) "Parse all start times into scheme date objects." - (for tz in (children cal 'VTIMEZONE) + (for tz in (filter (lambda (o) (eq? 'VTIMEZONE (type o))) (children cal)) + (format #t "TZ = ~a~%" tz) + (for-each (lambda (p) (mod! (attr p "DTSTART") string->time-utc)) (children tz)) @@ -40,15 +42,24 @@ (cadr (children tz)))) )) - (for ev in (children cal 'VEVENT) + (for ev in (filter (lambda (o) (eq? 'VEVENT (type o))) (children cal)) (define dptr (attr* ev 'DTSTART)) (define eptr (attr* ev 'DTEND)) - (define date (parse-datetime (value dptr))) + (define date (parse-datetime (value dptr))) (define end-date - (if (value eptr) - (parse-datetime (value eptr)) - (set (date-hour date) = (+ 1)))) + (begin (format #t "end-date, file = ~a~%" (attr ev 'X-HNH-FILENAME)) + ;; It's here it crashes! + ;; (value eptr) + ;; /home/hugo/.local/var/cal/lithekod_styrelse/9cd19ed2ac0f68f68c405010e43bcf3a5fd6ca01e8f2e0ccf909a0f2fa96532f.ics + ;; An object apparently doesn't need to have a DTEND... + (aif (value eptr) + (parse-datetime it) + (set (date-hour date) = (+ 1))))) + + (format #t "ev = ~a~%file = ~a~%" ev (attr ev 'X-HNH-FILENAME)) + + ;; (format #t "ev = ~a~%file = ~a~%" ev (attr ev 'X-HNH-FILENAME)) (set! (value dptr) (date->time-utc date) (value eptr) (date->time-utc end-date)) @@ -78,10 +89,9 @@ ;; (make-procedure-with-setter car set-car!)) - (define* (make-vcomponent #:optional path) (if (not path) - (make-vcomponent) + (primitive-make-vcomponent) (let ((root (parse-cal-path path))) (format #t "root = ~a~%" root ) (let* ((component @@ -102,14 +112,16 @@ ;; TODO the other VCALENDAR components might not get thrown away, ;; this since I protect them from the GC in the C code. ((vdir) - (let ((accum (make-vcomponent)) + (let ((accum (primitive-make-vcomponent 'VCALENDAR)) (ch (children root))) - (set! (type accum) "VCALENDAR") + ;; What does this even do? (unless (null? ch) + (format #t "Looping over attributes~%") (for key in (attributes (car ch)) (set! (attr accum key) (attr (car ch) key)))) + (format #t "Looping over children, again") (for cal in ch (for component in (children cal) (case (type component) @@ -117,7 +129,7 @@ (unless (find (lambda (z) (string=? (attr z "TZID") (attr component "TZID"))) - (children accum 'VTIMEZONE)) + (filter (lambda (o) (eq? 'VTIMEZONE (type o))) (children accum))) (push-child! accum component))) (else (push-child! accum component))))) ;; return @@ -127,6 +139,7 @@ (display "Here?\n") (parse-dates! component) + (display "Theren") (unless (attr component "NAME") (set! (attr component "NAME") -- cgit v1.2.3 From d42ba61061a105389796b4aa36194e74dce83e40 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 3 Oct 2019 23:22:24 +0200 Subject: Fix problem with no end date. --- module/vcomponent.scm | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) (limited to 'module/vcomponent.scm') diff --git a/module/vcomponent.scm b/module/vcomponent.scm index c2e65d19..9bd70689 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -48,14 +48,18 @@ (define date (parse-datetime (value dptr))) (define end-date - (begin (format #t "end-date, file = ~a~%" (attr ev 'X-HNH-FILENAME)) - ;; It's here it crashes! - ;; (value eptr) - ;; /home/hugo/.local/var/cal/lithekod_styrelse/9cd19ed2ac0f68f68c405010e43bcf3a5fd6ca01e8f2e0ccf909a0f2fa96532f.ics - ;; An object apparently doesn't need to have a DTEND... - (aif (value eptr) - (parse-datetime it) - (set (date-hour date) = (+ 1))))) + (cond [(not eptr) + (format #t "date = ~a~%" date) + (let ((d (set (date-hour date) = (+ 1)))) + (set! (attr ev 'DTEND) d + eptr (attr* ev 'DTEND)) + d + )] + [(value eptr) => parse-datetime] + [else + (format #t "date = ~a~%" date) + (set (date-hour date) = (+ 1))]) + ) (format #t "ev = ~a~%file = ~a~%" ev (attr ev 'X-HNH-FILENAME)) @@ -64,6 +68,8 @@ (set! (value dptr) (date->time-utc date) (value eptr) (date->time-utc end-date)) + (format #t "After first set") + (when (prop (attr* ev 'DTSTART) 'TZID) (set! (zone-offset date) (get-tz-offset ev) (value dptr) (date->time-utc date) -- cgit v1.2.3 From 3521ad64ef664f8303fa93ac237212b97dd0f69c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Fri, 4 Oct 2019 00:01:27 +0200 Subject: Remove debug prints.. --- module/vcomponent.scm | 16 ---------------- 1 file changed, 16 deletions(-) (limited to 'module/vcomponent.scm') diff --git a/module/vcomponent.scm b/module/vcomponent.scm index 9bd70689..e7ffb785 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -27,8 +27,6 @@ "Parse all start times into scheme date objects." (for tz in (filter (lambda (o) (eq? 'VTIMEZONE (type o))) (children cal)) - (format #t "TZ = ~a~%" tz) - (for-each (lambda (p) (mod! (attr p "DTSTART") string->time-utc)) (children tz)) @@ -49,7 +47,6 @@ (define date (parse-datetime (value dptr))) (define end-date (cond [(not eptr) - (format #t "date = ~a~%" date) (let ((d (set (date-hour date) = (+ 1)))) (set! (attr ev 'DTEND) d eptr (attr* ev 'DTEND)) @@ -57,19 +54,12 @@ )] [(value eptr) => parse-datetime] [else - (format #t "date = ~a~%" date) (set (date-hour date) = (+ 1))]) ) - (format #t "ev = ~a~%file = ~a~%" ev (attr ev 'X-HNH-FILENAME)) - - ;; (format #t "ev = ~a~%file = ~a~%" ev (attr ev 'X-HNH-FILENAME)) - (set! (value dptr) (date->time-utc date) (value eptr) (date->time-utc end-date)) - (format #t "After first set") - (when (prop (attr* ev 'DTSTART) 'TZID) (set! (zone-offset date) (get-tz-offset ev) (value dptr) (date->time-utc date) @@ -99,7 +89,6 @@ (if (not path) (primitive-make-vcomponent) (let ((root (parse-cal-path path))) - (format #t "root = ~a~%" root ) (let* ((component (case (string->symbol (or (attr root "X-HNH-SOURCETYPE") "no-type")) ;; == Single ICS file == @@ -107,7 +96,6 @@ ;; returning the wanted VCALENDAR component ((file) ;; TODO test this when an empty file is given. - (display "Hello\n") (car (children root))) ;; == Assume vdir == @@ -123,11 +111,9 @@ ;; What does this even do? (unless (null? ch) - (format #t "Looping over attributes~%") (for key in (attributes (car ch)) (set! (attr accum key) (attr (car ch) key)))) - (format #t "Looping over children, again") (for cal in ch (for component in (children cal) (case (type component) @@ -143,9 +129,7 @@ ((no-type) (throw 'no-type))))) - (display "Here?\n") (parse-dates! component) - (display "Theren") (unless (attr component "NAME") (set! (attr component "NAME") -- cgit v1.2.3 From feefb97cf9118c8e5d7018e33887a371dadc5eab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 6 Oct 2019 13:35:20 +0200 Subject: Minor cleanup in scheme code. --- module/vcomponent.scm | 36 +++++++----------------------------- 1 file changed, 7 insertions(+), 29 deletions(-) (limited to 'module/vcomponent.scm') diff --git a/module/vcomponent.scm b/module/vcomponent.scm index e7ffb785..4d13dbc8 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -32,13 +32,7 @@ ;; TZSET is the generated recurrence set of a timezone (set! (attr tz 'X-HNH-TZSET) - (make-tz-set tz) - #; - ((@ (srfi srfi-41) stream) - (list - (car (children tz)) - (cadr (children tz)))) - )) + (make-tz-set tz))) (for ev in (filter (lambda (o) (eq? 'VEVENT (type o))) (children cal)) (define dptr (attr* ev 'DTSTART)) @@ -50,12 +44,10 @@ (let ((d (set (date-hour date) = (+ 1)))) (set! (attr ev 'DTEND) d eptr (attr* ev 'DTEND)) - d - )] + d)] [(value eptr) => parse-datetime] [else - (set (date-hour date) = (+ 1))]) - ) + (set (date-hour date) = (+ 1))])) (set! (value dptr) (date->time-utc date) (value eptr) (date->time-utc end-date)) @@ -70,21 +62,6 @@ (value eptr) (date->time-utc end-date))))) -;; (define-public value caar) -;; (define-public next cdr) -;; (define-public next! pop!) - - -;; (define-public (reset! attr-list) -;; (while (not (car attr-list)) -;; (next! attr-list)) -;; (next! attr-list)) - -;; value -;; (define-public v -;; (make-procedure-with-setter car set-car!)) - - (define* (make-vcomponent #:optional path) (if (not path) (primitive-make-vcomponent) @@ -121,9 +98,10 @@ (unless (find (lambda (z) (string=? (attr z "TZID") (attr component "TZID"))) - (filter (lambda (o) (eq? 'VTIMEZONE (type o))) (children accum))) - (push-child! accum component))) - (else (push-child! accum component))))) + (filter (lambda (o) (eq? 'VTIMEZONE (type o))) + (children accum))) + (add-child! accum component))) + (else (add-child! accum component))))) ;; return accum)) -- cgit v1.2.3 From de97337a13ffd480355148da252859a205e10b74 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 6 Oct 2019 19:53:27 +0200 Subject: Fix re-export of add-child! --- module/vcomponent.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'module/vcomponent.scm') diff --git a/module/vcomponent.scm b/module/vcomponent.scm index 4d13dbc8..a65ef2d4 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -1,5 +1,7 @@ (define-module (vcomponent) - #:use-module ((vcomponent primitive) :select (parse-cal-path (make-vcomponent . primitive-make-vcomponent))) + #:use-module ((vcomponent primitive) + :select (parse-cal-path + (make-vcomponent . primitive-make-vcomponent))) #:use-module (vcomponent datetime) #:use-module (vcomponent recurrence) #:use-module (vcomponent timezone) -- cgit v1.2.3 From 3554f1b34bb6937cdac6ffc48d8f4d7bf2f4ce3c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 15 Oct 2019 22:06:54 +0200 Subject: Add final fallback for name. --- module/vcomponent.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'module/vcomponent.scm') diff --git a/module/vcomponent.scm b/module/vcomponent.scm index a65ef2d4..31d5b2bf 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -114,7 +114,8 @@ (unless (attr component "NAME") (set! (attr component "NAME") (or (attr component "X-WR-CALNAME") - (attr root "NAME")))) + (attr root "NAME") + "[NAMELESS]"))) (unless (attr component "COLOR") (set! (attr component "COLOR") -- cgit v1.2.3 From 306c2470fbc1085b34f9575c7179c89be2a8cd9d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 29 Oct 2019 17:43:10 +0100 Subject: Minor improvements on timezone loading. --- module/vcomponent.scm | 43 ++++++++++++++++++++++++++++++------------- 1 file changed, 30 insertions(+), 13 deletions(-) (limited to 'module/vcomponent.scm') diff --git a/module/vcomponent.scm b/module/vcomponent.scm index 31d5b2bf..8751440d 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -42,7 +42,8 @@ (define date (parse-datetime (value dptr))) (define end-date - (cond [(not eptr) + (cond ;; [(attr ev 'DURATION) => (lambda (d) (add-duration ...))] + [(not eptr) (let ((d (set (date-hour date) = (+ 1)))) (set! (attr ev 'DTEND) d eptr (attr* ev 'DTEND)) @@ -88,22 +89,38 @@ (let ((accum (primitive-make-vcomponent 'VCALENDAR)) (ch (children root))) - ;; What does this even do? + ;; Copy attributes from our parsed VCALENDAR + ;; to our newly created one. (unless (null? ch) (for key in (attributes (car ch)) (set! (attr accum key) (attr (car ch) key)))) - (for cal in ch - (for component in (children cal) - (case (type component) - ((VTIMEZONE) - (unless (find (lambda (z) - (string=? (attr z "TZID") - (attr component "TZID"))) - (filter (lambda (o) (eq? 'VTIMEZONE (type o))) - (children accum))) - (add-child! accum component))) - (else (add-child! accum component))))) + ;; Merge all children + (let ((tz '())) + (for cal in ch + (for component in (children cal) + (case (type component) + ((VTIMEZONE) + (set! tz (cons component tz)) + #; + (unless (find (lambda (z) + (string=? (attr z "TZID") + (attr component "TZID"))) + (filter (lambda (o) (eq? 'VTIMEZONE (type o))) + (children accum))) + (add-child! accum component))) + ((VEVENT) + (add-child! accum component) + ) + (else => (lambda (type) + (format (current-error-port) + "Got unexpected component of type ~a~%" type)) + #; (add-child! accum component) + )))) + + (unless (null? tz) + (add-child! accum (car tz))) + ) ;; return accum)) -- cgit v1.2.3 From 4cfb8ec5e6dad161dfefb683a64490d468caad7e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sat, 2 Nov 2019 22:26:18 +0100 Subject: Move parser into module subtree. --- module/vcomponent.scm | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) (limited to 'module/vcomponent.scm') diff --git a/module/vcomponent.scm b/module/vcomponent.scm index 8751440d..d3e574b5 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -1,7 +1,4 @@ (define-module (vcomponent) - #:use-module ((vcomponent primitive) - :select (parse-cal-path - (make-vcomponent . primitive-make-vcomponent))) #:use-module (vcomponent datetime) #:use-module (vcomponent recurrence) #:use-module (vcomponent timezone) @@ -124,7 +121,7 @@ ;; return accum)) - ((no-type) (throw 'no-type))))) + ((no-type) (error 'no-type))))) (parse-dates! component) -- cgit v1.2.3 From 275dfc4b4fc7bd8ad3244dbd6c9053fe1ceb7f5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 3 Nov 2019 13:39:57 +0100 Subject: Remove make-vcomponent. --- module/vcomponent.scm | 152 +++++++++++++++++++++++++------------------------- 1 file changed, 75 insertions(+), 77 deletions(-) (limited to 'module/vcomponent.scm') diff --git a/module/vcomponent.scm b/module/vcomponent.scm index d3e574b5..8eeeaff9 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -9,8 +9,8 @@ #:use-module (srfi srfi-19 setters) #:use-module (srfi srfi-26) #:use-module (util) - #:export (make-vcomponent) - #:re-export (repeating?)) + #:export (parse-calendar) + #:re-export (repeating? make-vcomponent)) ;; All VTIMEZONE's seem to be in "local" time in relation to ;; themselves. Therefore, a simple comparison should work, @@ -62,78 +62,76 @@ (value eptr) (date->time-utc end-date))))) -(define* (make-vcomponent #:optional path) - (if (not path) - (primitive-make-vcomponent) - (let ((root (parse-cal-path path))) - (let* ((component - (case (string->symbol (or (attr root "X-HNH-SOURCETYPE") "no-type")) - ;; == Single ICS file == - ;; Remove the abstract ROOT component, - ;; returning the wanted VCALENDAR component - ((file) - ;; TODO test this when an empty file is given. - (car (children root))) - - ;; == Assume vdir == - ;; Also removes the abstract ROOT component, but also - ;; merges all VCALENDAR's children into the a newly - ;; created VCALENDAR component, and return that component. - ;; - ;; TODO the other VCALENDAR components might not get thrown away, - ;; this since I protect them from the GC in the C code. - ((vdir) - (let ((accum (primitive-make-vcomponent 'VCALENDAR)) - (ch (children root))) - - ;; Copy attributes from our parsed VCALENDAR - ;; to our newly created one. - (unless (null? ch) - (for key in (attributes (car ch)) - (set! (attr accum key) (attr (car ch) key)))) - - ;; Merge all children - (let ((tz '())) - (for cal in ch - (for component in (children cal) - (case (type component) - ((VTIMEZONE) - (set! tz (cons component tz)) - #; - (unless (find (lambda (z) - (string=? (attr z "TZID") - (attr component "TZID"))) - (filter (lambda (o) (eq? 'VTIMEZONE (type o))) - (children accum))) - (add-child! accum component))) - ((VEVENT) - (add-child! accum component) - ) - (else => (lambda (type) - (format (current-error-port) - "Got unexpected component of type ~a~%" type)) - #; (add-child! accum component) - )))) - - (unless (null? tz) - (add-child! accum (car tz))) - ) - ;; return - accum)) - - ((no-type) (error 'no-type))))) - - (parse-dates! component) - - (unless (attr component "NAME") - (set! (attr component "NAME") - (or (attr component "X-WR-CALNAME") - (attr root "NAME") - "[NAMELESS]"))) - - (unless (attr component "COLOR") - (set! (attr component "COLOR") - (attr root "COLOR"))) - - ;; return - component)))) +(define* (parse-calendar path) + (let ((root (parse-cal-path path))) + (let* ((component + (case (string->symbol (or (attr root "X-HNH-SOURCETYPE") "no-type")) + ;; == Single ICS file == + ;; Remove the abstract ROOT component, + ;; returning the wanted VCALENDAR component + ((file) + ;; TODO test this when an empty file is given. + (car (children root))) + + ;; == Assume vdir == + ;; Also removes the abstract ROOT component, but also + ;; merges all VCALENDAR's children into the a newly + ;; created VCALENDAR component, and return that component. + ;; + ;; TODO the other VCALENDAR components might not get thrown away, + ;; this since I protect them from the GC in the C code. + ((vdir) + (let ((accum (make-vcomponent 'VCALENDAR)) + (ch (children root))) + + ;; Copy attributes from our parsed VCALENDAR + ;; to our newly created one. + (unless (null? ch) + (for key in (attributes (car ch)) + (set! (attr accum key) (attr (car ch) key)))) + + ;; Merge all children + (let ((tz '())) + (for cal in ch + (for component in (children cal) + (case (type component) + ((VTIMEZONE) + (set! tz (cons component tz)) + #; + (unless (find (lambda (z) + (string=? (attr z "TZID") + (attr component "TZID"))) + (filter (lambda (o) (eq? 'VTIMEZONE (type o))) + (children accum))) + (add-child! accum component))) + ((VEVENT) + (add-child! accum component) + ) + (else => (lambda (type) + (format (current-error-port) + "Got unexpected component of type ~a~%" type)) + #; (add-child! accum component) + )))) + + (unless (null? tz) + (add-child! accum (car tz))) + ) + ;; return + accum)) + + ((no-type) (error 'no-type))))) + + (parse-dates! component) + + (unless (attr component "NAME") + (set! (attr component "NAME") + (or (attr component "X-WR-CALNAME") + (attr root "NAME") + "[NAMELESS]"))) + + (unless (attr component "COLOR") + (set! (attr component "COLOR") + (attr root "COLOR"))) + + ;; return + component))) -- cgit v1.2.3 From cecffe9ebdd0bb1efb628da320039fec9e6cba39 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 3 Nov 2019 13:57:46 +0100 Subject: Move stuff between vcomponent/{base,parse}. --- module/vcomponent.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'module/vcomponent.scm') diff --git a/module/vcomponent.scm b/module/vcomponent.scm index 8eeeaff9..871ac2e7 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -3,6 +3,7 @@ #:use-module (vcomponent recurrence) #:use-module (vcomponent timezone) #:use-module (vcomponent base) + #:use-module (vcomponent parse) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (srfi srfi-19 util) -- cgit v1.2.3