From 7539f8c8804849294e100c5442e0397f4f4d2c40 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 1 Oct 2019 23:39:00 +0200 Subject: Disabled bunch of old stuff, new stuff kinda builds. --- src/guile_interface.scm.c | 261 ---------------------------------------------- 1 file changed, 261 deletions(-) delete mode 100644 src/guile_interface.scm.c (limited to 'src/guile_interface.scm.c') diff --git a/src/guile_interface.scm.c b/src/guile_interface.scm.c deleted file mode 100644 index 20c413df..00000000 --- a/src/guile_interface.scm.c +++ /dev/null @@ -1,261 +0,0 @@ -#include "guile_interface.h" - -#include "calendar.h" -#include "guile_type_helpers.h" - -static SCM vcomponent_type; -static SCM content_set_lists; - -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, "%vcomponent-make", 0, 1, 0, - (SCM path), - "Loads a vdir iCalendar from the given path.") -{ - vcomponent* cal = - (vcomponent*) scm_gc_malloc ( - sizeof(*cal), "vcomponent"); - - 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); -} - -/* - * 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); - - const char* key = scm_i_string_chars (attr); - content_line* c = get_attributes (cal, key); - - if (c == NULL) { - vcomponent_push_val(cal, key, ""); - c = get_attributes (cal, key); - c->cval->key.scm = SCM_BOOL_F; - } - - SCM ptr = scm_from_pointer(c, NULL); - SCM ret = scm_hashq_ref (content_set_lists, ptr, SCM_BOOL_F); - if (! scm_is_false (ret)) { - return ret; - } - - SCM val, proplist; - SCM attrroot = scm_list_1(SCM_BOOL_F); - SCM attrlist = attrroot; - LLIST(strbuf) *triekeys, *trievals; - - /* For every instance of a line */ - FOR (LLIST, content_set, v, c) { - val = scm_from_strbuf(&v->key); - - if (! scm_is_pair(val)) { - // TODO look into using a weak hash table instead - - // TODO why is it an error to unprotect the object here? - // scm_from_strbuf should already have protected it... - // scm_gc_unprotect_object(v->key.scm); - SCM htable = scm_make_hash_table (scm_from_ulong(32)); - val = scm_cons(val, htable); - v->key.scm = val; - scm_gc_protect_object(v->key.scm); - - triekeys = KEYS(TRIE(param_set))(&v->val); - /* For every property key bound to the current attribute */ - FOR (LLIST, strbuf, k, triekeys) { - proplist = SCM_EOL; - - trievals = GET(TRIE(param_set))(&v->val, k->mem); - /* For every value bound to the current property */ - FOR (LLIST, strbuf, s, trievals) { - proplist = scm_cons(scm_from_strbuf(s), proplist); - } - - scm_hashq_set_x(htable, scm_from_strbuf_symbol(k), - scm_reverse(proplist)); - } - } - - attrlist = scm_cons(val, attrlist); - } - - /* create circular list */ - scm_set_cdr_x (attrroot, attrlist); - - - scm_hashq_set_x (content_set_lists, ptr, attrlist); - - return attrlist; -} - -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(LLIST(vcomponent))(&c->components)); -} - -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); - - SCM llist = SCM_EOL; - FOR (LLIST, vcomponent, v, &cal->components) { - llist = scm_cons(scm_from_vcomponent(v), llist); - } - return llist; -} - -SCM_DEFINE(vcomponent_filter_children_x, "%vcomponent-filter-children!", - 2, 0, 0, - (SCM pred, SCM component), - "Remove all children from component who DOESN'T satisfy `pred`") -{ - scm_assert_foreign_object_type (vcomponent_type, component); - vcomponent* cal = scm_foreign_object_ref (component, 0); - - for (LINK(vcomponent)* l = FIRST(&cal->components); - l->after != NULL; - l = l->after) - { - if (scm_is_false(scm_call_1 (pred, scm_from_vcomponent(l->value)))) { - FFREE(vcomponent, l->value); - UNLINK(LINK(vcomponent))(l); - } - } - - return SCM_UNSPECIFIED; -} - -SCM_DEFINE(vcomponent_push_child_x, "%vcomponent-push-child!", 2, 0, 0, - (SCM component, SCM child), - "") -{ - scm_assert_foreign_object_type (vcomponent_type, component); - scm_assert_foreign_object_type (vcomponent_type, child); - vcomponent* comp = scm_foreign_object_ref (component, 0); - vcomponent* chil = scm_foreign_object_ref (child, 0); - - PUSH(vcomponent)(comp, chil); - - 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-get-type", 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); - - if (comp->scmtype == NULL) { - comp->scmtype = scm_from_utf8_symbol(comp->type); - } - - return comp->scmtype; -} - -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); - scm_gc_protect_object(v->scm); - } - return v->scm; -} - -SCM_DEFINE(vcomponent_attr_list, "%vcomponent-attribute-list", 1, 0, 0, - (SCM component), - "Returns list of all keys in component.") -{ - scm_assert_foreign_object_type (vcomponent_type, component); - vcomponent* comp = scm_foreign_object_ref (component, 0); - LLIST(strbuf)* keys = KEYS(TRIE(content_line))(&comp->clines); - - SCM llist = SCM_EOL; - FOR (LLIST, strbuf, s, keys) { - llist = scm_cons(scm_from_strbuf(s), llist); - } - - FFREE(LLIST(strbuf), keys); - - return llist; -} - -SCM_DEFINE(vcomponent_shallow_copy, "%vcomponent-shallow-copy", 1, 0, 0, - (SCM component), - "Creates a shallow copy of the given component.") -{ - scm_assert_foreign_object_type (vcomponent_type, component); - vcomponent* src = scm_foreign_object_ref (component, 0); - - vcomponent* dest = - (vcomponent*) scm_gc_malloc ( - sizeof(*dest), "vcomponent"); - INIT(vcomponent, dest, src->type, NULL); - vcomponent_copy (dest, src); - return scm_from_vcomponent (dest); -} - -void init_lib (void) { - init_vcomponent_type(); - content_set_lists = scm_make_weak_key_hash_table (scm_from_uint(0x100)); - -#ifndef SCM_MAGIC_SNARFER -#include "guile_interface.x" -#endif -} -- cgit v1.2.3