Add some more scheme bindings.

4 files changed, 147 insertions, 41 deletions

diff --git a/code.scm b/code.scm
index aef2772b..2c598c46 100755
--- a/code.scm
+++ b/code.scm
@@ -2,43 +2,36 @@
 -s
 !#
 
-(use-modules (ice-9 format))
+(add-to-load-path (dirname (current-filename)))
+(load "helpers.scm")
+
+(use-modules (ice-9 format)
+             (ice-9 pretty-print))
 
 (begin
   ;; Supurflous begin block here to make sourcing into geiser easier.
   (setenv "LD_LIBRARY_PATH" (getcwd))
   (load-extension "libguile-calendar" "init_calendar"))
 
-(define v (make-calendar (cadr (command-line))))
-
+(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))
+
+#;
 (do ((i 0 (1+ i)))
     ((>= i (calendar-size v)))
   (format #t "~3d | ~a~%"
           (1+ i) (car (calendar-get-attr v i "summary"))))
 
-
-;;; ----------------------------------------
-
-;; (use-modules (srfi srfi-19))
-
-#|
-- Z at end means that it's in UTC time.
-- No mark at end means that it's in "local time".
-- `TZID` can be given as an parameter, specifiying the timezone by name
-
-See p. 46-47 of the RFC
-|#
-
-;; (string->date (calendar-get-attr v 0 "dtstart")
-;;               "~Y~m~eT~k~M~S~z")
-;; => #<date nanosecond: 0 second: 0 minute: 15 hour: 12 day: 29 month: 1 year: 2019 zone-offset: 0>
-
-;; (string->date (calendar-get-attr v 0 "dtstart")
-;;               "~Y~m~eT~k~M~S")
-;; => #<date nanosecond: 0 second: 0 minute: 15 hour: 12 day: 29 month: 1 year: 2019 zone-offset: 3600>
-
-;; (string-take-right (calendar-get-attr v 0 "dtstart") 1) ; => "Z"
-
-;; (string->date "20180311T133700"
-;;               "~Y~m~eT~k~M~S") ; <-- Note missing ~z
-;; => #<date nanosecond: 0 second: 0 minute: 37 hour: 13 day: 11 month: 3 year: 2018 zone-offset: 3600>
diff --git a/helpers.scm b/helpers.scm
new file mode 100644
index 00000000..717a10d4
--- /dev/null
+++ b/helpers.scm
@@ -0,0 +1,43 @@
+(use-modules (srfi srfi-1)
+             (srfi srfi-8) ; receive
+             )
+
+(define (nlist? l)
+  "Returns #t if l is a pair that is not a list."
+  (and (pair? l)
+       (not (list? l))))
+
+(define (flatten tree)
+  "Flattens tree, should only return propper lists."
+  (cond ((null? tree) '())
+        ((list? tree)
+         (if (null? (cdr tree))
+             (flatten (car tree))
+             (let ((ret (cons (flatten (car tree))
+                              (flatten (cdr tree)))))
+               (if (nlist? ret)
+                   (list (car ret) (cdr ret))
+                   ret))))
+        (else tree)))
+
+
+(define (map-lists f lst)
+  "Map f over lst, if (car lst) is a list, pass the list to f. If (car list)
+isn't a list, pass the rest of lst to f."
+  (cond ((null? lst) '())
+        ((list? (car lst)) (cons (f (car lst))
+                                 (map-lists f (cdr lst))))
+        (else (f lst))))
+
+(define (beautify tree)
+  "Takes a prefix tree and turns some characters to strings."
+  (define (helper branch)
+    (receive (head tail)
+        (span char? branch)
+      (cons (list->string head)
+            (beautify tail))))
+  (if (or (null? tree)
+          (not (list? tree)))
+      tree
+      (cons (beautify (car tree))
+            (map-lists helper (cdr tree)))))
diff --git a/scheme.h b/scheme.h
index 9417896e..dff4b07f 100644
--- a/scheme.h
+++ b/scheme.h
@@ -2,6 +2,8 @@
 #define SCHEME_H
 
 #include <libguile.h>
+#include "calendar.h"
+#include "strbuf.h"
 
 SCM make_calendar(SCM path);
 
@@ -11,4 +13,12 @@ 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
index 2c06dd3d..d148a435 100644
--- a/scheme.scm.c
+++ b/scheme.scm.c
@@ -20,7 +20,7 @@ SCM_DEFINE (make_calendar, "make-calendar", 1, 0, 0,
 	vcomponent* cal =
 		(vcomponent*) scm_gc_malloc (
 				sizeof(*cal), "calendar");
-	INIT(vcomponent, cal);
+	INIT(vcomponent, cal, "ROOT");
 
 	char* p = scm_to_utf8_stringn(path, NULL);
 	read_vcalendar(cal, p);
@@ -31,8 +31,20 @@ SCM_DEFINE (make_calendar, "make-calendar", 1, 0, 0,
 
 }
 
-static SCM scm_from_strbuf(strbuf* s) {
-	return scm_from_utf8_stringn (s->mem, s->len - 1);
+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,
@@ -49,17 +61,39 @@ SCM_DEFINE (calendar_get_attr, "calendar-get-attr", 3, 0, 0,
 
 	if (c == NULL) return SCM_BOOL_F;
 
-	SCM llist = SCM_EOL;
+	return scm_from_llist(&c->vals);
+}
 
-	// TODO actuall iterators
-	// TODO this reverses the list
-	for ( LINK(strbuf)* n = FIRST(&c->vals);
-			n->after != NULL;
-			n = n->after) {
-		llist = scm_cons(scm_from_strbuf(n->value), llist);
+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->vals));
+	} else {
+		lst = scm_list_1(scm_from_char(node->c));
+	}
+	return scm_cons (lst, childs);
+}
 
-	return llist;
+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,
@@ -71,11 +105,37 @@ SCM_DEFINE (calendar_size, "calendar-size", 1, 0, 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
-
 }