From 7dd22dfad91491b21da600e47a495c047d61e834 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 18 Feb 2019 18:56:18 +0100 Subject: Start rework of guile interface. --- code.scm | 35 +++++++------ guile_interface.h | 15 ++++++ guile_interface.scm.c | 91 ++++++++++++++++++++++++++++++++ guile_type_helpers.c | 18 +++++++ guile_type_helpers.h | 13 +++++ scheme.h | 24 --------- scheme.scm.c | 141 -------------------------------------------------- 7 files changed, 155 insertions(+), 182 deletions(-) create mode 100644 guile_interface.h create mode 100644 guile_interface.scm.c create mode 100644 guile_type_helpers.c create mode 100644 guile_type_helpers.h delete mode 100644 scheme.h delete mode 100644 scheme.scm.c 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 + +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 + +#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 -#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 -} -- cgit v1.2.3