From 7eba3f7dbcef5ecf05d6d05e1c2fbd323d7898df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sat, 9 Feb 2019 03:01:53 +0100 Subject: Add some more scheme bindings. --- code.scm | 51 ++++++++++++++++-------------------- helpers.scm | 43 +++++++++++++++++++++++++++++++ scheme.h | 10 ++++++++ scheme.scm.c | 84 +++++++++++++++++++++++++++++++++++++++++++++++++++--------- 4 files changed, 147 insertions(+), 41 deletions(-) create mode 100644 helpers.scm 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") -;; => # - -;; (string->date (calendar-get-attr v 0 "dtstart") -;; "~Y~m~eT~k~M~S") -;; => # - -;; (string-take-right (calendar-get-attr v 0 "dtstart") 1) ; => "Z" - -;; (string->date "20180311T133700" -;; "~Y~m~eT~k~M~S") ; <-- Note missing ~z -;; => # 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 +#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 - } -- cgit v1.2.3