#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); } SCM_DEFINE_PUBLIC (scm_vcomponent_get_hash_table, "%vcomponent-get-hash-table", 1, 0, 0, (SCM comp), "") { scm_assert_foreign_object_type (vcomponent_type, comp); vcomponent* cal = scm_foreign_object_ref (comp, 0); return cal->clines; } /* * 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); return scm_hashq_ref (cal->clines, attr, SCM_BOOL_F); #if 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; #endif } 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)); return scm_length (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; return cal->components; } #if 0 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; } #endif 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; } vcomponent* scm_to_vcomponent (SCM s) { scm_assert_foreign_object_type (vcomponent_type, s); vcomponent* comp = scm_foreign_object_ref (s, 0); return comp; } #if 0 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; } #endif 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 }