Add (read only) property access from scheme.

3 files changed, 74 insertions, 0 deletions

diff --git a/module/vcalendar.scm b/module/vcalendar.scm
index 51c4f8e3..0f1a3c57 100644
--- a/module/vcalendar.scm
+++ b/module/vcalendar.scm
@@ -39,6 +39,18 @@
    component
    (as-string attr)))
 
+(define (get-property component attr prop)
+  (%vcomponent-get-property
+   component
+   (as-string attr)
+   (as-string prop)))
+
+;; TODO replace this with procedure-with-setter
+(define-public prop get-property)
+
+(define-public (properties component attr)
+  (%vcomponent-property-list component (as-string attr)))
+
 ;; Enables symmetric get and set:
 ;; (set! (attr ev "KEY") 10)
 (define-public attr (make-procedure-with-setter get-attr set-attr!))
diff --git a/module/vcalendar/primitive.scm b/module/vcalendar/primitive.scm
index fed799f9..f41a7803 100644
--- a/module/vcalendar/primitive.scm
+++ b/module/vcalendar/primitive.scm
@@ -14,6 +14,9 @@
             %vcomponent-set-attribute!
             %vcomponent-get-attribute
 
+            %vcomponent-get-property
+            %vcomponent-property-list
+
             %vcomponent-attribute-list
 
             %vcomponent-shallow-copy))
diff --git a/src/guile_interface.scm.c b/src/guile_interface.scm.c
index 9356533d..d4a7021f 100644
--- a/src/guile_interface.scm.c
+++ b/src/guile_interface.scm.c
@@ -62,6 +62,34 @@ SCM_DEFINE (vcomponent_get_attribute, "%vcomponent-get-attribute", 2, 0, 0,
 	}
 }
 
+SCM_DEFINE (vcomponent_get_property, "%vcomponent-get-property", 3, 0, 0,
+            (SCM component, SCM attr, SCM prop),
+            "")
+{
+	scm_assert_foreign_object_type (vcomponent_type, component);
+	vcomponent* comp = scm_foreign_object_ref (component, 0);
+
+	char* key      = scm_to_utf8_stringn(scm_string_upcase(attr), NULL);
+	char* prop_key = scm_to_utf8_stringn(scm_string_upcase(prop), NULL);
+	content_line* cl = get_property (comp, key);
+	free(key);
+
+	if (cl == NULL) return SCM_BOOL_F;
+
+	SCM llist = SCM_EOL;
+	FOR (LLIST, content_set, cs, cl) {
+		LLIST(strbuf)* strs = GET(TRIE(param_set))(&cs->val, prop_key);
+		if (strs == NULL) continue;
+		SCM subl = SCM_EOL;
+		FOR (LLIST, strbuf, s, strs) {
+			subl = scm_cons(scm_from_strbuf(s), subl);
+		}
+		llist = scm_cons(subl, llist);
+	}
+
+	return llist;
+}
+
 SCM_DEFINE (vcomponent_set_attr_x, "%vcomponent-set-attribute!", 3, 0, 0,
 		(SCM component, SCM attr, SCM new_value),
 		"")
@@ -227,6 +255,37 @@ SCM_DEFINE(vcomponent_attr_list, "%vcomponent-attribute-list", 1, 0, 0,
 	return llist;
 }
 
+SCM_DEFINE(vcomponent_prop_list, "%vcomponent-property-list", 2, 0, 0,
+           (SCM component, SCM attr),
+           "")
+{
+	scm_assert_foreign_object_type (vcomponent_type, component);
+	vcomponent* comp = scm_foreign_object_ref (component, 0);
+
+	char* key      = scm_to_utf8_stringn(scm_string_upcase(attr), NULL);
+	content_line* cl = get_property (comp, key);
+	free(key);
+
+	if (cl == NULL) return SCM_BOOL_F;
+
+	SCM llist = SCM_EOL;
+	FOR (LLIST, content_set, cs, cl) {
+		LLIST(strbuf)* keys = KEYS(TRIE(param_set))(&cs->val);
+		if (keys == NULL) continue;
+
+		FOR (LLIST, strbuf, s, keys) {
+			SCM symb = scm_string_to_symbol(scm_from_strbuf(s));
+			if ( scm_is_false(scm_memv (symb, llist)) ) {
+				llist = scm_cons(symb, llist);
+			}
+		}
+
+		FFREE(LLIST(strbuf), keys);
+	}
+
+	return llist;
+}
+
 SCM_DEFINE(vcomponent_shallow_copy, "%vcomponent-shallow-copy", 1, 0, 0,
            (SCM component),
            "Creates a shallow copy of the given component.")