Start rework of guile interface.

7 files changed, 155 insertions, 182 deletions

diff --git a/code.scm b/code.scm
index 2c598c46..01832a05 100755
--- a/code.scm
+++ b/code.scm
@@ -11,23 +11,24 @@
 (begin
   ;; Supurflous begin block here to make sourcing into geiser easier.
   (setenv "LD_LIBRARY_PATH" (getcwd))
-  (load-extension "libguile-calendar" "init_calendar"))
-
-(define (get-properties calendar)
-  "Fancy wrappen around primitive-get-properties.
-Transforms character codes into actuall chcaracters."
-  (define (recur tree)
-    (let ((head (car tree)))
-      (cons (cons (integer->char (car head))
-                  (cdr head))
-            (map recur (cdr tree)))))
-  (let ((result (recur (primitive-get-properties calendar))))
-    (cons 'ROOT (cdr result))))
-
-(let* ((v (make-calendar "test-cal/alarm"))
-       (props (get-properties (cadr (get-components (car (get-components v)))))))
-  (pretty-print (beautify (flatten props)))
-  (newline))
+  (load-extension "libguile-calendar" "init_vcomponent"))
+
+(begin
+  (define root (make-vcomponent "test.ics"))
+  (define cal (car (vcomponent-children root)))
+  (define events (vcomponent-children cal)))
+
+(define (pp-list strs)
+  (for-each (lambda (i str)
+              (format #t "~3d | ~a~%"
+                      (1+ i)
+                      str))
+            (iota (length strs))
+            strs))
+
+(pp-list
+ (map (lambda (c) (car (vcomponent-get-attribute c "summary")))
+      events))
 
 #;
 (do ((i 0 (1+ i)))
diff --git a/guile_interface.h b/guile_interface.h
new file mode 100644
index 00000000..91e25a72
--- /dev/null
+++ b/guile_interface.h
@@ -0,0 +1,15 @@
+#ifndef GUILE_INTERFACE_H
+#define GUILE_INTERFACE_H
+
+#include <libguile.h>
+
+void init_vcomponent ();
+void init_vcomponent_type (void);
+
+SCM make_vcomponent (SCM);
+SCM vcomponent_get_attribute (SCM, SCM);
+SCM vcomponent_child_count (SCM);
+SCM vcomponent_children (SCM);
+SCM vcomponent_typeof (SCM);
+
+#endif /* GUILE_INTERFACE_H */
diff --git a/guile_interface.scm.c b/guile_interface.scm.c
new file mode 100644
index 00000000..6aeeba66
--- /dev/null
+++ b/guile_interface.scm.c
@@ -0,0 +1,91 @@
+#include "guile_interface.h"
+
+#include "vcal.h"
+#include "calendar.h"
+#include "guile_type_helpers.h"
+
+static SCM vcomponent_type;
+
+void init_vcomponent_type (void) {
+	SCM name = scm_from_utf8_symbol("vcomponent");
+	SCM slots = scm_list_1(scm_from_utf8_symbol("data"));
+
+	vcomponent_type = scm_make_foreign_object_type(name, slots, NULL);
+}
+
+SCM_DEFINE (make_vcomponent, "make-vcomponent", 1, 0, 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);
+
+	return scm_make_foreign_object_1
+		(vcomponent_type, cal);
+
+}
+
+/*
+ * Returns a line from a component.
+ */
+SCM_DEFINE (vcomponent_get_attribute, "vcomponent-get-attribute", 2, 0, 0,
+		(SCM calendar, SCM attr),
+		"Retuns the given attribute from the vevent object at index in calendar.")
+{
+	scm_assert_foreign_object_type (vcomponent_type, calendar);
+	vcomponent* cal = scm_foreign_object_ref (calendar, 0);
+
+	char* key = scm_to_utf8_stringn(scm_string_upcase(attr), NULL);
+	content_line* c = get_property (cal, key);
+	free(key);
+
+	if (c == NULL) return SCM_BOOL_F;
+
+	SCM llist = SCM_EOL;
+	FOR (LLIST, content_set, v, &c->val) {
+		llist = scm_cons(scm_from_strbuf(&v->key), llist);
+	}
+	return llist;
+}
+
+SCM_DEFINE (vcomponent_child_count, "vcomponent-child-count", 1, 0, 0,
+		(SCM component),
+		"Returns number of child components.")
+{
+	scm_assert_foreign_object_type (vcomponent_type, component);
+	vcomponent* c = scm_foreign_object_ref (component, 0);
+	return scm_from_size_t (SIZE(VECT(vcomponent))(&c->components));
+}
+
+/* TODO This currently returns a new foreign object each time I call it.  */
+SCM_DEFINE(vcomponent_children, "vcomponent-children", 1, 0, 0,
+		(SCM component),
+		"")
+{
+	scm_assert_foreign_object_type (vcomponent_type, component);
+	vcomponent* cal = scm_foreign_object_ref (component, 0);
+	return scm_from_vector(&cal->components, vcomponent_type);
+}
+
+SCM_DEFINE(vcomponent_typeof, "vcomponent-typeof", 1, 0, 0,
+		(SCM component),
+		"Returns type of vcomponent")
+{
+	scm_assert_foreign_object_type (vcomponent_type, component);
+	vcomponent* comp = scm_foreign_object_ref (component, 0);
+	return scm_from_utf8_symbol(comp->type);
+}
+
+void init_vcomponent () {
+	init_vcomponent_type();
+
+#ifndef SCM_MAGIC_SNARFER
+#include "guile_interface.x"
+#endif
+}
diff --git a/guile_type_helpers.c b/guile_type_helpers.c
new file mode 100644
index 00000000..3f76c2d4
--- /dev/null
+++ b/guile_type_helpers.c
@@ -0,0 +1,18 @@
+#include "guile_type_helpers.h"
+
+#include "macro.h"
+
+SCM scm_from_strbuf(strbuf* s)
+	{ return scm_from_utf8_stringn (s->mem, s->len - 1); }
+
+SCM scm_from_vector(VECT(vcomponent)* vect, SCM element_type) {
+	SCM l = SCM_EOL;
+	for (size_t i = 0; i < vect->length; i++) {
+		l = scm_cons(
+				scm_make_foreign_object_1 (element_type, GET(VECT(vcomponent))(vect, i)),
+				l);
+	}
+	return scm_reverse(l);
+}
+
+
diff --git a/guile_type_helpers.h b/guile_type_helpers.h
new file mode 100644
index 00000000..bb69312d
--- /dev/null
+++ b/guile_type_helpers.h
@@ -0,0 +1,13 @@
+#ifndef GUILE_TYPE_HELPERS_H
+#define GUILE_TYPE_HELPERS_H
+
+#include <libguile.h>
+
+#include "calendar.h"
+#include "strbuf.h"
+
+SCM scm_from_strbuf(strbuf* s);
+
+SCM scm_from_vector(VECT(vcomponent)* vect, SCM element_type);
+
+#endif /* GUILE_TYPE_HELPERS_H */
diff --git a/scheme.h b/scheme.h
deleted file mode 100644
index dff4b07f..00000000
--- a/scheme.h
+++ /dev/null
@@ -1,24 +0,0 @@
-#ifndef SCHEME_H
-#define SCHEME_H
-
-#include <libguile.h>
-#include "calendar.h"
-#include "strbuf.h"
-
-SCM make_calendar(SCM path);
-
-SCM calendar_get_attr(SCM calendar, SCM id, SCM attr);
-
-SCM number_events(SCM calendar);
-
-void init_calendar ();
-
-SCM scm_from_strbuf(strbuf* s);
-SCM scm_from_llist(LLIST(strbuf)* lst);
-SCM scm_from_trie_node(TRIE_NODE(content_line)* node);
-SCM scm_from_trie(TRIE(content_line)* trie);
-SCM scm_from_vector(VECT(vcomponent)* vect);
-SCM calendar_size (SCM);
-SCM calendar_components (SCM);
-
-#endif /* SCHEME_H */
diff --git a/scheme.scm.c b/scheme.scm.c
deleted file mode 100644
index 7d96f2d6..00000000
--- a/scheme.scm.c
+++ /dev/null
@@ -1,141 +0,0 @@
-#include "scheme.h"
-
-#include "macro.h"
-#include "calendar.h"
-#include "strbuf.h"
-
-static SCM calendar_type;
-
-void init_calendar_type (void) {
-	SCM name = scm_from_utf8_symbol("calendar");
-	SCM slots = scm_list_1(scm_from_utf8_symbol("data"));
-
-	calendar_type = scm_make_foreign_object_type(name, slots, NULL);
-}
-
-SCM_DEFINE (make_calendar, "make-calendar", 1, 0, 0,
-		(SCM path),
-		"Loads a vdir iCalendar from the given path.")
-{
-	vcomponent* cal =
-		(vcomponent*) scm_gc_malloc (
-				sizeof(*cal), "calendar");
-	INIT(vcomponent, cal, "ROOT");
-
-	char* p = scm_to_utf8_stringn(path, NULL);
-	read_vcalendar(cal, p);
-	free(p);
-
-	return scm_make_foreign_object_1
-		(calendar_type, cal);
-
-}
-
-SCM scm_from_strbuf(strbuf* s) {
-	return scm_from_utf8_stringn (s->mem, s->len - 2);
-}
-
-SCM scm_from_llist(LLIST(strbuf)* lst) {
-
-	SCM llist = SCM_EOL;
-
-	for ( LINK(strbuf)* n = FIRST(lst);
-			n->after != NULL;
-			n = n->after) {
-		llist = scm_cons(scm_from_strbuf(n->value), llist);
-	}
-	return llist;
-}
-
-SCM_DEFINE (calendar_get_attr, "calendar-get-attr", 3, 0, 0,
-		(SCM calendar, SCM id, SCM attr),
-		"Retuns the given attribute from the vevent object at index in calendar.")
-{
-	scm_assert_foreign_object_type (calendar_type, calendar);
-	vcomponent* cal = scm_foreign_object_ref (calendar, 0);
-
-	vcomponent* v = cal->components.items[scm_to_int(id)];
-	char* key = scm_to_utf8_stringn(scm_string_upcase(attr), NULL);
-	content_line* c = get_property (v, key);
-	free(key);
-
-	if (c == NULL) return SCM_BOOL_F;
-
-	return scm_from_llist(&c->val);
-}
-
-SCM scm_from_trie_node(TRIE_NODE(content_line)* node) {
-
-	TRIE_NODE(content_line)* n = node->child;
-	SCM childs = SCM_EOL;
-	while (n != NULL) {
-		childs = scm_cons(scm_from_trie_node(n), childs);
-		n = n->next;
-	}
-	SCM lst;
-	if (node->value != NULL) {
-		lst = scm_cons(scm_from_char(node->c),
-				scm_from_llist(&node->value->val));
-	} else {
-		lst = scm_list_1(scm_from_char(node->c));
-	}
-	return scm_cons (lst, childs);
-}
-
-SCM scm_from_trie(TRIE(content_line)* trie) {
-	return scm_from_trie_node (trie->root);
-}
-
-SCM scm_from_vector(VECT(vcomponent)* vect) {
-	SCM l = SCM_EOL;
-	for (size_t i = 0; i < vect->length; i++) {
-		l = scm_cons(
-				scm_make_foreign_object_1 (calendar_type, GET(VECT(vcomponent))(vect, i)),
-				l);
-	}
-	return scm_reverse(l);
-}
-
-SCM_DEFINE (calendar_size, "calendar-size", 1, 0, 0,
-		(SCM calendar),
-		"Returns number of events in a vcalendar.")
-{
-	scm_assert_foreign_object_type (calendar_type, calendar);
-	vcomponent* cal = scm_foreign_object_ref (calendar, 0);
-	return scm_from_size_t (cal->components.length);
-}
-
-SCM_DEFINE (calendar_properties, "primitive-get-properties", 1, 0, 0,
-		(SCM calendar),
-		"Returns the TRIE from a calendar object")
-{
-	scm_assert_foreign_object_type (calendar_type, calendar);
-	vcomponent* cal = scm_foreign_object_ref (calendar, 0);
-	return scm_from_trie(&cal->clines);
-}
-
-SCM_DEFINE(calendar_components, "get-components", 1, 0, 0,
-		(SCM component),
-		"")
-{
-	scm_assert_foreign_object_type (calendar_type, component);
-	vcomponent* cal = scm_foreign_object_ref (component, 0);
-	return scm_from_vector(&cal->components);
-}
-
-SCM_DEFINE(component_type, "component-type", 1, 0, 0,
-		(SCM component),
-		"Returns type of vcomponent#")
-{
-	scm_assert_foreign_object_type (calendar_type, component);
-	vcomponent* comp = scm_foreign_object_ref (component, 0);
-	return scm_from_utf8_symbol(comp->type);
-}
-
-void init_calendar () {
-	init_calendar_type();
-
-#ifndef SCM_MAGIC_SNARFER
-#include "scheme.x"
-#endif
-}