diff options
-rw-r--r-- | module/vcalendar.scm | 12 | ||||
-rw-r--r-- | module/vcalendar/primitive.scm | 3 | ||||
-rw-r--r-- | src/guile_interface.scm.c | 59 |
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.") |