diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-03-12 19:04:57 +0100 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-03-12 19:04:57 +0100 |
| commit | 02d78f172c52035852d99a60cece76c4d0e1a08b (patch) | |
| tree | 9cc40bab02e82e208727c79ced79e808fd1c0ac4 /vcalendar.scm | |
| parent | Add name and color parsing to calendar, Add TYPE. (diff) | |
| download | calp-02d78f172c52035852d99a60cece76c4d0e1a08b.tar.gz calp-02d78f172c52035852d99a60cece76c4d0e1a08b.tar.xz | |
Update vcalendar to utilize TYPE field.
Diffstat (limited to '')
| -rw-r--r-- | vcalendar.scm | 73 |
1 files changed, 45 insertions, 28 deletions
diff --git a/vcalendar.scm b/vcalendar.scm index 4e595c22..efb00247 100644 --- a/vcalendar.scm +++ b/vcalendar.scm @@ -66,32 +66,49 @@ (if (string? k2) (string->symbol k2) k2))) (define-public (make-vcomponent path) - (parse-dates! - (if (string-ci=? ".ics" (string-take-right path 4)) - ;; == Single ICS file == - ;; Remove the abstract ROOT component, - ;; returning the wanted VCALENDAR component - (car (%vcomponent-children - (%vcomponent-make path))) - ;; == Assume vdir == - ;; Also removes the abstract ROOT component, but also - ;; merges all VCALENDAR's children into the first - ;; VCALENDAR, and return that VCALENDAR. - ;; - ;; TODO the other VCALENDAR components might not get thrown away, - ;; this since I protect them from the GC in the C code. - (reduce (lambda (cal accum) - (for-each (lambda (component) - (case (type component) - ((VTIMEZONE) - (let ((zones (children cal 'VTIMEZONE))) - (unless (find (lambda (z) - (string=? (attr z "TZID") - (attr component "TZID"))) - zones) - (%vcomponent-push-child! accum component)))) - (else (%vcomponent-push-child! accum component)))) - (%vcomponent-children cal)) - accum) - '() (%vcomponent-children (%vcomponent-make path)))))) + (let* ((root (%vcomponent-make path)) + (component + (parse-dates! + (case (string->symbol (or (attr root "TYPE") "no-type")) + ;; == Single ICS file == + ;; Remove the abstract ROOT component, + ;; returning the wanted VCALENDAR component + ((file) + (car (%vcomponent-children root))) + + ;; == Assume vdir == + ;; Also removes the abstract ROOT component, but also + ;; merges all VCALENDAR's children into the first + ;; VCALENDAR, and return that VCALENDAR. + ;; + ;; TODO the other VCALENDAR components might not get thrown away, + ;; this since I protect them from the GC in the C code. + ((vdir) + (reduce (lambda (cal accum) + (for-each (lambda (component) + (case (type component) + ((VTIMEZONE) + (let ((zones (children cal 'VTIMEZONE))) + (unless (find (lambda (z) + (string=? (attr z "TZID") + (attr component "TZID"))) + zones) + (%vcomponent-push-child! accum component)))) + (else (%vcomponent-push-child! accum component)))) + (%vcomponent-children cal)) + accum) + '() (%vcomponent-children root))) + + ((no-type) (throw 'no-type)) + + (else (throw 'something)))))) + + (display component) (newline) + (display root) (newline) + + (set! (attr component "NAME") + (attr root "NAME")) + (set! (attr component "COLOR") + (attr root "COLOR")) + component)) |