Rework how attributes and properties are accessed.

Made the fact that properties belong to an attribute shine through to
scheme. This by setting the SCM field in the strbuf:ers in my
vcomponents to a pair of their old SCM value, and a hash table
representing the properties.

This also meant that the primitive set-attribute! could be replaced by a
set-car! on the pair returned by the primitive get-attribute. And that
both set- and get-property now simple works on the hash table returned
by get-attribute.

The major problem with this release was that I for a while missed that
DEEP_COPY(strbuf) now also needed to deep copy the SCM values. Without
that attributes in a copied vcomponent would be shared with the
original. This mainly lead to repeating events all being the same.

2 files changed, 43 insertions, 124 deletions

diff --git a/src/guile_interface.scm.c b/src/guile_interface.scm.c
index 036e9e9c..0f795d44 100644
--- a/src/guile_interface.scm.c
+++ b/src/guile_interface.scm.c
@@ -45,109 +45,54 @@ SCM_DEFINE (vcomponent_get_attribute, "%vcomponent-get-attribute", 2, 0, 0,
 
 	char* key = scm_to_utf8_stringn(scm_string_upcase(attr), NULL);
 	content_line* c = get_attributes (cal, key);
-	free(key);
-
-	if (c == NULL) return SCM_BOOL_F;
-
-	SCM llist = SCM_EOL;
-	FOR (LLIST, content_set, v, c) {
-		llist = scm_cons(scm_from_strbuf(&v->key), llist);
-	}
 
-	/* returns the car of list if list is one long. */
-	if (scm_to_int(scm_length(llist)) == 1) {
-		return SCM_CAR(llist);
-	} else {
-		return llist;
+	if (c == NULL) {
+		vcomponent_push_val(cal, key, "");
+		c = get_attributes (cal, key);
+		c->cval->key.scm = SCM_BOOL_F;
 	}
-}
-
-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_attributes (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);
+	SCM val, attrlist = SCM_EOL, proplist;
+	LLIST(strbuf) *triekeys, *trievals;
+	/* For every instance of a line */
+	FOR (LLIST, content_set, v, c) {
+		val = scm_from_strbuf(&v->key);
+		if (! scm_is_pair(val)) {
+			// TODO look into using a weak hash table instead
+
+			// TODO why is it an error to unprotect the object here?
+			// scm_from_strbuf should already have protected it...
+			// scm_gc_unprotect_object(v->key.scm);
+			val = scm_cons(val, SCM_MAKE_HASH_TABLE());
+			v->key.scm = val;
+			scm_gc_protect_object(v->key.scm);
 		}
-		llist = scm_cons(subl, llist);
-	}
-
-	return llist;
-}
 
-SCM_DEFINE (vcomponent_set_property_x, "%vcomponent-set-property!", 4, 0, 0,
-            (SCM component, SCM attr, SCM prop, SCM val),
-            "")
-{
-	scm_assert_foreign_object_type (vcomponent_type, component);
-	vcomponent* comp = scm_foreign_object_ref (component, 0);
+		triekeys = KEYS(TRIE(param_set))(&v->val);
+		/* For every property key bound to the current attribute */
+		FOR (LLIST, strbuf, k, triekeys) {
+			proplist = SCM_EOL;
 
-	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_attributes (comp, key);
-	free(key);
-
-	TRIE(param_set)* tt = &cl->cval->val;
-	LLIST(strbuf)* vals = GET(TRIE(param_set))(tt, prop_key);
-	vals->cval->scm = val;
-
-	return SCM_UNSPECIFIED;
-}
-
-SCM_DEFINE (vcomponent_set_attr_x, "%vcomponent-set-attribute!", 3, 0, 0,
-		(SCM component, SCM attr, SCM new_value),
-		"")
-{
-	scm_assert_foreign_object_type (vcomponent_type, component);
-	vcomponent* com = scm_foreign_object_ref (component, 0);
-
-	char* key = scm_to_utf8_stringn(scm_string_upcase(attr), NULL);
-	content_line* c = get_attributes (com, key);
+			trievals = GET(TRIE(param_set))(&v->val, k->mem);
+			/* For every value bound to the current property */
+			FOR (LLIST, strbuf, s, trievals) {
+				proplist = scm_cons(scm_from_strbuf(s), proplist);
+			}
 
-	/* Create the position in the TRIE if it doesn't already exist */
-	if (c == NULL) {
-		/* Insert empty key since this allows me to use the helper
-		 * function */
-		vcomponent_push_val(com, key, "");
-		c = get_attributes (com, key);
-	} else {
-		/*
-		 * The SCM representation of an object is usually initialized
-		 * when an attribute is first accessed from guile. If we
-		 * however try to set it before accessing it then that field
-		 * will still be NULL.
-		 *
-		 * If the object, and its SCM instance exist, unprotect it.
-		 * Otherwise we know that it's NULL and safe to write a new
-		 * SCM value there.
-		 */
-		if (c->cval->key.scm != NULL) {
-			scm_gc_unprotect_object(c->cval->key.scm);
+			scm_hashq_set_x(scm_cdr(val), scm_from_strbuf_symbol(k),
+			                scm_reverse(proplist));
 		}
+		attrlist = scm_cons(val, attrlist);
 	}
 
-	free(key);
-
-	strbuf* target = &c->cval->key;
-	target->scm = new_value;
-	scm_gc_protect_object(target->scm);
-
-	return SCM_UNSPECIFIED;
+	/* returns the car of list if list is one long. */
+	if (scm_to_int(scm_length(attrlist)) == 1) {
+		return SCM_CAR(attrlist);
+	} else {
+		return attrlist;
+	}
 }
 
 SCM_DEFINE (vcomponent_child_count, "%vcomponent-child-count", 1, 0, 0,
@@ -274,37 +219,6 @@ 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_attributes (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.")
diff --git a/src/strbuf.c b/src/strbuf.c
index c7e3f2b5..66fe2989 100644
--- a/src/strbuf.c
+++ b/src/strbuf.c
@@ -70,8 +70,13 @@ int DEEP_COPY(strbuf)(strbuf* dest, strbuf* src) {
 	}
 
 	if (src->scm != NULL) {
-		/* The magic SCM type is copied when reassigned. */
-		dest->scm = src->scm;
+		/*
+		 * Upon Vcomponent binding into scheme I place all
+		 * strings inside cons cells. This leads to a deep
+		 * copy being required. copy-tree however returns
+		 * the same object for atoms and scheme strings.
+		 */
+		dest->scm = scm_copy_tree(src->scm);
 		/* NOTE This is a bit of a leaky abstraction.  */
 		scm_gc_protect_object(dest->scm);
 	}