From 2cb76416fb78cd6d9a6ffeb7a1ca282cc6d2ffb1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sun, 10 Mar 2019 23:36:45 +0100
Subject: Update vcalendar to allow symbol keys.

---
 vcalendar.scm | 70 +++++++++++++++++++++++++++++++++++++++--------------------
 1 file changed, 47 insertions(+), 23 deletions(-)

(limited to 'vcalendar.scm')

diff --git a/vcalendar.scm b/vcalendar.scm
index 2ce5a438..4e595c22 100644
--- a/vcalendar.scm
+++ b/vcalendar.scm
@@ -13,26 +13,6 @@
                  (mod! (attr ev "DTEND")   parse-datetime)))
   cal)
 
-(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 (cut %vcomponent-push-child! accum <>)
-                           (%vcomponent-children cal))
-                 accum)
-               '() (%vcomponent-children (%vcomponent-make path))))))
 
 (define-public (type-filter t lst)
   (filter (lambda (e) (eqv? t (type e)))
@@ -45,8 +25,16 @@
         childs)))
 (export children)
 
-(define set-attr! %vcomponent-set-attribute!)
-(define get-attr %vcomponent-get-attribute)
+(define (set-attr! component attr value)
+  (%vcomponent-set-attribute!
+   component
+   (if (symbol? attr) (symbol->string attr) attr)
+   value))
+
+(define (get-attr component attr)
+  (%vcomponent-get-attribute
+   component
+   (if (symbol? attr) (symbol->string attr) attr)))
 
 ;; Enables symmetric get and set:
 ;; (set! (attr ev "KEY") 10)
@@ -55,7 +43,7 @@
 (define-public type %vcomponent-type)
 (define-public parent %vcomponent-parent)
 (define-public push-child! %vcomponent-push-child!)
-(define-public attributes %vcomponent-attribute-list)
+(define-public (attributes component) (map string->symbol (%vcomponent-attribute-list component)))
 
 (define-public copy-vcomponent %vcomponent-shallow-copy)
 
@@ -71,3 +59,39 @@
 
 (define-public (extract field)
   (cut get-attr <> field))
+
+(define-public (key=? k1 k2)
+  (eq?
+   (if (string? k1) (string->symbol k1) k1)
+   (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))))))
+
-- 
cgit v1.2.3