diff options
43 files changed, 685 insertions, 2833 deletions
@@ -17,8 +17,6 @@ C_FILES = $(wildcard src/*.c) SCM_C_FILES = $(wildcard src/*.scm.c) X_FILES = $(SCM_C_FILES:.scm.c=.x) -.SECONDARY: $(X_FILES) - O_FILES = $(C_FILES:src/%.c=obj/%.o) SCM_FILES = $(shell find module/ -type f -name \*.scm) @@ -30,12 +28,11 @@ GUILE_C_FLAGS = -Lmodule \ -Wmacro-use-before-definition -Warity-mismatch \ -Wduplicate-case-datum -Wbad-case-datum +.SECONDARY: $(X_FILES) $(O_FILES) -all: $(SO_FILES) $(GO_FILES) + -# Old C main -parse: $(O_FILES) - $(CC) -o $@ $^ $(LDFLAGS) +all: $(SO_FILES) $(GO_FILES) src/%.x : src/%.scm.c guile-snarf -o $@ $< $(CFLAGS) @@ -52,28 +49,24 @@ lib/%.so: $(O_FILES) @mkdir -p lib $(CC) -shared -o $@ $^ $(LDFLAGS) -obj/%.scm.go: %.scm $(SO_FILES) +obj/module/vcomponent/primitive.scm.go: module/vcomponent/primitive.scm $(SO_FILES) @mkdir -p obj guild compile $(GUILE_C_FLAGS) -o $@ $< -.SECONDARY += %.dot -%.dot: testcal/%.ics parse - ./parse $< -g $@ - -%.pdf: %.dot - dot -Tpdf -o $@ $< +obj/%.scm.go: %.scm + @mkdir -p obj + guild compile $(GUILE_C_FLAGS) -o $@ $< html: $(GO_FILES) mkdir -p html ln -sf ../static html - module/main.scm html -f 2019-07-01 -t 2019-08-30 > html/index.html + module/main.scm html -f 2019-10-01 -t 2019-12-31 > html/index.html tags: $(C_FILES) $(H_FILES) ctags -R ./rfc-tags rfc5545.txt >> tags clean: - -rm parse -rm -r html -rm -r obj -rm -r lib @@ -0,0 +1,12 @@ +# -*- mode: sh -*- + +root=$(dirname $(realpath $BASH_SOURCE)) + +GUILE_LOAD_PATH="$root/module:$GUILE_LOAD_PATH" +#GUILE_LOAD_COMPILED_PATH="$root/obj/module:$GUILE_LOAD_COMPILED_PATH" +#LD_LIBRARY_PATH="$root/lib:$LD_LIBRARY_PATH" + +export GUILE_LOAD_PATH GUILE_LOAD_COMPILED_PATH LD_LIBRARY_PATH +#export GUILE_AUTO_COMPILE=0 + +# exec "$@" diff --git a/module/main.scm b/module/main.scm index 29c7317a..242883ea 100755 --- a/module/main.scm +++ b/module/main.scm @@ -1,14 +1,7 @@ #!/bin/bash # -*- mode: scheme -*- -root=$(dirname $(dirname $(realpath $0))) - -GUILE_LOAD_PATH="$root/module:$GUILE_LOAD_PATH" -GUILE_LOAD_COMPILED_PATH="$root/obj/module:$GUILE_LOAD_COMPILED_PATH" -LD_LIBRARY_PATH="$root/lib:$LD_LIBRARY_PATH" - -export GUILE_LOAD_PATH GUILE_LOAD_COMPILED_PATH LD_LIBRARY_PATH -export GUILE_AUTO_COMPILE=0 +. $(dirname $(dirname $(realpath $0)))/env exec guile -e main -s $0 "$@" !# @@ -29,6 +22,7 @@ exec guile -e main -s $0 "$@" (output text) (output import) (output info) + (output ical) (server) (ice-9 getopt-long) @@ -44,8 +38,12 @@ exec guile -e main -s $0 "$@" ;; ;; Given as a sepparate function from main to ease debugging. (define* (init proc #:key (calendar-files (calendar-files))) - (define calendars (map make-vcomponent calendar-files)) - (define events (concatenate (map (cut children <> 'VEVENT) calendars))) + (define calendars (map parse-calendar calendar-files)) + (define events (concatenate + ;; TODO does this drop events? + (map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o))) + (children cal))) + calendars))) (let* ((repeating regular (partition repeating? events))) @@ -96,6 +94,7 @@ exec guile -e main -s $0 "$@" ((term) terminal-main) ((import) import-main) ((info) info-main) + ((ical) ical-main) ((server) server-main)) c e ropt))) calendar-files: (or (and=> (option-ref opts 'file #f) diff --git a/module/output/html.scm b/module/output/html.scm index e03be8d4..adbea85e 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -221,6 +221,7 @@ ;; (display "<!doctype HTML>") (newline) + ((@ (sxml simple) sxml->xml) `(html (@ (lang sv)) (head diff --git a/module/output/ical.scm b/module/output/ical.scm new file mode 100644 index 00000000..5eff7915 --- /dev/null +++ b/module/output/ical.scm @@ -0,0 +1,82 @@ +(define-module (output ical) + :use-module (ice-9 getopt-long) + :use-module (ice-9 format) + :use-module (vcomponent) + :use-module (srfi srfi-19) + :use-module (srfi srfi-19 util) + :use-module (srfi srfi-41) + :use-module (srfi srfi-41 util) + ) + +(define opt-spec + '((from (value #t) (single-char #\f)) + (to (value #t) (single-char #\t)))) + +(define (value-format key value) + ;; TODO remove once key's are normalized to symbols. + (case (string->symbol key) + ((DTSTART DTEND) + (time->string value "~Y~m~dT~H~M~SZ")) + ((DURATION) + #; (time->string value "~H~M~S") + (let ((s (time-second value))) + (format #f "~a~a~a" + (floor/ s 3600) + (floor/ (modulo s 3600) 60) + (modulo s 60)) + )) + (else value))) + +(define (escape-chars str) + (with-output-to-string + (lambda () + (string-for-each (lambda (ch) + (case ch + ((#\, #\\) => (lambda (c) (display "\\") (display c))) + (else (display ch))) + ) str)))) + +(define (component->ical-string component) + (format #t "BEGIN:~a~%" (type component)) + (for-each (lambda (kv) + (let ((key (car kv)) + (vline (cdr kv))) + ;; key;p1=v;p3=10:value + (format #t "~a~:{;~a=~@{~a~^,~}~}:~a~%" + key (properties vline) + (escape-chars (value-format key (value vline))) + ))) + (attributes component)) + (for-each component->ical-string (children component)) + (format #t "END:~a~%" (type component)) + + ) + +(define (print-header) + (format #t +"BEGIN:VCALENDAR +PRODID:~a +VERSION:2.0 +CALSCALE:GREGORIAN +" +"Hugo" +)) + + +(define (print-footer) + (format #t "END:VCALENDAR~%")) + +(define-public (ical-main calendars events args) + (define opts (getopt-long args opt-spec)) + (define start (parse-freeform-date (option-ref opts 'from "2019-04-15"))) + (define end (parse-freeform-date (option-ref opts 'to "2019-05-10"))) + + (print-header) + + (stream-for-each + component->ical-string + (filter-sorted-stream (lambda (ev) ((in-date-range? start end) + (time-utc->date (attr ev 'DTSTART)))) + events)) + + (print-footer)) diff --git a/module/output/info.scm b/module/output/info.scm index 62600472..eba0979c 100644 --- a/module/output/info.scm +++ b/module/output/info.scm @@ -11,7 +11,9 @@ (format #t "~%Found ~a calendars, named:~%~{ - [~4@a] ~a~a\x1b[m~%~}~%" (length calendars) (concatenate - (zip (map (lambda (c) (length (children c 'VEVENT))) calendars) + (zip (map (lambda (c) (length (filter (lambda (e) (eq? 'VEVENT (type e))) + (children c)))) + calendars) (map (compose color-escape (extract 'COLOR)) calendars) (map (extract 'NAME) calendars))))) diff --git a/module/output/terminal.scm b/module/output/terminal.scm index 67548537..16ba31e9 100644 --- a/module/output/terminal.scm +++ b/module/output/terminal.scm @@ -62,11 +62,14 @@ (define-values (height width) (get-terminal-size)) + (define grouped-stream (group-stream event-stream)) + (while #t ;; TODO reusing the same grouping causes it to lose events. ;; I currently have no idea why, but it's BAD. - (let ((groups (get-groups-between (group-stream event-stream) + (let ((groups (get-groups-between grouped-stream (time-utc->date time) (time-utc->date time)))) + (format (current-error-port) "len(groups) = ~a~%" (stream-length groups)) (let ((events (if (stream-null? groups) '() (group->event-list (stream-car groups))))) @@ -135,7 +138,7 @@ (let ((ev ((@ (vcomponent primitive) %vcomponent-make) fname))) (serialize-vcomponent ev (current-error-port)) - (push-child! (parent (list-ref events cur-event)) ev) + (add-child! (parent (list-ref events cur-event)) ev) (format (current-error-port) "Children: ~a~%start: ~a~%" (children ev) (attr ev 'DTSTART)) (set! event-stream (stream-insert ev-time<? ev event-stream))))))) @@ -156,5 +159,6 @@ (let ((time (date->time-utc (drop-time (or (and=> (option-ref opts 'date #f) parse-freeform-date) (current-date)))))) + ;; (format (current-error-port) "len(events) = ~a~%" (stream-length events)) (with-vulgar (lambda () (main-loop time events)))))) diff --git a/module/server/macro.scm b/module/server/macro.scm index 71452d0f..123fc468 100644 --- a/module/server/macro.scm +++ b/module/server/macro.scm @@ -7,14 +7,6 @@ (use-modules* (web (response uri))) -(define (not-null? obj) - (if (null? obj) #f obj)) - -(define (match-count pattern str) - (fold-matches pattern str 0 - (lambda (_ count) - (1+ count)))) - (define-public (parse-endpoint-string str) @@ -53,6 +45,8 @@ (define-macro (make-routes . routes) `(lambda* (request body #:optional state) + ;; ALl these bindings generate compile time warnings since the expansion + ;; of the macro might not use them. This isn't really a problem. (let ((r:method (request-method request)) (r:uri (request-uri request)) (r:version (request-version request)) diff --git a/module/srfi/srfi-19/util.scm b/module/srfi/srfi-19/util.scm index 2e969f6e..4155b263 100644 --- a/module/srfi/srfi-19/util.scm +++ b/module/srfi/srfi-19/util.scm @@ -108,9 +108,9 @@ attribute set to 0. Can also be seen as \"Start of day\"" (define-public (day-stream start-day) (stream-iterate (lambda (d) - (mod! (day d) = (+ 1)) - (set! d (drop-time (normalize-date* d))) - d) + (drop-time + (normalize-date* + (set (date-day d) = (+ 1))))) (drop-time start-day))) (define-public (in-date-range? start-date end-date) diff --git a/module/srfi/srfi-41/util.scm b/module/srfi/srfi-41/util.scm index 050e1d2e..be363146 100644 --- a/module/srfi/srfi-41/util.scm +++ b/module/srfi/srfi-41/util.scm @@ -24,11 +24,19 @@ (define-public (stream-insert < item s) (interleave-streams < (list (stream item) s))) -(define-public (filter-sorted-stream proc stream) +;; Requires that stream is a total order in regards to what we filter +;; on. From there it knows that once it has found the first element +;; that satisfies our predicate all remaining elements satisfying pred +;; will be in direct succession. +(define-public (filter-sorted-stream pred stream) (stream-take-while - proc (stream-drop-while - (negate proc) stream))) + pred (stream-drop-while + (negate pred) stream))) + +;; Simmilar to the regular @code{filter-sorted-stream}, but once an +;; element satisfies @code{keep-remaning?} then the remaining tail +;; of the stream is all assumed to be good. (define-public (filter-sorted-stream* pred? keep-remaining? stream) (cond [(stream-null? stream) stream-null] [(keep-remaining? (stream-car stream)) stream] diff --git a/module/util.scm b/module/util.scm index 89f6dab6..707cba90 100644 --- a/module/util.scm +++ b/module/util.scm @@ -11,7 +11,7 @@ quote? re-export-modules use-modules* - -> set + -> set aif tree-map let-lazy) #:replace (let* set! define-syntax when unless if)) @@ -44,6 +44,13 @@ ((@ (guile) if) p t (begin f ...))])) +(define-syntax aif + (lambda (stx) + (syntax-case stx () + [(_ condition true-clause false-clause) + (with-syntax ((it (datum->syntax stx 'it))) + #'(let ((it condition)) + (if it true-clause false-clause)))]))) (define-public upstring->symbol (compose string->symbol string-upcase)) @@ -356,6 +363,9 @@ (-> (func obj) rest ...)])) +;; Non-destructive set, syntax extension from set-fields from (srfi +;; srfi-9 gnu). Also doubles as a non-destructive mod!, if the `=' +;; operator is used. (define-syntax set (syntax-rules (=) [(set (acc obj) value) diff --git a/module/util/strbuf.scm b/module/util/strbuf.scm new file mode 100644 index 00000000..2b574e82 --- /dev/null +++ b/module/util/strbuf.scm @@ -0,0 +1,52 @@ +;;; Description: +;; Alternative class to regular string, optimized for really fast appending, +;; Works on a byte level, and isn't really good for anything else. +;;; Code: + +(define-module (util strbuf) + :use-module (srfi srfi-9) + :use-module (rnrs bytevectors) + :use-module ((rnrs io ports) + :select (bytevector->string native-transcoder)) + :use-module ((ice-9 optargs) :select (define*-public)) + ) + +(define-record-type <strbuf> + (make-strbuf% len bytes) + strbuf? + (len get-length set-length!) + (bytes get-bytes set-bytes!)) + +(define-public (make-strbuf) + (make-strbuf% 0 (make-u8vector #x1000))) + +(define (strbuf-realloc! strbuf) + (let* ((len (u8vector-length (get-bytes strbuf))) + (nv (make-u8vector (ash len 1)))) + (bytevector-copy! (get-bytes strbuf) 0 + nv 0 len) + (set-bytes! strbuf nv))) + +;; TODO charset +(define*-public (strbuf->string strbuf #:optional + (transcoder (native-transcoder))) + (let ((bv (make-u8vector (get-length strbuf)))) + (bytevector-copy! (get-bytes strbuf) 0 + bv 0 + (get-length strbuf)) + (bytevector->string bv transcoder))) + +(define-public (strbuf-reset! strbuf) + (set-length! strbuf 0)) + +(define-public (strbuf-append! strbuf u8) + (catch 'out-of-range + (lambda () + (u8vector-set! (get-bytes strbuf) + (get-length strbuf) + u8)) + (lambda (err . args) + (strbuf-realloc! strbuf) + (strbuf-append! strbuf u8))) + (set-length! strbuf (1+ (get-length strbuf)))) + diff --git a/module/vcomponent.scm b/module/vcomponent.scm index cc79b646..871ac2e7 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -1,17 +1,17 @@ (define-module (vcomponent) - #:use-module ((vcomponent primitive) :select (%vcomponent-make)) #:use-module (vcomponent datetime) #:use-module (vcomponent recurrence) #:use-module (vcomponent timezone) #:use-module (vcomponent base) + #:use-module (vcomponent parse) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (srfi srfi-19 util) #:use-module (srfi srfi-19 setters) #:use-module (srfi srfi-26) #:use-module (util) - #:export (make-vcomponent) - #:re-export (repeating?)) + #:export (parse-calendar) + #:re-export (repeating? make-vcomponent)) ;; All VTIMEZONE's seem to be in "local" time in relation to ;; themselves. Therefore, a simple comparison should work, @@ -26,29 +26,29 @@ (define (parse-dates! cal) "Parse all start times into scheme date objects." - (for tz in (children cal 'VTIMEZONE) + (for tz in (filter (lambda (o) (eq? 'VTIMEZONE (type o))) (children cal)) (for-each (lambda (p) (mod! (attr p "DTSTART") string->time-utc)) (children tz)) ;; TZSET is the generated recurrence set of a timezone (set! (attr tz 'X-HNH-TZSET) - (make-tz-set tz) - #; - ((@ (srfi srfi-41) stream) - (list - (car (children tz)) - (cadr (children tz)))) - )) - - (for ev in (children cal 'VEVENT) + (make-tz-set tz))) + + (for ev in (filter (lambda (o) (eq? 'VEVENT (type o))) (children cal)) (define dptr (attr* ev 'DTSTART)) (define eptr (attr* ev 'DTEND)) - (define date (parse-datetime (value dptr))) + (define date (parse-datetime (value dptr))) (define end-date - (if (value eptr) - (parse-datetime (value eptr)) - (set (date-hour date) = (+ 1)))) + (cond ;; [(attr ev 'DURATION) => (lambda (d) (add-duration ...))] + [(not eptr) + (let ((d (set (date-hour date) = (+ 1)))) + (set! (attr ev 'DTEND) d + eptr (attr* ev 'DTEND)) + d)] + [(value eptr) => parse-datetime] + [else + (set (date-hour date) = (+ 1))])) (set! (value dptr) (date->time-utc date) (value eptr) (date->time-utc end-date)) @@ -63,78 +63,76 @@ (value eptr) (date->time-utc end-date))))) -;; (define-public value caar) -;; (define-public next cdr) -;; (define-public next! pop!) - - -;; (define-public (reset! attr-list) -;; (while (not (car attr-list)) -;; (next! attr-list)) -;; (next! attr-list)) - -;; value -;; (define-public v -;; (make-procedure-with-setter car set-car!)) - - - -(define* (make-vcomponent #:optional path) - (if (not path) - (%vcomponent-make) - (let* ((root (%vcomponent-make path)) - (component - (case (string->symbol (or (attr root "X-HNH-SOURCETYPE") "no-type")) - ;; == Single ICS file == - ;; Remove the abstract ROOT component, - ;; returning the wanted VCALENDAR component - ((file) - ;; TODO test this when an empty file is given. - (car (children root))) - - ;; == Assume vdir == - ;; Also removes the abstract ROOT component, but also - ;; merges all VCALENDAR's children into the a newly - ;; created VCALENDAR component, and return that component. - ;; - ;; TODO the other VCALENDAR components might not get thrown away, - ;; this since I protect them from the GC in the C code. - ((vdir) - (let ((accum (make-vcomponent)) - (ch (children root))) - (set! (type accum) "VCALENDAR") - - (unless (null? ch) - (for key in (attributes (car ch)) - (set! (attr accum key) (attr (car ch) key)))) - +(define* (parse-calendar path) + (let ((root (parse-cal-path path))) + (let* ((component + (case (string->symbol (or (attr root "X-HNH-SOURCETYPE") "no-type")) + ;; == Single ICS file == + ;; Remove the abstract ROOT component, + ;; returning the wanted VCALENDAR component + ((file) + ;; TODO test this when an empty file is given. + (car (children root))) + + ;; == Assume vdir == + ;; Also removes the abstract ROOT component, but also + ;; merges all VCALENDAR's children into the a newly + ;; created VCALENDAR component, and return that component. + ;; + ;; TODO the other VCALENDAR components might not get thrown away, + ;; this since I protect them from the GC in the C code. + ((vdir) + (let ((accum (make-vcomponent 'VCALENDAR)) + (ch (children root))) + + ;; Copy attributes from our parsed VCALENDAR + ;; to our newly created one. + (unless (null? ch) + (for key in (attributes (car ch)) + (set! (attr accum key) (attr (car ch) key)))) + + ;; Merge all children + (let ((tz '())) (for cal in ch (for component in (children cal) (case (type component) ((VTIMEZONE) + (set! tz (cons component tz)) + #; (unless (find (lambda (z) - (string=? (attr z "TZID") - (attr component "TZID"))) - (children accum 'VTIMEZONE)) - (push-child! accum component))) - (else (push-child! accum component))))) - ;; return - accum)) - - ((no-type) (throw 'no-type)) - - (else (throw 'something))))) - - (parse-dates! component) - - (unless (attr component "NAME") - (set! (attr component "NAME") - (or (attr component "X-WR-CALNAME") - (attr root "NAME")))) - - (unless (attr component "COLOR") - (set! (attr component "COLOR") - (attr root "COLOR"))) - - ;; return - component))) + (string=? (attr z "TZID") + (attr component "TZID"))) + (filter (lambda (o) (eq? 'VTIMEZONE (type o))) + (children accum))) + (add-child! accum component))) + ((VEVENT) + (add-child! accum component) + ) + (else => (lambda (type) + (format (current-error-port) + "Got unexpected component of type ~a~%" type)) + #; (add-child! accum component) + )))) + + (unless (null? tz) + (add-child! accum (car tz))) + ) + ;; return + accum)) + + ((no-type) (error 'no-type))))) + + (parse-dates! component) + + (unless (attr component "NAME") + (set! (attr component "NAME") + (or (attr component "X-WR-CALNAME") + (attr root "NAME") + "[NAMELESS]"))) + + (unless (attr component "COLOR") + (set! (attr component "COLOR") + (attr root "COLOR"))) + + ;; return + component))) diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm index fd8628f9..52bbe0c3 100644 --- a/module/vcomponent/base.scm +++ b/module/vcomponent/base.scm @@ -1,69 +1,123 @@ (define-module (vcomponent base) :use-module (util) :use-module (srfi srfi-1) + :use-module (srfi srfi-9) :use-module (srfi srfi-17) - :use-module (vcomponent primitive) - :use-module ((ice-9 optargs) :select (define*-public))) + :use-module (ice-9 hash-table) + :use-module ((ice-9 optargs) :select (define*-public)) + ) + + + +;; The <vline> type is a bit to many times refered to as a attr ptr. +(define-record-type <vline> + (make-vline% value parameters) + vline? + (value get-vline-value set-vline-value!) + (parameters get-vline-parameters)) + +(define*-public (make-vline value #:optional ht) + (make-vline% value (or ht (make-hash-table)))) + +(define-record-type <vcomponent> + (make-vcomponent% type children parent attributes) + vcomponent? + (type type) + (children children set-component-children!) + (parent get-component-parent set-component-parent!) + (attributes get-component-attributes)) +(export children type) + +;; TODO should this also update the parent +(define-public parent + (make-procedure-with-setter + get-component-parent set-component-parent!)) + +(define*-public (make-vcomponent #:optional (type 'VIRTUAL)) + (make-vcomponent% type '() #f (make-hash-table))) + +(define-public (add-child! parent child) + (set-component-children! parent (cons child (children parent))) + (set-component-parent! child parent)) -(define (get-attr component attr) - (%vcomponent-get-attribute - component - (as-string attr))) +(define* (get-attribute-value component key #:optional default) + (cond [(hashq-ref (get-component-attributes component) + key #f) + => get-vline-value] + [else default])) -(define (set-attr! component attr value) - (set! (car (get-attr component (as-string attr))) - value)) +(define (get-attribute component key) + (hashq-ref (get-component-attributes component) + key)) -(define-public value caar) +(define (set-attribute! component key value) + (let ((ht (get-component-attributes component))) + (cond [(hashq-ref ht key #f) + => (lambda (vline) (set-vline-value! vline value))] + [else (hashq-set! ht key (make-vline value))]))) -(define-public (values-left-count attr-list) - (length (take-while identity attr-list))) +(define-public (set-vline! component key vline) + (hashq-set! (get-component-attributes component) + key vline)) -(define-public (value-count attr-list) - (length (take-while identity (cdr (drop-while identity attr-list))))) + + +;; vline → value +(define-public value + (make-procedure-with-setter + get-vline-value set-vline-value!)) -(define-public attr* get-attr) +;; vcomponent x (or str symb) → vline +(define-public (attr* component attr) + (hashq-ref (get-component-attributes component) + (as-symb attr))) -(define (get-first c a) - (and=> (car (get-attr c a)) car)) +;; vcomponent x (or str symb) → value +(define (get-attr component key) + (get-attribute-value component (as-symb key) #f)) -(define (set-first! c a v) - (and=> (car (get-attr c a)) - (lambda (f) (set! (car f) v)))) +(define (set-attr! component key value) + (set-attribute! component (as-symb key) value)) (define-public attr (make-procedure-with-setter - get-first set-first!)) + get-attr + set-attr!)) (define-public prop (make-procedure-with-setter (lambda (attr-obj prop-key) - (hashq-ref (cdar attr-obj) prop-key)) + ;; TODO `list' is a hack since a bit to much code depends + ;; on prop always returning a list of values. + (and=> (hashq-ref (get-vline-parameters attr-obj) + (as-symb prop-key)) + list)) (lambda (attr-obj prop-key val) - (hashq-set! (cdar attr-obj) prop-key val)))) + (hashq-set! (get-vline-parameters attr-obj) + (as-symb prop-key) val)))) ;; Returns the properties of attribute as an assoc list. ;; @code{(map car <>)} leads to available properties. (define-public (properties attrptr) - (hash-map->list cons (cdar attrptr))) - -(define-public type (make-procedure-with-setter - %vcomponent-get-type - %vcomponent-set-type!)) -(define-public parent %vcomponent-parent) -(define-public push-child! %vcomponent-push-child!) -(define-public (attributes component) (map string->symbol (%vcomponent-attribute-list component))) - -(define*-public (children component #:optional only-type) - (let ((childs (%vcomponent-children component))) - (if only-type - (filter (lambda (e) (eq? only-type (type e))) childs) - childs))) - -(define-public copy-vcomponent %vcomponent-shallow-copy) - -(define-public filter-children! %vcomponent-filter-children!) + (hash-map->list cons (get-vline-parameters attrptr))) + +(define-public (attributes component) + (map car (hash-map->list cons (get-component-attributes component)))) + +(define (copy-vline vline) + (make-vline (get-vline-value vline) + ;; TODO deep-copy on properties? + (get-vline-parameters vline))) + +(define-public (copy-vcomponent component) + (make-vcomponent% (type component) + (children component) + (parent component) + ;; attributes + (alist->hashq-table + (hash-map->list (lambda (key value) (cons key (copy-vline value))) + (get-component-attributes component))))) (define-public (extract field) (lambda (e) (attr e field))) diff --git a/module/vcomponent/control.scm b/module/vcomponent/control.scm index 38199161..3bdecc5a 100644 --- a/module/vcomponent/control.scm +++ b/module/vcomponent/control.scm @@ -5,7 +5,7 @@ (eval-when (expand load) ; No idea why I must have load here. - (define href (make-procedure-with-setter hashq-ref hashq-set!)) + (define href (make-procedure-with-setter hash-ref hash-set!)) (define (set-temp-values! table component kvs) (for-each (lambda (kv) diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm index c5b6948e..46160a3a 100644 --- a/module/vcomponent/group.scm +++ b/module/vcomponent/group.scm @@ -5,8 +5,9 @@ #:use-module (srfi srfi-19 util) #:use-module (srfi srfi-41) #:use-module (srfi srfi-41 util) - #:export (group-stream)) + #:export (group-stream get-groups-between)) +;; TODO templetize this (define-stream (group-stream in-stream) (define (ein? day) (lambda (e) (event-contains? e (date->time-utc day)))) @@ -15,19 +16,26 @@ (if (stream-null? stream) stream-null (let* ((day (stream-car days)) - (tomorow (add-day (date->time-utc (drop-time day))))) + (tomorow (date->time-utc (stream-car (stream-cdr days))))) + (let ((head (stream-take-while (ein? day) stream)) (tail + ;; This is a filter, instead of a stream-span together with head, + ;; since events can span multiple days. + ;; This starts with taking everything which end after the beginning + ;; of tommorow, and finishes with the rest when it finds the first + ;; object which begins tomorow (after midnight, exclusize). (filter-sorted-stream* (lambda (e) (time<? tomorow (attr e 'DTEND))) (lambda (e) (time<=? tomorow (attr e 'DTSTART))) stream))) + (stream-cons (cons day head) (loop (stream-cdr days) tail))))))) -(define-public (get-groups-between groups start-date end-date) +(define (get-groups-between groups start-date end-date) (filter-sorted-stream ;; TODO in-date-range? drops the first date (compose (in-date-range? start-date end-date) diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm new file mode 100644 index 00000000..04a06d54 --- /dev/null +++ b/module/vcomponent/parse.scm @@ -0,0 +1,264 @@ +(define-module (vcomponent parse) + :use-module ((rnrs io ports) :select (get-u8)) + :use-module (rnrs bytevectors) + :use-module (srfi srfi-9) + :use-module ((ice-9 rdelim) :select (read-line)) + :use-module ((ice-9 textual-ports) :select (unget-char)) + :use-module ((ice-9 ftw) :select (scandir ftw)) + + :use-module (util) + :use-module (util strbuf) + :use-module (vcomponent base) + ) + + + + +(define-record-type <parse-ctx> + (make-parse-ctx% filename row col ctx line-key param-key param-table) + parse-ctx? + (filename get-filename) ; string + (row get-row set-row!) ; [0, ] + (col get-col set-col!) ; [1, ) + (ctx get-ctx set-ctx!) ; '(key value param-name param-value escape) + (line-key get-line-key set-line-key!) ; string + (param-key get-param-key set-param-key!) ; string + (param-table get-param-table set-param-table!) ; hash-map + ) + +(define (make-parse-ctx filename) + (make-parse-ctx% filename 1 0 'key + #f #f (make-hash-table))) + +(define (increment-column! ctx) + (set-col! ctx (1+ (get-col ctx)))) + +(define (increment-row! ctx) + (set-col! ctx 0) + (set-row! ctx (1+ (get-row ctx)))) + + + +(define (fold-proc ctx c) + ;; First extra character optionall read is to get the \n if our line + ;; ended with \r\n. Secound read is to get the first character of the + ;; next line. The initial \r which might recide in @var{c} is discarded. + (let ((pair (cons (if (char=? #\newline (integer->char c)) + c (get-u8 (current-input-port))) + (get-u8 (current-input-port))))) + (increment-row! ctx) + (cond [(not (char=? #\newline (integer->char (car pair)))) + (error "Expected newline after CR")] + + ;; The standard (3.4, l. 2675) says that each icalobject must + ;; end with CRLF. My files however does not. This means that + ;; an EOF can immideately follow a \n\r pair. But this case is the + ;; same as that we are at the end of line, so we spoof it and let + ;; the regular parser loop handle it. + [(eof-object? (cdr pair)) + 'end-of-line] + + ;; Following line begins with a whitespace character, + ;; meaning that we don't break the logical line here. + [(memv (integer->char (cdr pair)) '(#\space #\tab)) + (increment-column! ctx) ; since we just read the space + 'fold] + + [else + ;; TODO check if this failed, and signal a writeback error + (unget-char (current-input-port) + (integer->char (cdr pair))) + + 'end-of-line]))) + +(define (parse-calendar port) + (with-input-from-port port + (lambda () + (let ((component (make-vcomponent)) + (ctx (make-parse-ctx (port-filename port))) + (strbuf (make-strbuf))) + (with-throw-handler #t + (lambda () + (while #t + (let ((c (get-u8 (current-input-port)))) + (cond + + ;; End of file + [(eof-object? c) + ;; == NOTE == + ;; We never check the final line here. But since it + ;; ALWAYS should be "END:VCOMPONENT", and we do all + ;; the setup at creation this shouldn't be a problem. + (let ((component + (case (get-ctx ctx) + ;; Line ended before we came here, get the actual root + ;; component (instead of our virtual one: + [(key) (car (children component))] + ;; Line wasn't ended before we get here, so our current + ;; component is our "actual" root. + [(value) component] + [else + => (lambda (a) + (scm-error + 'wrong-type-arg "parse-break" + (string-append + "Bad context at end of file. " + "Expected `key' or `value', got ~a") + (list a) #f))]))) + ;; == NOTE == + ;; This sets to the VCALENDAR, which is correct, + ;; but the program later squashes together everything + ;; and drops this information. + (set! (attr component 'X-HNH-FILENAME) (get-filename ctx) + (parent component) #f) + (break component))] + + ;; End of line + [(memv (integer->char c) '(#\return #\newline)) + (case (fold-proc ctx c) + [(end-of-line) + (let ((str (strbuf->string strbuf))) + (cond [(eq? 'BEGIN (get-line-key ctx)) + (let ((child (make-vcomponent (string->symbol str)))) + (add-child! component child) + (set! component child))] + + [(eq? (get-line-key ctx) 'END) + (set! component (parent component))] + + [else + ;; TODO repeated keys + (set-vline! component (get-line-key ctx) + (make-vline str (get-param-table ctx))) + (set-param-table! ctx (make-hash-table))]) + + (strbuf-reset! strbuf) + (set-ctx! ctx 'key))] + [(fold) 'noop] ; Good case, here to catch errors in else + [else => (lambda (a) (error "Bad return from fold, unexpected" a))])] + + ;; Escaped characters + [(char=? #\\ (integer->char c)) + (case (integer->char (get-u8 (current-input-port))) + ;; Escape character '\' and escaped token sepparated by a newline + ;; (since the standard for some reason allows that (!!!)) + ;; We are at least guaranteed that it's a folded line, so just + ;; unfold it and continue trying to find a token to escape. + [(#\return #\newline) + => (lambda (c) + (case (fold-proc ctx (char->integer c)) + [(end-of-line) + (throw 'escape-error "ESC before not folded line")] + [(fold) + (increment-column! ctx) + (strbuf-append! strbuf (get-u8 (current-input-port)))]))] + + [(#\n #\N) (strbuf-append! strbuf (char->integer #\newline))] + [(#\; #\, #\\) => (lambda (c) (strbuf-append! strbuf (char->integer c)))] + [else => (lambda (c) (throw 'escape-error "Non-escapable character" c))]) + (increment-column! ctx)] + + ;; Delimiter between param key and param value + [(and (eq? (get-ctx ctx) 'param-name) + (char=? #\= (integer->char c))) + (set-param-key! ctx (string->symbol (strbuf->string strbuf))) + (strbuf-reset! strbuf) + (set-ctx! ctx 'param-value)] + + ;; Delimiter between parameters (;), or between + ;; "something" and attribute value (:) + [(and (memv (integer->char c) '(#\: #\;)) + (memv (get-ctx ctx) '(param-value key))) + (case (get-ctx ctx) + [(param-value) + (hashq-set! (get-param-table ctx) + (get-param-key ctx) + (strbuf->string strbuf)) + (strbuf-reset! strbuf)] + [(key) + (set-line-key! ctx (string->symbol (strbuf->string strbuf))) + (strbuf-reset! strbuf)]) + + (set-ctx! ctx (case (integer->char c) + [(#\:) 'value] + [(#\;) 'param-name]))] + + ;; Regular character + [else + (strbuf-append! strbuf c) + (increment-column! ctx)])))) + + (lambda _ + (format (current-error-port) + "== PARSE ERROR == +filename = ~a +row ~a column ~a ctx = ~a +~a ; ~a = ... : ...~%~%" + (get-filename ctx) + (get-row ctx) (get-col ctx) (get-ctx ctx) + (get-line-key ctx) (get-param-key ctx)))))))) + + + +(define-public (read-vcalendar path) + (define st (stat path)) + (case (stat:type st) + [(regular) (let ((comp (call-with-input-file path parse-calendar))) + (set! (attr comp 'X-HNH-SOURCETYPE) "file") + (list comp))] + [(directory) + + (let ((/ (lambda args (string-join args file-name-separator-string 'infix)))) + (let ((color + (catch 'system-error + (lambda () (call-with-input-file (/ path "color") read-line)) + (const "#FFFFFF"))) + (name + (catch 'system-error + (lambda () (call-with-input-file (/ path "displayname") read-line)) + (const (basename path))))) + + (map (lambda (fname) + (let ((fullname (/ path fname))) + (let ((cal (call-with-input-file fullname + parse-calendar))) + (set! (attr cal 'COLOR) color + (attr cal 'NAME) name) + cal))) + (scandir path (lambda (s) (and (not (string= "." (string-take s 1))) + (string= "ics" (string-take-right s 3))))))))] + [(block-special char-special fifo socket unknown symlink) + => (lambda (t) (error "Can't parse file of type " t))])) + + +(define-public (parse-cal-path path) + (let ((parent (make-vcomponent))) + (for-each (lambda (child) (add-child! parent child)) + (read-vcalendar path)) + (set! (attr parent 'X-HNH-SOURCETYPE) + (if (null? (children parent)) + "vdir" + (or (attr (car (children parent)) + 'X-HNH-SOURCETYPE) + "vdir"))) + parent)) + + +(define-public (read-tree path) + (define list '()) + (ftw path + (lambda (filename statinfo flag) + (case flag + [(regular) + (case (stat:type statinfo) + [(regular) + (when (and (not (string= "." (string-take filename 1))) + (string= "ics" (string-take-right filename 3))) + (set! list (cons filename list))) + #t] + [else #t])] + [(directory) #t] + [else #f]))) + ((@ (ice-9 threads) n-par-map) 12 + (lambda (fname) (call-with-input-file fname parse-calendar)) + list)) diff --git a/module/vcomponent/primitive.scm b/module/vcomponent/primitive.scm deleted file mode 100644 index ad33a3be..00000000 --- a/module/vcomponent/primitive.scm +++ /dev/null @@ -1,19 +0,0 @@ -;;; Primitive export of symbols linked from C binary. - -(define-module (vcomponent primitive) - #:export (%vcomponent-children - %vcomponent-push-child! - %vcomponent-filter-children! - - %vcomponent-parent - - %vcomponent-make - %vcomponent-get-type - %vcomponent-set-type! - - %vcomponent-get-attribute - %vcomponent-attribute-list - - %vcomponent-shallow-copy)) - -(load-extension "libguile-calendar" "init_lib") diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm index 435d3009..3f4cb869 100644 --- a/module/vcomponent/recurrence/generate.scm +++ b/module/vcomponent/recurrence/generate.scm @@ -51,6 +51,9 @@ (get-tz-offset e) 0)))) + (set! (attr ev 'DTSTART) + (copy-time (attr ev 'DTSTART))) + (let ((i (interval r))) (case (freq r) ((SECONDLY) (mod! (second d) = (+ i))) @@ -73,8 +76,8 @@ (date->time-utc d)) (when (attr e 'DTEND) - (set! (attr e 'DTEND) - (add-duration (attr e 'DTSTART) (attr e 'DURATION)))) + (set! (attr e 'DTEND) + (add-duration (attr e 'DTSTART) (attr e 'DURATION)))) ;; Return e)) @@ -127,9 +130,9 @@ (when (and (attr event 'DTEND) (not (attr event 'DURATION))) (set! (attr event "DURATION") - (time-difference - (attr event "DTEND") - (attr event "DTSTART")))) + (time-difference + (attr event "DTEND") + (attr event "DTSTART")))) (if (attr event "RRULE") (recur-event-stream event (parse-recurrence-rule (attr event "RRULE"))) ;; TODO some events STANDARD and DAYLIGT doesn't have RRULE's, but rather diff --git a/module/vcomponent/timezone.scm b/module/vcomponent/timezone.scm index 4a312288..ed3bef6b 100644 --- a/module/vcomponent/timezone.scm +++ b/module/vcomponent/timezone.scm @@ -28,15 +28,20 @@ ;; : TZOFFSETFROM: +0200 ;; @end example -;; Given a tz stream of length 2, takes the time difference between the DTSTART -;; of those two. And creates a new VTIMEZONE with that end time. -;; TODO set remaining properties, and type of the newly created component. +;; Given a tz stream of length 2, extrapolates when the next timezone +;; change aught to be. +;; Currently it does so by taking the first time zone, and adding one +;; year. This kind of works. +;; Previously it took the difference between element 2 and 1, and added +;; that to the start of the secound time zone. This was even more wrong. +;; TODO? set remaining properties, and type of the newly created component. (define (extrapolate-tz-stream strm) - (let ((nevent (copy-vcomponent (stream-ref strm 1)))) - (mod! (attr nevent 'DTSTART) - = (add-duration (time-difference - (attr (stream-ref strm 1) 'DTSTART) - (attr (stream-ref strm 0) 'DTSTART)))) + (let ((nevent (copy-vcomponent (stream-car strm)))) + (set! (attr nevent 'DTSTART) + (date->time-utc + (set (date-year + (time-utc->date (attr nevent 'DTSTART))) + = (+ 1)))) (stream-append strm (stream nevent)))) ;; The RFC requires that at least one DAYLIGHT or STANDARD component is present. @@ -58,17 +63,20 @@ [else (stream-zip strm (stream-cdr strm))]))) +;; str ::= ±[0-9]{4} +;; str → int seconds (define (parse-offset str) - (let* (((pm h1 h0 m1 m0) (string->list str))) - ((primitive-eval (symbol pm)) - (+ (* 60 (string->number (list->string (list m1 m0)))) - (* 60 60 (string->number (list->string (list h1 h0)))))))) + (let* (((± h1 h0 m1 m0) (string->list str))) + ((primitive-eval (symbol ±)) + (+ (* 60 (string->number (string m1 m0))) + (* 60 60 (string->number (string h1 h0))))))) ;; Finds the VTIMEZONE with id @var{tzid} in calendar. ;; Crashes on error. (define (find-tz cal tzid) (let ((ret (find (lambda (tz) (string=? tzid (attr tz 'TZID))) - (children cal 'VTIMEZONE)))) + (filter (lambda (o) (eq? 'VTIMEZONE (type o))) + (children cal))))) ret)) ;; Takes a VEVENT. diff --git a/src/calendar.c b/src/calendar.c deleted file mode 100644 index e634b166..00000000 --- a/src/calendar.c +++ /dev/null @@ -1,163 +0,0 @@ -#include "calendar.h" - -#include <sys/stat.h> -#include <dirent.h> -#include <string.h> -#include <stdio.h> -#include <errno.h> - -/* basename */ -#include <libgen.h> - -#include "parse.h" -#include "err.h" - -int read_vcalendar(vcomponent* cal, char* path) { - - struct stat statbuf; - if (stat (path, &statbuf) != 0) { - fprintf(stderr, - "Error stating file or directory, errno = %i\npath = [%s]\n", - errno, path); - } - - int type = statbuf.st_mode & 0777000; - int chmod = statbuf.st_mode & 0777; - INFO_F("file has mode 0%o, with chmod = 0%o", type, chmod); - - switch (type) { - case S_IFREG: handle_file(cal, path); break; - case S_IFDIR: handle_dir (cal, path); break; - case S_IFLNK: - ERR("Found symlink, can't be bothered to check it further."); - break; - - default: ; - } - - return 0; -} - -int handle_file(vcomponent* cal, char* path) { - INFO("Parsing a single file"); - - /* NAME is the `fancy' name of the calendar. */ - vcomponent_push_val(cal, "NAME", basename(path)); - vcomponent_push_val(cal, "X-HNH-SOURCETYPE", "file"); - char* resolved_path = realpath(path, NULL); - open_ics (resolved_path, cal); - free (resolved_path); - - return 0; -} - - -int handle_dir(vcomponent* cal, char* path) { - INFO("Parsing a directory"); - DIR* dir = opendir(path); - - /* Buffer for holding search path and filename */ - char buf[PATH_MAX] = { [0 ... PATH_MAX - 1] = '\0' }; - strcpy(buf, path); - int path_len = strlen(path) + 1; - - /* Slash to guarantee we have at least one */ - buf[path_len - 1] = '/'; - - - /* NAME is the `fancy' name of the calendar. */ - vcomponent_push_val(cal, "NAME", basename(path)); - vcomponent_push_val(cal, "X-HNH-SOURCETYPE", "vdir"); - - struct dirent* d; - while ((d = readdir(dir)) != NULL) { - /* Check that it's a regular file */ - if (d->d_type != DT_REG) continue; - - /* Append filename with currentt searchpath */ - strcat(buf, d->d_name); - char* resolved_path = realpath(buf, NULL); - /* Remove file part from combined path */ - buf[path_len] = '\0'; - - FILE* f; - size_t read, size = 0x100; - char* info_buf = malloc(size); - if (strcmp (d->d_name, "color") == 0) { - f = fopen(resolved_path, "r"); - read = getline(&info_buf, &size, f); - if (info_buf[read - 1] == '\n') - info_buf[read - 1] = '\0'; - - fclose(f); - vcomponent_push_val(cal, "COLOR", info_buf); - } else if (strcmp (d->d_name, "displayname") == 0) { - f = fopen(resolved_path, "r"); - read = getline(&info_buf, &size, f); - if (info_buf[read - 1] == '\n') - info_buf[read - 1] = '\0'; - - fclose(f); - - /* This adds the new list to the set of names, keeping the - * filename name. - * This works since *currently* values are returned in - * reverse order - */ - vcomponent_push_val(cal, "NAME", info_buf); - } else { - open_ics (resolved_path, cal); - } - - free (resolved_path); - } - - closedir(dir); - return 0; -} - -int get_extension(const char* filename, char* ext, ssize_t max_len) { - - if (filename == NULL) { - ext[0] = '\0'; - return 0; - } - - int ext_idx = -1; - ext[0] = '\0'; - for (int i = 0; filename[i] != '\0'; i++) { - if (filename[i] == '.') ext_idx = i + 1; - if (filename[i] == '/') ext_idx = -1; - } - - if (ext_idx == -1) return 0; - - int ext_len = 0; - for (int i = 0; i < max_len; i++, ext_len++) { - char c = filename[i + ext_idx]; - if (c == '\0') break; - ext[i] = c; - } - ext[ext_len] = '\0'; - return ext_len; -} - -int check_ext (const char* path, const char* ext) { - char buf[10]; - int has_ext = get_extension(path, buf, 9); - - return has_ext && strcmp(buf, ext) == 0; -} - -int open_ics (char* resolved_path, vcomponent* cal) { - if (! check_ext(resolved_path, "ics") ) return 2; - - FILE* f = fopen(resolved_path, "r"); - - if (f == NULL) return 1; - - parse_file(resolved_path, f, cal); - fclose(f); - - return 0; -} diff --git a/src/calendar.h b/src/calendar.h deleted file mode 100644 index 20b78a9f..00000000 --- a/src/calendar.h +++ /dev/null @@ -1,41 +0,0 @@ -#ifndef CALENDAR_H -#define CALENDAR_H - -#include "vcal.h" - -/* - * Reads all ics flies in path into the given vcomponent. The - * component is assumed to be a abstract ROOT element, whose first - * component will most likely become a VCALENDAR. - * - * path should either be a single .ics file (vcalendar), or a - * directory directly containing .ics files (vdir). - */ -int read_vcalendar(vcomponent* cal, char* path); - -/* - * Gets extension from filename. Writes output to ext. - * Assumes that the extension is the text between the last dot and - * the end of the string, and that no slashes can occur between the - * dot and the end. - * - * Returns the length of the extension, 0 if no extension. - */ -int get_extension(const char* filename, char* ext, ssize_t max_len); - -/* Returns 1 if path has extension ext, 0 otherwise */ -int check_ext (const char* path, const char* ext); - -/* Handle a lone ics file */ -int handle_file(vcomponent* cal, char* path); - -/* Handle a directory of ics files */ -int handle_dir(vcomponent* cal, char* path); - -/* - * Helper for opening a single ICS file. Handles file internally, and - * writes output to cal. - */ -int open_ics (char* resolved_path, vcomponent* cal); - -#endif /* CALENDAR_H */ diff --git a/src/err.h b/src/err.h deleted file mode 100644 index d9d19ec7..00000000 --- a/src/err.h +++ /dev/null @@ -1,42 +0,0 @@ -#ifndef ERR_H -#define ERR_H - -#include <stdio.h> - -#include "macro.h" - -#define _RESET "\x1b[m" -#define _BLACK "\x1B[0;30m" -#define _RED "\x1B[0;31m" -#define _GREEN "\x1B[0;32m" -#define _YELLOW "\x1B[0;33m" -#define _BLUE "\x1B[0;34m" -#define _PURPLE "\x1B[0;35m" -#define _CYAN "\x1B[0;36m" -#define _WHITE "\x1B[0;37m" - -#define ERR(msg) fprintf(stderr, _RED "ERR" _RESET " (%s:%i) %s\n", __FILE__, __LINE__, #msg) -#define ERR_F(fmt, ...) fprintf(stderr, _RED "ERR" _RESET " (%s:%i) " fmt "\n", \ - __FILE__, __LINE__, ##__VA_ARGS__) - -/* Parse error */ -#define ERR_P(ctx, fmt, ...) fprintf(stderr, _RED "PARSE" _RESET " (%s:%i) %i:%i " fmt "\n", \ - __FILE__, __LINE__, (ctx)->pline, (ctx)->pcolumn, ##__VA_ARGS__) - -#define INFO(msg) fprintf(stderr, _BLUE "INFO" _RESET " (%s:%i) %s\n", __FILE__, __LINE__, #msg) -#define INFO_F(fmt, ...) fprintf(stderr, _BLUE "INFO" _RESET " (%s:%i) " fmt "\n", \ - __FILE__, __LINE__, ##__VA_ARGS__) - -#define LINE(len) do { \ - printf(_GREEN); \ - FOR(int, i, len) printf("_"); \ - printf("\n"); \ -} while (0) - -#define PRINT(T, v) do { \ - char buf[0x1000]; \ - FMT(T)(v, buf); \ - INFO_F("%s", buf); \ -} while (0) - -#endif /* ERR_H */ diff --git a/src/graphs.c b/src/graphs.c deleted file mode 100644 index 51a26117..00000000 --- a/src/graphs.c +++ /dev/null @@ -1,144 +0,0 @@ -#include "graphs.h" - -#include <stdio.h> -#include <errno.h> -#include <string.h> -#include "err.h" - -// #define TYPE strbuf -// #include "linked_list.h" -// #include "linked_list.inc.h" -// #undef TYPE - -int create_graph_trie (vcomponent* ev, char* filename) { - FILE* f = fopen(filename, "w"); - - fputs("digraph {\n rankdir=LR;", f); - trie_to_dot(&ev->clines, f); - fputs("}", f); - - fclose(f); - - INFO_F("Wrote '%s' to '%s'", vcomponent_get_val(ev, "X-HNH-FILENAME"), filename); - - return 0; -} - -int helper_vcomponent (vcomponent* root, FILE* f) { - fprintf(f, "subgraph \"cluster_root\" { label=File; \"%p\" [label=%s] }\n", root, root->type); - - TRIE(content_line)* trie = &root->clines; - TRIE_NODE(content_line)* n = trie->root->child; - - if (! EMPTY(TRIE(content_line))(trie)) { - fprintf(f, "subgraph \"cluster_%p\" {\n", root); - fprintf(f, "\"%p\" [label=trie fontcolor=gray, color=gray];", trie); - fprintf(f, "\"%p\" -> \"%p\" [color=red]\n", root, trie); - while (n != NULL) { - fprintf(f, "\"%p\" -> \"%p\" [color=gray]\n", - (void*) trie, - (void*) n); - fprintf(f, "subgraph \"cluster_%c_%p\" {\ncolor=red; \n", - n->c, root); - trie_to_dot_helper( n, f ); - - - fputs("}", f); - n = n->next; - } - fputs("}", f); - } - - FOR(LLIST, vcomponent, child, &root->components) { - fprintf(f, "\"%p\" -> \"%p\"\n", root, child); - helper_vcomponent(child, f); - } - return 0; -} - -int create_graph_vcomponent (vcomponent* root, char* outfile) { - FILE* f = fopen(outfile, "w"); - if (f == NULL) { - ERR_F("Error opening file %s, errno = %i", outfile, errno); - return 1; - } - vcomponent* c = root; - fputs("digraph {", f); - helper_vcomponent(c, f); - fputs("}", f); - fclose(f); - return 0; -} - -#define T content_line - -int trie_to_dot ( TRIE(T)* trie, FILE* f ) { - TRIE_NODE(T)* n = trie->root->child; - fprintf(f, "\"%p\" [label=root fontcolor=gray, color=gray];", trie); - while (n != NULL) { - fprintf(f, "\"%p\" -> \"%p\" [color=gray]\n", - (void*) trie, - (void*) n); - fprintf(f, "subgraph \"cluster_%c\" {\n", - n->c); - trie_to_dot_helper( n, f ); - fputs("}", f); - n = n->next; - } - return 0; -} - -int trie_to_dot_helper ( TRIE_NODE(T)* root, FILE* f ) { - if (L(root) == NULL) { - fprintf(f, "\"%p\"[label = \"%c\" style=filled fillcolor=white];\n", - (void*) root, root->c); - } else { - fprintf(f, "\"%p\"[label = \"%c [%i]\" style=filled fillcolor=green];\n", - (void*) root, root->c, - SIZE(LLIST(content_set))(L(root)) - ); - } - TRIE_NODE(T)* child = root->child; - - // ---------------------------------------- -#if 1 /* Toggle values */ - if (L(root) != NULL) { - - FOR(LLIST, content_set, v, L(root)) { - char buf[0x100]; - FMT(strbuf)(&v->key, buf); - fprintf(f, "\"%p\" [label=\"%s\" shape=rectangle color=darkgreen];\n", - v, buf); - /* Edge between TRIE char node and data node */ - fprintf(f, "\"%p\" -> \"%p\";\n", root, v); - - /* Parameters */ - LLIST(strbuf)* keys = KEYS(TRIE(param_set))(&v->val); - FOR(LLIST, strbuf, key, keys) { - param_set* p = GET(TRIE(param_set))(&v->val, key->mem); - - fprintf(f, "\"%p\" [label=\"%s\" color=blue];\n", - key, key->mem); - /* Edge between data node and param key node */ - fprintf(f, "\"%p\" -> \"%p\";", v, key); - - FOR(LLIST, strbuf, str, p) { - fprintf(f, "\"%p\" [label=\"%s\" color=orange];", - str, str->mem); - /* Edge between param key node and param value node */ - fprintf(f, "\"%p\" -> \"%p\";", key, str); - } - } - } - } -#endif - // ---------------------------------------- - - while (child != NULL) { - fprintf(f, "\"%p\" -> \"%p\";\n", - (void*) root, (void*) child); - trie_to_dot_helper(child, f); - child = child->next; - } - return 0; -} diff --git a/src/graphs.h b/src/graphs.h deleted file mode 100644 index fe521003..00000000 --- a/src/graphs.h +++ /dev/null @@ -1,15 +0,0 @@ -#ifndef GRAPHS_H -#define GRAPHS_H - -#include "vcal.h" - -int create_graph_trie (vcomponent* ev, char* filename); - -int create_graph_vcomponent (vcomponent* root, char* outfile); - -int helper_vcomponent (vcomponent* root, FILE* f); - -int trie_to_dot ( TRIE(content_line)*, FILE* ); -int trie_to_dot_helper ( TRIE_NODE(content_line)*, FILE* ); - -#endif /* GRAPHS_H */ diff --git a/src/guile_interface.h b/src/guile_interface.h deleted file mode 100644 index 76ec24d3..00000000 --- a/src/guile_interface.h +++ /dev/null @@ -1,28 +0,0 @@ -#ifndef GUILE_INTERFACE_H -#define GUILE_INTERFACE_H - -#include <libguile.h> -#include "vcal.h" - -/* - * At a number of places scm_gc_{un,}protect_object is called. - * This is needed since most of my structures are allocated with the - * regular malloc, instead of the scm_gc_malloc variants. - * This leads to the garbage collector not realizing that I still have - * the components, and deletes them. - * - * The protection markers stop the GC from doing its thing. - */ - -void init_lib (void); -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); - -SCM scm_from_vcomponent (vcomponent*); - -#endif /* GUILE_INTERFACE_H */ 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 -} diff --git a/src/guile_type_helpers.c b/src/guile_type_helpers.c deleted file mode 100644 index 0353a88a..00000000 --- a/src/guile_type_helpers.c +++ /dev/null @@ -1,17 +0,0 @@ -#include "guile_type_helpers.h" -#include "guile_interface.h" - -#include "macro.h" - -SCM scm_from_strbuf(strbuf* s) { - if (s->scm == NULL) { - s->scm = scm_from_utf8_stringn (s->mem, s->len); - scm_gc_protect_object(s->scm); - } - - return s->scm; -} - -SCM scm_from_strbuf_symbol(strbuf* s) { - return scm_string_to_symbol(scm_from_strbuf(s)); -} diff --git a/src/guile_type_helpers.h b/src/guile_type_helpers.h deleted file mode 100644 index c936f45d..00000000 --- a/src/guile_type_helpers.h +++ /dev/null @@ -1,14 +0,0 @@ -#ifndef GUILE_TYPE_HELPERS_H -#define GUILE_TYPE_HELPERS_H - -#include <libguile.h> - -#include "calendar.h" -#include "strbuf.h" - -#define SCM_IS_LIST(x) scm_is_true(scm_list_p(x)) - -SCM scm_from_strbuf(strbuf* s); -SCM scm_from_strbuf_symbol(strbuf* s); - -#endif /* GUILE_TYPE_HELPERS_H */ diff --git a/src/linked_list.h b/src/linked_list.h deleted file mode 100644 index 0d32b988..00000000 --- a/src/linked_list.h +++ /dev/null @@ -1,93 +0,0 @@ -#ifndef LINKED_LIST_H -#define LINKED_LIST_H - -#include "macro.h" - -#define LLIST(T) TEMPL(llist, T) -#define LINK(T) TEMPL(llist_link, T) - -#define UNLINK(T) TEMPL(unlink, T) - -#endif /* LINKED_LIST_H */ -#ifdef TYPE - -typedef struct LINK(TYPE) { - struct LINK(TYPE)* before; - struct LINK(TYPE)* after; - TYPE* value; -} LINK(TYPE); - -#define L(link) (link)->value - -typedef struct { - LINK(TYPE)* head; - LINK(TYPE)* tail; - LINK(TYPE)* cur; - TYPE* cval; - int length; -} LLIST(TYPE); - -#define FIRST(lst) (lst)->head->after -#define FIRST_V(lst) (lst)->head->after->value -#define LAST(lst) (lst)->tail->before -#define LAST_V(lst) (lst)->tail->before->value - -INIT_F ( LLIST(TYPE) ); - -/* - * NOTE freeing a linked list alsa FFREE's all its contents. - * TODO some form of shared pointer to ensure nothing is free'd twice - * would be a good idea. - */ -FREE_F ( LLIST(TYPE) ); - -INIT_F ( LINK(TYPE) ); -INIT_F ( LINK(TYPE), TYPE* val ); -FREE_F ( LINK(TYPE) ); - -int UNLINK(LINK(TYPE)) ( LINK(TYPE)* ); - -int PUSH(LLIST(TYPE)) ( LLIST(TYPE)*, TYPE* ); -TYPE* PEEK(LLIST(TYPE)) ( LLIST(TYPE)* ); -TYPE* POP(LLIST(TYPE)) ( LLIST(TYPE)* ); - -int DEEP_COPY(LLIST(TYPE)) ( LLIST(TYPE)* dest, LLIST(TYPE)* src ); - -int APPEND(LLIST(TYPE)) ( LLIST(TYPE)* dest, LLIST(TYPE)* new_ ); - -int SIZE(LLIST(TYPE)) ( LLIST(TYPE)* llist ); -int EMPTY(LLIST(TYPE)) ( LLIST(TYPE)* llist ); - -/* - * Resets a linked list by removing all it's objects. - * FREE's all elements stored in the list. - */ -int RESET(LLIST(TYPE)) ( LLIST(TYPE)* llist ); - -/* - * Takes to lists, and merges them into a single one. Destroys new_ in - * the process. - */ -LLIST(TYPE)* RESOLVE(LLIST(TYPE)) (LLIST(TYPE)* dest, LLIST(TYPE)* new_); - -FMT_F(LLIST(TYPE)); - -/* Iterator */ - -#define __PRE_LLIST(T, l, set) \ - T* l; LINK(T)* __INTER(l); - -#define PRE_FOR_LLIST(T) __PRE_LLIST - -// #define __BEG_LLIST(v, set) v = (set)->head -#define __BEG_LLIST(T, l, set) __INTER(l) = FIRST(set), l = L(__INTER(l)) -#define BEG_LLIST(T) __BEG_LLIST - -#define __END_LLIST(T, l, set) __INTER(l) != (set)->tail -#define END_LLIST(T) __END_LLIST - -#define __NXT_LLIST(T, l, set) __INTER(l) = __INTER(l)->after, l = L(__INTER(l)) -// #define __NXT_LLIST(T, l, set) l = L(__INTER(l) = __INTER(l)->after) -#define NXT_LLIST(T) __NXT_LLIST - -#endif /* TYPE */ diff --git a/src/linked_list.inc.h b/src/linked_list.inc.h deleted file mode 100644 index 3984e485..00000000 --- a/src/linked_list.inc.h +++ /dev/null @@ -1,179 +0,0 @@ -#ifndef TYPE -#error "Set TYPE before including self file" -#else - -INIT_F ( LLIST(TYPE) ) { - self->length = 0; - NEW(LINK(TYPE), head); - NEW(LINK(TYPE), tail); - self->head = head; - self->tail = tail; - head->after = tail; - tail->before = head; - self->cur = head; - self->cval = head->value; - return 0; -} - -FREE_F (LINK(TYPE)) { - UNLINK(LINK(TYPE))(self); - - if (self->value != NULL) FFREE(TYPE, self->value); - return 0; -} - -FREE_F( LLIST(TYPE) ) { - LINK(TYPE) *n, *next; - n = self->head; - while ( n != NULL ) { - next = n->after; - FFREE(LINK(TYPE), n); - n = next; - } - - self->length = -1; - - return 0; -} - -INIT_F ( LINK(TYPE) ) { - self->before = NULL; - self->after = NULL; - self->value = NULL; - return 0; -} - -INIT_F ( LINK(TYPE), TYPE* val ) { - self->before = NULL; - self->after = NULL; - self->value = val; - return 0; -} - -int UNLINK(LINK(TYPE)) ( LINK(TYPE)* self ) { - if (self->before != NULL) self->before->after = self->after; - if (self->after != NULL) self->after->before = self->before; - return 0; -} - - -int PUSH(LLIST(TYPE)) ( LLIST(TYPE)* lst, TYPE* val) { - NEW(LINK(TYPE), link, val); - - link->after = FIRST(lst); - FIRST(lst) = link; - - link->after->before = link; - link->before = lst->head; - - ++lst->length; - - // TODO do I want to change that? - lst->cur = link; - lst->cval = link->value; - - return 0; -} - -TYPE* PEEK(LLIST(TYPE)) ( LLIST(TYPE)* lst ) { - if (EMPTY(LLIST(TYPE))(lst)) return NULL; - - return FIRST(lst)->value; -} - -TYPE* POP(LLIST(TYPE)) ( LLIST(TYPE)* lst) { - if (EMPTY(LLIST(TYPE))(lst)) return NULL; - - LINK(TYPE)* frst = FIRST(lst); - UNLINK(LINK(TYPE))(frst); - - TYPE* retval = frst->value; - --lst->length; - free (frst); - return retval; -} - -int DEEP_COPY(LLIST(TYPE)) ( LLIST(TYPE)* dest, LLIST(TYPE)* src ) { - LINK(TYPE)* n = FIRST(src); - - while (n->after != NULL) { - NEW(TYPE, cpy); - DEEP_COPY(TYPE)(cpy, n->value); - PUSH(LLIST(TYPE)) ( dest, cpy ); - n = n->after; - } - - return 0; -} - -/* - * Adds two linked lists together. - * O(1) time. - * destroys new__ in the process, but keeps the elements. - * make sure to free(new__) after. - */ -int APPEND(LLIST(TYPE)) ( LLIST(TYPE)* dest, LLIST(TYPE)* new__ ) { - - /* Link end of dest onto start of new__. */ - LAST(dest)->after = FIRST(new__); - FIRST(new__)->before = LAST(dest); - - /* Free the two now not needed end links. */ - free(new__->head); - free(dest->tail); - - /* Update dest with new__ tail ptr. */ - dest->tail = new__->tail; - - dest->length += new__->length; - - return 0; -} - -int SIZE(LLIST(TYPE)) ( LLIST(TYPE)* llist ) { - return llist->length; -} - -int EMPTY(LLIST(TYPE)) ( LLIST(TYPE)* llist ) { - return FIRST(llist) == llist->tail; -} - -LLIST(TYPE)* RESOLVE(LLIST(TYPE)) (LLIST(TYPE)* dest, LLIST(TYPE)* new__) { - if (dest == NULL) return new__; - APPEND(LLIST(TYPE))(dest, new__); - free(new__); - return dest; -} - -int RESET(LLIST(TYPE)) ( LLIST(TYPE)* llist ) { - - LINK(TYPE) *link = FIRST(llist), *next; - /* - * Manual looping rather than itterators since we destroyed the - * loop variable. - */ - while (link != llist->tail) { - next = link->after; - FFREE(LINK(TYPE), link); - link = next; - } - - llist->cur = llist->head; - llist->cval = llist->head->value; - - return 0; -} - -FMT_F(LLIST(TYPE)) { - int seek = 0; - fmtf("("); - FOR(LLIST, TYPE, v, self) { - seek += FMT(TYPE)(v, buf + seek); - fmtf(" "); - } - fmtf(")"); - - return seek; -} - -#endif /* TYPE */ diff --git a/src/macro.h b/src/macro.h deleted file mode 100644 index 7b620f83..00000000 --- a/src/macro.h +++ /dev/null @@ -1,134 +0,0 @@ -#ifndef MACRO_H -#define MACRO_H - -/* - * Token paste - */ -#define TP(a, b) a ## b -#define TP3(a, b, c) a ## b ## c -#define TP4(a, b, c, d) a ## b ## c ## d -#define TP5(a, b, c, d, e) a ## b ## c ## d ## e -#define TP6(a, b, c, d, e, f) a ## b ## c ## d ## e ## f - -/* - * Get length of __VA_ARGS__ - * Borrowed fram: - * https://stackoverflow.com/a/35986932 - */ -#define VA_ARGS_NUM_PRIV(P1, P2, P3, P4, P5, P6, Pn, ...) Pn -#define VA_ARGS_NUM(...) VA_ARGS_NUM_PRIV(-1, ## __VA_ARGS__, 5, 4, 3, 2, 1, 0) - -/* - * Templatization macros. Forms symbols on the from name<T>, which - * looks really good in debuggers and the like. Unicode characters - * written in \U notation since C apparently doesn't support unicode - * literals. - * - * Can be nested (useful for container types). - * - * Doesn't use ASCII <>, but rather some other ᐸᐳ, meaning that it's - * not a reserved character. - * - * nameᐸTᐳ - */ -#define TEMPL(name, T) TP4(name, \U00001438 , T, \U00001433 ) -#define TEMPL2(name, T, V) TP6(name, \U00001438\U00001438 , T , \U00001433_\U00001438 , V, \U00001433\U00001433) -#define TEMPL_N(name, T, argcount) TP6(name, \U00001438 , T, _, argcount, \U00001433 ) - -/* Constructor type name */ -#define __INIT_T(T, C) TEMPL_N(init, T, C) - -/* Returns full type of constructor */ -#define INIT_F(T, ...) \ - int __INIT_T(T, VA_ARGS_NUM(__VA_ARGS__)) (T* self, ## __VA_ARGS__) - -/* - * Call the constructor of an object - * `int` part of the macro, to ensure that any attempt to call self - * function results in an error. - */ -#define INIT(T, N, ...) \ - __INIT_T(T, VA_ARGS_NUM(__VA_ARGS__)) (N, ## __VA_ARGS__) - -/* Allocate a new_ object on the HEAP */ -#define NEW(T, N, ...) \ - T* N = (T*) malloc(sizeof(*N)); \ - INIT(T, N, ## __VA_ARGS__); - -/* - * Reconstructs a object. Use with caution. - */ -#define RENEW(T, N, ...) do { \ - N = (T*) malloc(sizeof(*N)); \ - INIT(T, N, ## __VA_ARGS__); \ -} while (0) - - -/* Allocate a new_ object on the STACK */ -#define SNEW(T, N, ...) \ - T N; \ - INIT(T, & N, ## __VA_ARGS__); - -/* Destructor for type */ -#define FREE(T) TEMPL(free, T) - -/* Call destructor for type, and free object */ -#define FFREE(T, N) do { FREE(T)(N); free(N); } while (0) - -/* Declare destructor */ -#define FREE_F(T) int FREE(T) (T* self) - -/* generate reusable internal symbol */ -#define __INTER(s) TP3(__, s, __internal) -#define __INTER2(s) __INTER(__INTER(s)) -#define __INTER3(s) __INTER(__INTER(__INTER(s))) - -/* Iterator macros. */ -#define FOR(CONT_T, T, var, set) \ - PRE_FOR_ ## CONT_T (T) (T, var, set); \ - for( BEG_ ## CONT_T (T) (T, var, set); \ - END_ ## CONT_T (T) (T, var, set); \ - NXT_ ## CONT_T (T) (T, var, set)) - -/* Example int implementation - * FOR(int, i, 10) { } */ - -#define PRE_FOR_int(i, set) -#define BEG_int(i, set) int i = 0 -#define NXT_int(i, set) i++ -#define END_int(i, set) i < set - -/* - * General functions that different container types may implement. - * Actuall implementation and type signature is mostly left to - * individual implementations. - */ -#define DEEP_COPY(T) TEMPL(copy , T) -#define RESOLVE(T) TEMPL(resolve , T) -#define APPEND(T) TEMPL(append , T) -#define SIZE(T) TEMPL(size , T) -#define EMPTY(T) TEMPL(empty , T) -#define PUSH(T) TEMPL(push , T) -#define PEEK(T) TEMPL(peek , T) -#define POP(T) TEMPL(pop , T) -#define GET(T) TEMPL(get , T) -#define RESET(T) TEMPL(reset , T) -#define KEYS(T) TEMPL(keys , T) - -/* - * Formatting macros. - * Transform objects into string representation of themselves. - * buf should be a suffisiently large memmory location, if it's to - * small then bad stuff might happen. - * - * Should return the number of bytes written (like sprintf). - */ - -#define FMT_T(T) TEMPL(format , T) -#define FMT_F(T) int FMT_T(T)(T* self, char* buf, ...) -// TODO change order of buf and item -#define __FMT_HELP(item, buf, ...) ((item), (buf), VA_ARGS_NUM(__VA_ARGS__), ## __VA_ARGS__) -#define FMT(T) FMT_T(T) __FMT_HELP -#define fmtf(...) seek += sprintf(buf + seek, __VA_ARGS__) - -#endif /* MACRO_H */ diff --git a/src/main.c b/src/main.c deleted file mode 100644 index 4d8da7d3..00000000 --- a/src/main.c +++ /dev/null @@ -1,120 +0,0 @@ -#include <errno.h> -#include <stdio.h> -#include <string.h> -#include <assert.h> - -#include "calendar.h" -#include "macro.h" -#include "vcal.h" -#include "graphs.h" -#include "err.h" - -typedef struct { - int argc; - char** argv; -} arg; - -int arg_shift (arg* a) { - if (a->argc == 0) return 0; - - ++a->argv; - return --a->argc; - -} - -#define GETSET(C, KEY) \ - vcomponent_push_val((C), (KEY), "DUMMY VALUE"); \ - INFO_F("cline = %p", get_attributes((C), (KEY))); - -/* - * Tests defined here instead of in own header to ensure that all the - * correct modules are loaded. - */ -int run_tests() { - NEW(vcomponent, c); - INFO(All the following should print a valid pointer != 0x0); - GETSET(c, "FILENAME"); - GETSET(c, "X-HNH-FILENAME"); - GETSET(c, "DATA"); - GETSET(c, "DAT"); - GETSET(c, "DA"); - GETSET(c, "D"); - GETSET(c, "A"); - GETSET(c, "F"); - FFREE(vcomponent, c); - return 0; -} - -int main (int argc, char** argv) { - arg args = { .argc = argc, .argv = argv }; - - - if (arg_shift(&args) == 0) { - ERR("Please give something to parse, or some other flags"); - exit (1); - } - - if (strcmp(args.argv[0], "--run-tests") == 0) { - run_tests(); - return 0; - } - - char* rootpath = args.argv[0]; - SNEW(vcomponent, root, "ROOT", rootpath); - read_vcalendar(&root, rootpath); - - arg_shift(&args); - - if (args.argc == 0 || strcmp(args.argv[0], "-p") == 0) { - INFO_F("Parsed calendar file containing [%u] events", - root.components.length); - - puts("CAL : OBJ | Filename | Description"); - puts("----------+----------+------------"); - - /* This loops over all VCALENDAR's in root */ - FOR (LLIST, vcomponent, cal, &root.components) { - assert(strcmp(cal->type, "VCALENDAR") == 0); - - char* filename = vcomponent_get_val(cal, "X-HNH-FILENAME"); - - /* This loop over all VEVENT's in the current VCALENDAR */ - FOR (LLIST, vcomponent, ev, &cal->components) { - if (strcmp(ev->type, "VEVENT") != 0) continue; - - printf("%s | %s\n", - filename, - get_attributes(ev, "SUMMARY")->cval->key.mem); - } - } - } else if (strcmp(args.argv[0], "-g") == 0) { - /* TODO self might be broken */ - if (arg_shift(&args) == 0) { - FOR (LLIST, vcomponent, cal, &root.components) { - assert(strcmp(cal->type, "VCALENDAR") == 0); - - vcomponent* ev = FCHILD(cal); - - char target[0xFF]; - target[0] = '\0'; - strcat(target, "/tmp/dot/"); - strcat(target, vcomponent_get_val(ev, "X-HNH-FILENAME")); - strcat(target, ".dot"); - // create_graph(ev, target); - } - } else { - // create_graph(FCHILD(FCHILD(&root)), args.argv[0]); - INFO("Creating graph for single file"); - INFO_F("output = %s\n", args.argv[0]); - create_graph_vcomponent(&root, args.argv[0]); - } - } - - /* - char buf[0x20000]; - FMT(vcomponent)(&root, buf); - puts(buf); - */ - - FREE(vcomponent)(&root); -} diff --git a/src/pair.h b/src/pair.h deleted file mode 100644 index e96cf180..00000000 --- a/src/pair.h +++ /dev/null @@ -1,19 +0,0 @@ -#ifndef PAIR_H -#define PAIR_H - -#define PAIR(T, V) TEMPL2(pair, T, V) - -#endif /* PAIR_H */ -#if defined(T) && defined(V) - -typedef struct { - T key; - V val; -} PAIR(T, V); - -INIT_F(PAIR(T, V)); -FREE_F(PAIR(T, V)); -FMT_F(PAIR(T, V)); -int DEEP_COPY(PAIR(T, V)) (PAIR(T, V)* dest, PAIR(T, V)* src); - -#endif diff --git a/src/pair.inc.h b/src/pair.inc.h deleted file mode 100644 index c42b2dfd..00000000 --- a/src/pair.inc.h +++ /dev/null @@ -1,34 +0,0 @@ -#if ! (defined(T) && defined(V)) -#error "Both T and V must be defiend here" -#else - -INIT_F(PAIR(T, V)) { - INIT(T, &self->key); - INIT(V, &self->val); - - return 0; -} - -FREE_F(PAIR(T, V)) { - FREE(T)(&self->key); - FREE(V)(&self->val); - - return 0; -} - -FMT_F(PAIR(T, V)) { - char lbuf[0x100]; - char rbuf[0x1000]; - FMT(T)(&self->key, lbuf); - FMT(V)(&self->val, rbuf); - - return sprintf(buf, "<%s, %s>", lbuf, rbuf); -} - -int DEEP_COPY(PAIR(T, V)) (PAIR(T, V)* dest, PAIR(T, V)* src) { - DEEP_COPY(T)(&dest->key, &src->key); - DEEP_COPY(V)(&dest->val, &src->val); - return 0; -} - -#endif /* T & V */ diff --git a/src/parse.c b/src/parse.c deleted file mode 100644 index 565e1d6c..00000000 --- a/src/parse.c +++ /dev/null @@ -1,350 +0,0 @@ -#include "parse.h" - -#include <errno.h> -#include <string.h> -#include <assert.h> - -#include "macro.h" -#include "vcal.h" - -#include "err.h" - -// #define TYPE vcomponent -// #include "linked_list.inc.h" -// #undef TYPE - -#define T strbuf -#define V strbuf -#include "pair.h" -#include "pair.inc.h" -#undef T -#undef V - -/* - * name *(";" param) ":" value CRLF - */ -int parse_file(char* filename, FILE* f, vcomponent* root) { - part_context p_ctx = p_key; - - SNEW(parse_ctx, ctx, f, filename); - PUSH(LLIST(vcomponent))(&ctx.comp_stack, root); - - /* - * Create a content_line which we use as storage while we are - * parsing. This object is constantly broken down and rebuilt. - * - * {cline,param}_key is also temporary register used during - * parsing. - */ - SNEW(content_line, cline); - SNEW(strbuf, cline_key); - SNEW(strbuf, param_key); - - char c; - while ( (c = fgetc(f)) != EOF) { - - /* We have a linebreak */ - if (c == '\r' || c == '\n') { - - if (fold(&ctx, c) > 0) { - /* Actuall end of line, handle value */ - TRANSFER(CLINE_CUR_VAL(&cline), &ctx.str); - handle_kv(&cline_key, &cline, &ctx); - p_ctx = p_key; - } /* Else continue on current line */ - - /* We have an escaped character */ - } else if (c == '\\') { - handle_escape (&ctx); - - /* Border between param {key, value} */ - } else if (p_ctx == p_param_name && c == '=') { - - /* Save the current parameter key */ - TRANSFER (¶m_key, &ctx.str); - p_ctx = p_param_value; - - /* - * One of four cases: - * 1) end of key , start of value - * 2) ,, key , ,, param - * 3) ,, param, ,, param - * 4) ,, param, ,, value - */ - } else if ((p_ctx == p_key || p_ctx == p_param_value) && (c == ':' || c == ';')) { - - /* We got a parameter value, push the current string to - * the current parameter set. */ - if (p_ctx == p_param_value) { - /* save current parameter value. */ - - NEW(strbuf, s); - TRANSFER(s, &ctx.str); - - NEW(param_set, ps); - PUSH(param_set)(ps, s); - - PUSH(TRIE(param_set))(CLINE_CUR_PARAMS(&cline), param_key.mem, ps); - strbuf_soft_reset (¶m_key); - } - - /* - * Top level key. - * Copy the key into the current cline, and create a - * content_set for the upcomming value and (possible) - * parameters. - */ - if (p_ctx == p_key) { - - TRANSFER(&cline_key, &ctx.str); - - NEW(content_set, p); - PUSH(LLIST(content_set))(&cline, p); - } - - if (c == ':') p_ctx = p_value; - else if (c == ';') p_ctx = p_param_name; - - /* - * Nothing interesting happened, append the read character to - * the current string. - */ - } else { - strbuf_append(&ctx.str, c); - - ++ctx.column; - ++ctx.pcolumn; - } - } - - if (! feof(f)) { - ERR("Error parsing"); - } - /* Check to see if empty line */ - else if (ctx.str.ptr != 0) { - /* - * The standard (3.4, l. 2675) says that each icalobject must - * end with CRLF. My files however does not, so we also parse - * the end here. - */ - - TRANSFER(CLINE_CUR_VAL(&cline), &ctx.str); - handle_kv(&cline_key, &cline, &ctx); - - } - - FREE(content_line)(&cline); - FREE(strbuf)(&cline_key); - FREE(strbuf)(¶m_key); - - assert(POP(LLIST(vcomponent))(&ctx.comp_stack) == root); - assert(EMPTY(LLIST(strbuf))(&ctx.key_stack)); - assert(EMPTY(LLIST(vcomponent))(&ctx.comp_stack)); - - FREE(parse_ctx)(&ctx); - - return 0; -} - -/* - * We have a complete key value pair. - */ -int handle_kv ( - strbuf* key, - content_line* cline, - parse_ctx* ctx - ) { - - /* - * The key being BEGIN means that we decend into a new component. - */ - if (strbuf_c(key, "BEGIN")) { - /* key \in { VCALENDAR, VEVENT, VALARM, VTODO, VTIMEZONE, ... } */ - - /* - * Take a copy of the name of the entered component, and store - * it on the stack of component names. - */ - NEW(strbuf, s); - DEEP_COPY(strbuf)(s, CLINE_CUR_VAL(cline)); - PUSH(LLIST(strbuf))(&ctx->key_stack, s); - - /* Clear the value list in the parse content_line */ - RESET(LLIST(content_set))(cline); - - /* - * Create the new curent component, link it with the current - * component in a parent/child relationship. - * Finally push the new component on to the top of the - * component stack. - */ - NEW(vcomponent, e, - s->mem, - ctx->filename); - vcomponent* parent = PEEK(LLIST(vcomponent))(&ctx->comp_stack); - PUSH(vcomponent)(parent, e); - - PUSH(LLIST(vcomponent))(&ctx->comp_stack, e); - - /* - * The end of a component, go back along the stack to the previous - * component. - */ - } else if (strbuf_c(key, "END")) { - strbuf* expected_key = POP(LLIST(strbuf))(&ctx->key_stack); - - if (strbuf_cmp(expected_key, CLINE_CUR_VAL(cline)) != 0) { - - ERR_P(ctx, "Expected END:%s, got END:%s.\n%s line", - expected_key->mem, - CLINE_CUR_VAL(cline)->mem, - vcomponent_get_val( - PEEK(LLIST(vcomponent))(&ctx->comp_stack), - "X-HNH-FILENAME")); - PUSH(LLIST(strbuf))(&ctx->key_stack, expected_key); - - return -1; - - } else { - FFREE(strbuf, expected_key); - POP(LLIST(vcomponent))(&ctx->comp_stack); - } - - /* - * A regular key, value pair. Push it into to the current - * component. - */ - } else { - - /* - * cline is the value store used during parsing, meaning that - * its values WILL mutate at a later point. Therefore we take - * a copy of it here. - */ - NEW(content_line, c); - DEEP_COPY(content_line)(c, cline); - - /* - * The PUSH(TRIE(T)) method handles collisions by calling - * RESOLVE(T). content_line resolves by merging the new value - * into the old value, and freeing the new value's container. - * - * This means that |c| declared above might be destroyed - * here. - */ - PUSH(TRIE(content_line))( - &PEEK(LLIST(vcomponent))(&ctx->comp_stack)->clines, - key->mem, c); - - RESET(LLIST(content_set))(cline); - } - - return 0; -} - -int fold(parse_ctx* ctx, char c) { - int retval; - - char buf[2] = { - (c == '\n' ? '\n' : (char) fgetc(ctx->f)), - (char) fgetc(ctx->f) - }; - - ctx->pcolumn = 1; - - if (buf[0] != '\n') { - ERR_P(ctx, "expected new_line after CR"); - retval = -1; - - } else if (buf[1] == ' ' || buf[1] == '\t') { - retval = 0; - ctx->pcolumn++; - - } else if (ungetc(buf[1], ctx->f) != buf[1]) { - ERR_P(ctx, "Failed to put character back on FILE"); - retval = -2; - - } else { - retval = 1; - ++ctx->line; - ctx->column = 0; - } - - ++ctx->pline; - - return retval; -} - - -INIT_F(parse_ctx, FILE* f, char* filename) { - INIT(LLIST(strbuf), &self->key_stack); - INIT(LLIST(vcomponent), &self->comp_stack); - self->filename = (char*) calloc(sizeof(*filename), strlen(filename) + 1); - strcpy(self->filename, filename); - self->f = f; - - self->line = 0; - self->column = 0; - - self->pline = 1; - self->pcolumn = 1; - - INIT(strbuf, &self->str); - - return 0; -} - -FREE_F(parse_ctx) { - - FREE(LLIST(strbuf))(&self->key_stack); - FREE(LLIST(vcomponent))(&self->comp_stack); - free(self->filename); - - self->line = 0; - self->column = 0; - FREE(strbuf)(&self->str); - - return 0; -} - -int handle_escape (parse_ctx* ctx) { - char esc = fgetc(ctx->f); - - /* - * Escape character '\' and escaped token sepparated by a newline - * (since the standard for some reason allows that (!!!)) - * We are at least guaranteed that it's a folded line, so just - * unfold it and continue trying to find a token to escape. - */ - if (esc == '\r' || esc == '\n') { - int ret; - if ( (ret = fold(ctx, esc)) != 0) { - if (ret == 1) ERR_P(ctx, "ESC before not folded line"); - else ERR_P(ctx, "other error: val = %i", ret); - exit (2); - } else { - esc = fgetc(ctx->f); - } - } - - /* Escaped new_line */ - if (esc == 'n' || esc == 'N') { - esc = '\n'; - - /* "Standard" escaped character */ - } else if (esc == ';' || esc == ',' || esc == '\\') { - /* esc already contains character, do nothing */ - - /* Invalid escaped character */ - } else { - ERR_P(ctx, "Non escapable character '%c' (%i)", esc, esc); - } - - /* save escapade character as a normal character */ - strbuf_append(&ctx->str, esc); - - ++ctx->column; - ++ctx->pcolumn; - - return 0; -} diff --git a/src/parse.h b/src/parse.h deleted file mode 100644 index 53263b4c..00000000 --- a/src/parse.h +++ /dev/null @@ -1,122 +0,0 @@ -#ifndef PARSE_H -#define PARSE_H - -#include <stdio.h> -#include <stdlib.h> - -#include "strbuf.h" -#include "vcal.h" - -// #define TYPE vcomponent -// #include "linked_list.h" -// #undef TYPE - -/* - * The standard says that no line should be longer than 75 octets. - * This sets the default amount of memory to allocate for each string, - * but strings are reallocated when needed. - */ -#define SEGSIZE 75 - -/* - * Transfers a strbuf from src to target. - * Does this first copying the contents, followed by capping the - * target and reseting the src. - */ -#define TRANSFER(target, src) do { \ - DEEP_COPY(strbuf)((target), (src)); \ - strbuf_cap(target); \ - strbuf_soft_reset(src); \ -} while (0) - -/* - * Current context for the character consumer (parse_file). - */ -typedef enum { - p_key, p_value, p_param_name, p_param_value, p_escape -} part_context; - -/* - * Struct holding most state information needed while parsing. - * Kept together for simplicity. - */ -typedef struct { - /* Which file we are parsing, copied to all components to allow - * writebacks later */ - char* filename; - - FILE* f; - - /* - * context stacks used since ICS files form a tree. key_stack is - * only for sequrity purposes. - */ - LLIST(strbuf) key_stack; - LLIST(vcomponent) comp_stack; - - /* Number for unfolded lines - * TODO remove this - * */ - int line; - int column; - - /* Actuall lines and columns from file */ - int pline; - int pcolumn; - - /* - * String which we write everything read into. - * Later copied to appropiate places. - */ - strbuf str; -} parse_ctx; - -INIT_F(parse_ctx, FILE* f, char* filename); -FREE_F(parse_ctx); - - -/* - * Character consumer. Reads characters from stdin until end of file. - * Whenever it finds a token with a special value (such as ':', ';', - * ...) it saves it away. - * Once It has parsed a full line it calls handel_kv. Which build my - * actuall datastructure. - */ -int parse_file(char* filename, FILE* f, vcomponent* cal); - -/* - * Called whenever parse_file finishes a line. Copies the contents of - * ctx and the current content_line into the object stack, stored in - * ctx. - */ -int handle_kv( - strbuf* key, - content_line* cline, - parse_ctx* ctx - ); - -/* - * Input - * f: file to get characters from - * ctx: current parse context - * c: last read character - * output: - * 0: line folded - * 1: line ended - * - * A carrige return means that the current line is at an - * end. The following character should always be \n. - * However, if the first character on the next line is a - * whitespace then the two lines should be concatenated. - * - * NOTE - * The above is true according to the standard. But I have - * found files with only NL. The code below ends line on the - * first of NL or CR, and then ensures that the program thinks - * it got the expected CRNL. - */ -int fold(parse_ctx* ctx, char c); - -int handle_escape (parse_ctx* ctx); - -#endif /* PARSE_H */ diff --git a/src/strbuf.c b/src/strbuf.c deleted file mode 100644 index 66fe2989..00000000 --- a/src/strbuf.c +++ /dev/null @@ -1,156 +0,0 @@ -#include "strbuf.h" - -#include <string.h> -#include <stdio.h> - -#include "err.h" - -INIT_F(strbuf) { - self->alloc = 0x10; - self->mem = (char*) calloc(sizeof(*self->mem), self->alloc); - self->ptr = 0; - self->len = 0; - self->scm = NULL; - return 0; -} - -int strbuf_realloc(strbuf* str, size_t len) { - str->mem = (char*) realloc(str->mem, len); - str->alloc = len; - return 0; -} - -FREE_F(strbuf) { - /* has already been freed */ - if (self->mem == NULL) return 1; - - free (self->mem); - self->mem = NULL; - self->alloc = 0; - self->len = 0; - return 0; -} - -/* - * Reallocates memmory for you. Returns 1 if memory was reallocated. - */ -int strbuf_append(strbuf* s, char c) { - int retval = 0; - - if (s->len + 1 > s->alloc) { - s->alloc <<= 1; - s->mem = (char*) realloc(s->mem, s->alloc); - retval = 1; - } - - s->mem[s->len] = c; - s->ptr = ++s->len; - return retval; -} - -char strbuf_pop(strbuf* s) { - char ret = s->mem[--s->len]; - s->mem[s->len + 1] = '\0'; - return ret; -} - -int strbuf_cap(strbuf* s) { - strbuf_append(s, 0); - --s->len; - return 0; -} - -int DEEP_COPY(strbuf)(strbuf* dest, strbuf* src) { - int retval = 0; - - if (dest->alloc < src->len) { - /* +1 in length is to have room for '\0'. */ - strbuf_realloc(dest, src->len + 1); - retval = 1; - } - - if (src->scm != NULL) { - /* - * Upon Vcomponent binding into scheme I place all - * strings inside cons cells. This leads to a deep - * copy being required. copy-tree however returns - * the same object for atoms and scheme strings. - */ - dest->scm = scm_copy_tree(src->scm); - /* NOTE This is a bit of a leaky abstraction. */ - scm_gc_protect_object(dest->scm); - } - - dest->len = src->len; - memcpy(dest->mem, src->mem, src->len); - return retval; -} - -int strbuf_cmp(strbuf* a, strbuf* b) { - if (a == NULL || a->alloc == 0 || - b == NULL || b->alloc == 0) - { - ERR("a or b not alloced"); - return -1; - } else { - return strncmp(a->mem, b->mem, a->len); - } -} - -int strbuf_c(strbuf* a, const char* b) { - if (a == NULL || a->alloc == 0) { - ERR("a not allocated"); - return -1; - } - - return strcmp(a->mem, b) == 0; -} - -char* charat(strbuf* s, unsigned int idx) { - if (idx > s->len) { - ERR("Index out of bounds"); - return (char*) -1; - } - - return &s->mem[idx]; -} - -char* strbuf_cur(strbuf* s) { - return &s->mem[s->ptr]; -} - -char* strbuf_end(strbuf* s) { - return &s->mem[s->len]; -} - -int strbuf_reset(strbuf* s) { - s->ptr = 0; - return 0; -} - - -int strbuf_soft_reset(strbuf* s) { - s->ptr = s->len = 0; - return 0; -} - -strbuf* RESOLVE(strbuf)(strbuf* dest, strbuf* new_) { - if (dest == NULL) return new_; - else return dest; -} - -FMT_F(strbuf) { - return sprintf(buf, "%s", self->mem); -} - -int SIZE(strbuf)(strbuf* self) { - return self->len; -} - -int strbuf_load(strbuf* self, const char* str) { - for (int i = 0; str[i] != '\0'; i++) { - strbuf_append(self, str[i]); - } - strbuf_cap(self); - return 0; -} diff --git a/src/strbuf.h b/src/strbuf.h deleted file mode 100644 index 7f936a9e..00000000 --- a/src/strbuf.h +++ /dev/null @@ -1,109 +0,0 @@ -#ifndef STRBUF_H -#define STRBUF_H - -#include <stdlib.h> -#include <libguile.h> -#include "macro.h" - -/* - * A high level string type which holds it's own length, how much - * memmory it has allocated for itself, and a seek pointer into the - * string. - * - * Also comes with a number of functions which allow for safe(er) - * access to the memmory. - */ -typedef struct { - char* mem; - SCM scm; - /* TODO add support for negative ptr */ - int ptr; - unsigned int alloc; - unsigned int len; -} strbuf; - -/* - * Init strbuf to size of 10 - */ -INIT_F(strbuf); - -/* - * Like realloc, but for strbuf - */ -int strbuf_realloc(strbuf* str, size_t len); - -/* - * Free's contents of str, but keeps str. - */ -FREE_F(strbuf); - -int strbuf_cmp(strbuf* a, strbuf* b); -int strbuf_c(strbuf* a, const char* b); - -/* - * Copy contents from src to dest. - * Assumes that dest is already initialized. - */ -int DEEP_COPY(strbuf)(strbuf*, strbuf*); - -/* - * Append char to end of strbuf, determined by s->len. - * - * TODO rename this PUSH(strbuf)? - */ -int strbuf_append(strbuf* s, char c); - -char strbuf_pop(strbuf*); - -/* - * Calls strbuf_append with NULL. - */ -int strbuf_cap(strbuf* s); - -/* - * Returns a pointer to character at index. Allows mutation of the - * value pointed to by the return address. - */ -char* charat(strbuf* s, unsigned int idx); - -/* - * Same as `charat`, But returns the current character. - */ -char* strbuf_cur(strbuf* s); - -/* - * Resets the seek for strbuf to 0. - */ -int strbuf_reset(strbuf* s); - -/* - * Sets the length and seek ptr to 0, but doesn't touch the memmory. - */ -int strbuf_soft_reset(strbuf* s); - -/* - * Returns the character after the last, so where null hopefully is. - */ -char* strbuf_end(strbuf* s); - -/* - * Reallocs dest to be the same size as src, and copies the contents - * of src into dest. - */ -int strbuf_realloc_copy(strbuf* dest, strbuf* src); - -/* - * Copies contents from src to dest, also allocating dest in the - * process. dest should not be initialized before self call. - */ -int strbuf_init_copy(strbuf* dest, strbuf* src); - -strbuf* RESOLVE(strbuf)(strbuf*, strbuf*); - -FMT_F(strbuf); - -int SIZE(strbuf)(strbuf*); - -int strbuf_load(strbuf* self, const char* str); - -#endif /* STRBUF_H */ diff --git a/src/trie.h b/src/trie.h deleted file mode 100644 index 9de38be3..00000000 --- a/src/trie.h +++ /dev/null @@ -1,54 +0,0 @@ -#ifndef TRIE_H -#define TRIE_H - -#include <stdio.h> - -#include "macro.h" - -#define TRIE(T) TEMPL(trie, T) -#define TRIE_NODE(T) TEMPL(trie_node, T) - -#endif /* TRIE_H */ -#ifdef TYPE - -#include "linked_list.h" -#include "strbuf.h" - -typedef struct TRIE_NODE(TYPE) { - char c; - TYPE* value; - struct TRIE_NODE(TYPE)* next; - struct TRIE_NODE(TYPE)* child; -} TRIE_NODE(TYPE); - -typedef struct { - TRIE_NODE(TYPE)* root; -} TRIE(TYPE); - - -INIT_F ( TRIE(TYPE) ); - -INIT_F (TRIE_NODE(TYPE), char c); - -INIT_F (TRIE_NODE(TYPE), - char c, TRIE_NODE(TYPE)* next, TRIE_NODE(TYPE)* child ); - -int PUSH(TRIE(TYPE)) ( TRIE(TYPE)* trie, char* key, TYPE* val ); - -TYPE* GET(TRIE(TYPE)) ( TRIE(TYPE)* trie, char* key ); - -FREE_F(TRIE_NODE(TYPE)); - -FREE_F(TRIE(TYPE)); - -int EMPTY(TRIE(TYPE))(TRIE(TYPE)*); - -FMT_F(TRIE_NODE(TYPE)); -FMT_F(TRIE(TYPE)); - -int DEEP_COPY(TRIE_NODE(TYPE)) (TRIE_NODE(TYPE)* dest, TRIE_NODE(TYPE)* src); -int DEEP_COPY(TRIE(TYPE)) (TRIE(TYPE)* dest, TRIE(TYPE)* src); - -LLIST(strbuf)* KEYS(TRIE(TYPE)) (TRIE(TYPE)*); - -#endif /* TYPE */ diff --git a/src/trie.inc.h b/src/trie.inc.h deleted file mode 100644 index 64e5239d..00000000 --- a/src/trie.inc.h +++ /dev/null @@ -1,231 +0,0 @@ -#ifndef TYPE -#error "Set TYPE before including self file" -#else - -#include <stdarg.h> - -#include "err.h" -#include "macro.h" -#include "linked_list.inc.h" -#include "strbuf.h" - -INIT_F ( TRIE(TYPE) ) { - NEW(TRIE_NODE(TYPE), t, '\0'); - self->root = t; - return 0; -} - -INIT_F (TRIE_NODE(TYPE), char c) { - self->c = c; - self->value = NULL; - self->next = NULL; - self->child = NULL; - return 0; -} - -INIT_F (TRIE_NODE(TYPE), - char c, - TRIE_NODE(TYPE)* next, - TRIE_NODE(TYPE)* child ) -{ - self->c = c; - self->next = next; - self->child = child; - return 0; -} - -int PUSH(TRIE(TYPE)) ( TRIE(TYPE)* trie, char* key, TYPE* val ) { - TRIE_NODE(TYPE) *cur, *last; - - last = trie->root; - cur = last->child; - - char* subkey = key; - - while (1) { - if (cur == NULL) { - /* Build direct LL for remaining subkey */ - for (char* c = subkey; c[0] != '\0'; c++) { - NEW(TRIE_NODE(TYPE), t, *c); - last->child = t; - last = t; - } - last->value = RESOLVE(TYPE)(last->value, val); - return 0; - } else if (cur->c == subkey[0]) { - /* This node belongs to the key, - * Decend further */ - last = cur; - cur = cur->child; - subkey++; - } else if (subkey[0] == '\0') { - /* Key finished */ - last->value = RESOLVE(TYPE)(last->value, val); - return 0; - } else if (cur->next != NULL) { - /* This node was not part of the set, but it's sibling might */ - cur = cur->next; - /* `last` not set since we aren't moving down */ - } else { - /* No node on self level was part of the set, create a new__ - * sibling and follow down that parse */ - NEW(TRIE_NODE(TYPE), t, *subkey); - cur->next = t; - last = cur; - cur = t; - } - } - - return 0; -} - -/* - * TODO what happens when I give an invalid key? - */ -TYPE* GET(TRIE(TYPE)) ( TRIE(TYPE)* trie, char* key ) { - TRIE_NODE(TYPE)* n = trie->root->child; - char* subkey = key; - - while (n != NULL) { - if (subkey[0] == n->c) { - if (subkey[1] == '\0') { - /* Wanted node found, - * value can however be NULL */ - return n->value; - } else { - n = n->child; - subkey++; - } - } else { - n = n->next; - } - - } - - /* Position not found */ - return 0; -} - -FREE_F(TRIE_NODE(TYPE)) { - if (self == NULL) return 0; - if (self->value != NULL) FFREE(TYPE, self->value); - if (self->next != NULL) FREE(TRIE_NODE(TYPE))(self->next); - if (self->child != NULL) FREE(TRIE_NODE(TYPE))(self->child); - free (self); - return 0; -} - -FREE_F(TRIE(TYPE)) { - if (self->root->c != '\0') { - // ERR("Invalid trie"); - return 1; - } - return FREE(TRIE_NODE(TYPE))(self->root); -} - -int EMPTY(TRIE(TYPE))(TRIE(TYPE)* self) { - return self->root->child == NULL; -} - -FMT_F(TRIE_NODE(TYPE)) { - - va_list ap; - va_start(ap, buf); - int argc = va_arg(ap, int); - int depth = argc >= 1 - ? va_arg(ap, int) - : 0; - va_end(ap); - - int seek = 0; - - TRIE_NODE(TYPE)* n = self; - - if (n == NULL) { fmtf("\n"); } - while (n != NULL) { - fmtf("|"); - // FOR(int, i, depth) fmtf(" "); - for (int i = 0; i < depth; i++) fmtf(" "); - fmtf("%c ", n->c == '\0' ? '0' : n->c); - if (n->value != NULL) { - seek += FMT(TYPE)(n->value, buf + seek); - fmtf("\n"); - } - - if (n->child != NULL) { - fmtf("\n"); - seek += FMT(TRIE_NODE(TYPE))(n->child, buf + seek, depth + 1); - } - n = n->next; - } - return seek; - -} - -FMT_F(TRIE(TYPE)) { - int seek = 0; - fmtf("Trie: %p: {", self); - if (EMPTY(TRIE(TYPE))(self)) { - fmtf(" [EMPTY] "); - } else { - fmtf("\n"); - seek += FMT(TRIE_NODE(TYPE))(self->root->child, buf + seek); - } - fmtf("}"); - return seek; -} - -int DEEP_COPY(TRIE_NODE(TYPE)) (TRIE_NODE(TYPE)* dest, TRIE_NODE(TYPE)* src) { - dest->c = src->c; - - if (src->value != NULL) { - RENEW(TYPE, dest->value); - DEEP_COPY(TYPE)(dest->value, src->value); - } - - if (src->next != NULL) { - RENEW(TRIE_NODE(TYPE), dest->next, '\0'); - DEEP_COPY(TRIE_NODE(TYPE))(dest->next, src->next); - } - - if (src->child != NULL) { - RENEW(TRIE_NODE(TYPE), dest->child, '\0'); - DEEP_COPY(TRIE_NODE(TYPE))(dest->child, src->child); - } - - return 0; -} - -int DEEP_COPY(TRIE(TYPE)) (TRIE(TYPE)* dest, TRIE(TYPE)* src) { - return DEEP_COPY(TRIE_NODE(TYPE))(dest->root, src->root); -} - -void KEYS(TRIE_NODE(TYPE)) (TRIE_NODE(TYPE)* node, LLIST(strbuf)* list, strbuf* path) { - if (node == NULL) return; - - - if (node->value != NULL) { - strbuf_append(path, node->c); - NEW(strbuf, c); - DEEP_COPY(strbuf)(c, path); - PUSH(LLIST(strbuf))(list, c); - strbuf_pop(path); - } - if (node->next != NULL) { - KEYS(TRIE_NODE(TYPE)) (node->next, list, path); - } - if (node->child != NULL) { - if (node->c != '\0') strbuf_append(path, node->c); - KEYS(TRIE_NODE(TYPE)) (node->child, list, path); - if (node->c != '\0') strbuf_pop(path); - } -} - -LLIST(strbuf)* KEYS(TRIE(TYPE)) (TRIE(TYPE)* trie) { - NEW(LLIST(strbuf), retlist); - SNEW(strbuf, key); - KEYS(TRIE_NODE(TYPE)) (trie->root, retlist, &key); - return retlist; -} - -#endif /* TYPE */ diff --git a/src/vcal.c b/src/vcal.c deleted file mode 100644 index 74af44be..00000000 --- a/src/vcal.c +++ /dev/null @@ -1,175 +0,0 @@ -#include "vcal.h" - -#include <string.h> - -#define TYPE strbuf -#include "linked_list.inc.h" -#undef TYPE - -#define TYPE param_set -#include "trie.inc.h" -#undef TYPE - -#define TYPE content_set -#include "linked_list.inc.h" -#undef TYPE - -#define T strbuf - #define V TRIE(param_set) - #include "pair.inc.h" - #undef V -#undef T - -#define TYPE content_line -// #include "hash.inc" -#include "trie.inc.h" -#undef TYPE - -#define TYPE vcomponent -// #include "vector.inc.h" -#include "linked_list.inc.h" -#undef TYPE - -INIT_F(vcomponent) { - INIT(TRIE(content_line), &self->clines); - INIT(LLIST(vcomponent), &self->components); - - // vcomponent_push_val (self, "X-HNH-FILENAME", "VIRTUAL"); - vcomponent_push_val (self, "X-HNH-SOURCETYPE", "virtual"); - char* type = "VIRTUAL"; - self->type = (char*) calloc(sizeof(*type), strlen(type) + 1); - strcpy(self->type, type); - - self->parent = NULL; - self->scm = NULL; - self->scmtype = NULL; - - return 0; - -} - -INIT_F(vcomponent, const char* type) { - return INIT(vcomponent, self, type, NULL); -} - -INIT_F(vcomponent, const char* type, const char* filename) { - - INIT(TRIE(content_line), &self->clines); - INIT(LLIST(vcomponent), &self->components); - - if (filename != NULL) { - /* - * NOTE - * RFC-7986 adds additional parameters linked to this one. - * - `SOURCE' :: where a (possibly) updated version of the data can be - * found - * - `URL' :: Where the same data can be fonud, but - * differently (but not where the original data can be fonud - * agani). - */ - vcomponent_push_val (self, "X-HNH-FILENAME", filename); - } - - self->type = (char*) calloc(sizeof(*type), strlen(type) + 1); - strcpy(self->type, type); - - self->parent = NULL; - self->scm = NULL; - self->scmtype = NULL; - - return 0; -} - -content_line* get_attributes (vcomponent* ev, const char* key) { - size_t len = strlen(key) + 1; - char* cpy = (char*) (calloc(sizeof(*cpy), len)); - strncpy (cpy, key, len); - - content_line* ret = GET(TRIE(content_line))(&ev->clines, cpy); - - free (cpy); - return ret; -} - -FREE_F(vcomponent) { - free(self->type); - - if (FREE(TRIE(content_line))(&self->clines) != 0) { - ERR("Error freeing vcomponent"); - } - - FREE(LLIST(vcomponent))(&self->components); - - return 0; -} - -int PUSH(vcomponent)(vcomponent* parent, vcomponent* child) { - child->parent = parent; - return PUSH(LLIST(vcomponent))(&parent->components, child); -} - -int DEEP_COPY(vcomponent)(vcomponent* a, vcomponent* b) { - (void) a; - (void) b; - ERR("Deep copy not implemented for vcomponent"); - return -1; -} - -int vcomponent_copy(vcomponent* dest, vcomponent* src) { - - DEEP_COPY(TRIE(content_line))(&dest->clines, &src->clines); - - /* Children are the same objects */ - FOR(LLIST, vcomponent, c, &src->components) { - PUSH(LLIST(vcomponent))(&dest->components, c); - } - - dest->parent = src->parent; - // PUSH(vcomponent)(src->parent, dest); - - return 0; -} - -FMT_F(vcomponent) { - int seek = 0; - - for (int i = 0; i < 40; i++) fmtf("_"); - - seek += sprintf(buf + seek, _YELLOW); - seek += sprintf(buf + seek, "\nVComponet (Type := %s)\n", self->type); - seek += sprintf(buf + seek, _RESET); - seek += FMT(TRIE(content_line))(&self->clines, buf + seek); - seek += sprintf(buf + seek, "\nComponents:\n"); - FOR(LLIST, vcomponent, comp, &self->components) { - seek += FMT(vcomponent)(comp, buf + seek); - } - - return seek; -} - -int vcomponent_push_val (vcomponent* comp, const char* key, const char* val) { - NEW(content_line, cl); - NEW(content_set, cs); - strbuf_load(&cs->key, val); - PUSH(content_line)(cl, cs); - - char* key_cpy = calloc(sizeof(*key_cpy), strlen(key) + 1); - strcpy (key_cpy, key); - PUSH(TRIE(content_line))(&comp->clines, key_cpy, cl); - free (key_cpy); - - return 0; -} - -char* vcomponent_get_val (vcomponent* comp, const char* key) { - char* key_cpy = calloc(sizeof(*key_cpy), strlen(key) + 1); - strcpy (key_cpy, key); - content_line* cl = GET(TRIE(content_line))(&comp->clines, key_cpy); - free (key_cpy); - - if (cl != NULL && cl->cval != NULL) { - return cl->cval->key.mem; - } - - return NULL; -} diff --git a/src/vcal.h b/src/vcal.h deleted file mode 100644 index 2a3ad294..00000000 --- a/src/vcal.h +++ /dev/null @@ -1,120 +0,0 @@ -#ifndef VCAL_H -#define VCAL_H - -#include <stdlib.h> - -#include <libguile.h> - -#include "strbuf.h" - -#define TYPE strbuf -#include "linked_list.h" -// #include "trie.h" -#undef TYPE - -/* - * content_line: - * (a mapping) between a top level key, and everything it contains. - * content_set: - * A top level value, along with a list of kv pairs for all its - * possible parameters. - * param_set: - * A parameter key, along with a list of all its values. - */ - -#define param_set LLIST(strbuf) - -#define TYPE param_set -#include "trie.h" -#undef TYPE - -#define T strbuf - #define V TRIE(param_set) - #include "pair.h" - /* left := content | right := params */ - #define content_set PAIR(strbuf, TRIE(param_set)) - #undef V -#undef T - -#define TYPE content_set -#include "linked_list.h" -#undef TYPE - -#define content_line LLIST(content_set) - -/* - * Helper macros for accessing fields in - * content_line, content_set, and param_set - */ - -/* content_set */ -#define CLINE_CUR(c) ((c)->cval) - -/* strbuf */ -#define CLINE_CUR_VAL(c) (& CLINE_CUR(c)->key) - -/* TRIE(param_set) */ -#define CLINE_CUR_PARAMS(c) (& CLINE_CUR(c)->val) - -#define TYPE content_line -#include "trie.h" -#undef TYPE - -typedef struct s_vcomponent vcomponent; - -#define TYPE vcomponent -// #include "vector.h" -#include "linked_list.h" -#undef TYPE - -struct s_vcomponent { - /* VCALENDAR, VEVENT, ... */ - char* type; - vcomponent* parent; - TRIE(content_line) clines; - LLIST(vcomponent) components; - - /* - * Holds a Guile representation of this object. Used to always - * return the same foreign (for guile) object for the same - * vcomponent. - */ - SCM scm; - SCM scmtype; -}; - -#define FCHILD(v) FIRST_V(&(v)->components) - -INIT_F(vcomponent); -INIT_F(vcomponent, const char* type); -INIT_F(vcomponent, const char* type, const char* filename); -FREE_F(vcomponent); - -content_line* get_attributes (vcomponent* ev, const char* key); - -int add_content_line (vcomponent* ev, content_line* c); - -int vcomponent_push_val (vcomponent*, const char* key, const char* val); -char* vcomponent_get_val (vcomponent*, const char* key); - -/* - * Appends ev to cal. Doesn't copy ev. So make sure that it wont go - * out of scope. - */ -int PUSH(vcomponent)(vcomponent*, vcomponent*); - -/* - * Deep copy is currently not implemented for vcomponentes. - * The reason for this method being here is since some - * generic methods in other places complain otherwise. - */ -int DEEP_COPY(vcomponent)(vcomponent*, vcomponent*); - -/* - * "Shallow" copy of vcomponent. - */ -int vcomponent_copy(vcomponent*, vcomponent*); - -FMT_F(vcomponent); - -#endif /* VCAL_H */ |