Add VIRTUAL vcomponents.

VIRTUAL vcomponents are vcomponents created without a source. Their
primiary purpose is for creating brand new events, which will later be
dumped to the proper files.

They can however also be used in testing for great effect.

6 files changed, 52 insertions, 12 deletions

diff --git a/module/vcalendar.scm b/module/vcalendar.scm
index 3f7ba6ba..c978f3fc 100644
--- a/module/vcalendar.scm
+++ b/module/vcalendar.scm
@@ -42,7 +42,10 @@
 ;; (set! (attr ev "KEY") 10)
 (define-public attr (make-procedure-with-setter get-attr set-attr!))
 
-(define-public type %vcomponent-type)
+;; (define-public type %vcomponent-get-type)
+(define-public type (make-procedure-with-setter
+                     %vcomponent-get-type
+                     %vcomponent-set-type!))
 (define-public parent %vcomponent-parent)
 (define-public push-child! %vcomponent-push-child!)
 (define-public (attributes component) (map string->symbol (%vcomponent-attribute-list component)))
@@ -71,7 +74,7 @@
   (let* ((root (%vcomponent-make path))
          (component
           (parse-dates!
-           (case (string->symbol (or (attr root "TYPE") "no-type"))
+           (case (string->symbol (or (attr root "X-HNH-SOURCETYPE") "no-type"))
              ;; == Single ICS file ==
              ;; Remove the abstract ROOT component,
              ;; returning the wanted VCALENDAR component
diff --git a/module/vcalendar/primitive.scm b/module/vcalendar/primitive.scm
index b5eb9388..fed799f9 100644
--- a/module/vcalendar/primitive.scm
+++ b/module/vcalendar/primitive.scm
@@ -8,7 +8,8 @@
             %vcomponent-parent
 
             %vcomponent-make
-            %vcomponent-type
+            %vcomponent-get-type
+            %vcomponent-set-type!
 
             %vcomponent-set-attribute!
             %vcomponent-get-attribute
diff --git a/src/calendar.c b/src/calendar.c
index be681abe..403ae83c 100644
--- a/src/calendar.c
+++ b/src/calendar.c
@@ -39,7 +39,7 @@ int handle_file(vcomponent* cal, char* path) {
 	INFO("Parsing a single file");
 
 	vcomponent_push_val(cal, "NAME", path);
-	vcomponent_push_val(cal, "TYPE", "file");
+	vcomponent_push_val(cal, "X-HNH-SOURCETYPE", "file");
 	char* resolved_path = realpath(path, NULL);
 	open_ics (resolved_path, cal);
 	free (resolved_path);
@@ -66,7 +66,7 @@ int handle_dir(vcomponent* cal, char* path) {
 	 * TODO cut path to its last component.
 	 */
 	vcomponent_push_val(cal, "NAME", path);
-	vcomponent_push_val(cal, "TYPE", "vdir");
+	vcomponent_push_val(cal, "X-HNH-SOURCETYPE", "vdir");
 
 	struct dirent* d;
 	while ((d = readdir(dir)) != NULL) {
diff --git a/src/guile_interface.scm.c b/src/guile_interface.scm.c
index 7c6fee6f..a9485b38 100644
--- a/src/guile_interface.scm.c
+++ b/src/guile_interface.scm.c
@@ -12,18 +12,23 @@ void init_vcomponent_type (void) {
 	vcomponent_type = scm_make_foreign_object_type(name, slots, NULL);
 }
 
-SCM_DEFINE (make_vcomponent, "%vcomponent-make", 1, 0, 0,
+SCM_DEFINE (make_vcomponent, "%vcomponent-make", 0, 1, 0,
 		(SCM path),
 		"Loads a vdir iCalendar from the given path.")
 {
 	vcomponent* cal =
 		(vcomponent*) scm_gc_malloc (
 				sizeof(*cal), "vcomponent");
-	INIT(vcomponent, cal, "ROOT");
 
-	char* p = scm_to_utf8_stringn(path, NULL);
-	read_vcalendar(cal, p);
-	free(p);
+	if (SCM_UNBNDP(path)) {
+		INIT(vcomponent, cal);
+	} else {
+		INIT(vcomponent, cal, "ROOT");
+
+		char* p = scm_to_utf8_stringn(path, NULL);
+		read_vcalendar(cal, p);
+		free(p);
+	}
 
 	return scm_from_vcomponent (cal);
 }
@@ -171,7 +176,7 @@ SCM_DEFINE (vcomponent_parent, "%vcomponent-parent", 1, 0, 0,
 	}
 }
 
-SCM_DEFINE(vcomponent_typeof, "%vcomponent-type", 1, 0, 0,
+SCM_DEFINE(vcomponent_typeof, "%vcomponent-get-type", 1, 0, 0,
 		(SCM component),
 		"Returns type of vcomponent")
 {
@@ -180,6 +185,22 @@ SCM_DEFINE(vcomponent_typeof, "%vcomponent-type", 1, 0, 0,
 	return scm_from_utf8_symbol(comp->type);
 }
 
+SCM_DEFINE(vcomponent_set_type_x, "%vcomponent-set-type!", 2, 0, 0,
+		(SCM component, SCM type),
+		"Replace current type of vcomponent")
+{
+	scm_assert_foreign_object_type (vcomponent_type, component);
+	vcomponent* comp = scm_foreign_object_ref (component, 0);
+
+	if (comp->type) free (comp->type);
+
+	char* ntype = scm_to_utf8_stringn (type, NULL);
+	comp->type = calloc(sizeof(*ntype), strlen(ntype) + 1);
+	strcpy(comp->type, ntype);
+
+	return SCM_UNSPECIFIED;
+}
+
 SCM scm_from_vcomponent(vcomponent* v) {
 	if (v->scm == NULL) {
 		v->scm = scm_make_foreign_object_1 (vcomponent_type, v);
diff --git a/src/vcal.c b/src/vcal.c
index fdb68d54..2a610187 100644
--- a/src/vcal.c
+++ b/src/vcal.c
@@ -34,7 +34,12 @@ INIT_F(vcomponent) {
 	INIT(TRIE(content_line), &self->clines);
 	INIT(LLIST(vcomponent), &self->components);
 
-	self->type = NULL;
+	// vcomponent_push_val (self, "X-HNH-FILENAME", "VIRTUAL");
+	vcomponent_push_val (self, "X-HNH-SOURCETYPE", "virtual");
+	char* type = "VIRTUAL";
+	self->type = (char*) calloc(sizeof(*type), strlen(type) + 1);
+	strcpy(self->type, type);
+
 	self->parent = NULL;
 	self->scm = NULL;
 
@@ -52,6 +57,15 @@ INIT_F(vcomponent, const char* type, const char* filename) {
 	INIT(LLIST(vcomponent), &self->components);
 
 	if (filename != NULL) {
+		/*
+		 * NOTE
+		 * RFC-7986 adds additional parameters linked to this one.
+		 * - `SOURCE' :: where a (possibly) updated version of the data can be
+		 *   found 
+		 * - `URL' :: Where the same data can be fonud, but
+		 *   differently (but not where the original data can be fonud
+		 *   agani).
+		 */
 		vcomponent_push_val (self, "X-HNH-FILENAME", filename);
 	}
 
diff --git a/src/vcal.h b/src/vcal.h
index 1dfc5b17..3db5fcdc 100644
--- a/src/vcal.h
+++ b/src/vcal.h
@@ -68,6 +68,7 @@ typedef struct s_vcomponent vcomponent;
 #undef TYPE
 
 struct s_vcomponent {
+	/* VCALENDAR, VEVENT, ... */
 	char* type;
 	vcomponent* parent;
 	TRIE(content_line) clines;