From a6aa6ff2fffe298b90788a07059902d85e3a1391 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Tue, 26 Feb 2019 01:14:02 +0100
Subject: Add %vcomponent-parent.

---
 guile_interface.h     |  3 +++
 guile_interface.scm.c | 25 +++++++++++++++++++++++--
 guile_type_helpers.c  | 10 +++-------
 guile_type_helpers.h  |  2 +-
 vcalendar.scm         |  5 ++++-
 5 files changed, 34 insertions(+), 11 deletions(-)

diff --git a/guile_interface.h b/guile_interface.h
index ab86850c..76ec24d3 100644
--- a/guile_interface.h
+++ b/guile_interface.h
@@ -2,6 +2,7 @@
 #define GUILE_INTERFACE_H
 
 #include <libguile.h>
+#include "vcal.h"
 
 /*
  * At a number of places scm_gc_{un,}protect_object is called.
@@ -22,4 +23,6 @@ SCM vcomponent_child_count (SCM);
 SCM vcomponent_children (SCM);
 SCM vcomponent_typeof (SCM);
 
+SCM scm_from_vcomponent (vcomponent*);
+
 #endif /* GUILE_INTERFACE_H */
diff --git a/guile_interface.scm.c b/guile_interface.scm.c
index 78045fca..244116e3 100644
--- a/guile_interface.scm.c
+++ b/guile_interface.scm.c
@@ -1,6 +1,5 @@
 #include "guile_interface.h"
 
-#include "vcal.h"
 #include "calendar.h"
 #include "guile_type_helpers.h"
 
@@ -93,7 +92,7 @@ SCM_DEFINE(vcomponent_children, "%vcomponent-children", 1, 0, 0,
 {
 	scm_assert_foreign_object_type (vcomponent_type, component);
 	vcomponent* cal = scm_foreign_object_ref (component, 0);
-	return scm_from_vector(&cal->components, vcomponent_type);
+	return scm_from_vector(&cal->components);
 }
 
 SCM_DEFINE(vcomponent_push_child_x, "%vcomponent-push-child!", 2, 0, 0,
@@ -110,6 +109,20 @@ SCM_DEFINE(vcomponent_push_child_x, "%vcomponent-push-child!", 2, 0, 0,
 	return SCM_UNSPECIFIED;
 }
 
+SCM_DEFINE (vcomponent_parent, "%vcomponent-parent", 1, 0, 0,
+		(SCM component),
+		"")
+{
+	scm_assert_foreign_object_type (vcomponent_type, component);
+	vcomponent* comp = scm_foreign_object_ref (component, 0);
+
+	vcomponent* parent = comp->parent;
+	if (strcmp(parent->type, "ROOT") == 0) {
+		return SCM_BOOL_F;
+	} else {
+		return scm_from_vcomponent(parent);
+	}
+}
 
 SCM_DEFINE(vcomponent_typeof, "%vcomponent-type", 1, 0, 0,
 		(SCM component),
@@ -120,6 +133,14 @@ SCM_DEFINE(vcomponent_typeof, "%vcomponent-type", 1, 0, 0,
 	return scm_from_utf8_symbol(comp->type);
 }
 
+SCM scm_from_vcomponent(vcomponent* v) {
+	if (v->scm == NULL) {
+		v->scm = scm_make_foreign_object_1 (vcomponent_type, v);
+		scm_gc_protect_object(v->scm);
+	}
+	return v->scm;
+}
+
 void init_lib (void) {
 	init_vcomponent_type();
 
diff --git a/guile_type_helpers.c b/guile_type_helpers.c
index 00c68b18..5c7090ec 100644
--- a/guile_type_helpers.c
+++ b/guile_type_helpers.c
@@ -1,4 +1,5 @@
 #include "guile_type_helpers.h"
+#include "guile_interface.h"
 
 #include "macro.h"
 
@@ -11,17 +12,12 @@ SCM scm_from_strbuf(strbuf* s) {
 	return s->scm;
 }
 
-SCM scm_from_vector(VECT(vcomponent)* vect, SCM element_type) {
+SCM scm_from_vector(VECT(vcomponent)* vect) {
 	SCM l = SCM_EOL;
 	for (size_t i = 0; i < vect->length; i++) {
 		vcomponent* v = GET(VECT(vcomponent))(vect, i);
-		if (v->scm == NULL) {
-			v->scm = scm_make_foreign_object_1 (element_type, v);
-			scm_gc_protect_object(v->scm);
-		}
-		l = scm_cons(v->scm, l);
+		l = scm_cons(scm_from_vcomponent(v), l);
 	}
 	return scm_reverse(l);
 }
 
-
diff --git a/guile_type_helpers.h b/guile_type_helpers.h
index 427c55c6..005ee34b 100644
--- a/guile_type_helpers.h
+++ b/guile_type_helpers.h
@@ -10,6 +10,6 @@
 
 SCM scm_from_strbuf(strbuf* s);
 
-SCM scm_from_vector(VECT(vcomponent)* vect, SCM element_type);
+SCM scm_from_vector(VECT(vcomponent)* vect);
 
 #endif /* GUILE_TYPE_HELPERS_H */
diff --git a/vcalendar.scm b/vcalendar.scm
index b80e40e6..c6aee02c 100644
--- a/vcalendar.scm
+++ b/vcalendar.scm
@@ -18,6 +18,9 @@
       ;; 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))
@@ -28,7 +31,7 @@
 (define set-attr! %vcomponent-set-attribute!)
 (define get-attr %vcomponent-get-attribute)
 (define type %vcomponent-type)
-
+(define parent %vcomponent-parent)
 (define push-child! %vcomponent-push-child!)
 
 (define (transform-attr! ev field transformer)
-- 
cgit v1.2.3