diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2019-10-06 13:35:20 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-10-06 13:35:20 +0200 |
commit | feefb97cf9118c8e5d7018e33887a371dadc5eab (patch) | |
tree | 33c42222df642813b726f5cc085d0d3569e441a1 /module/vcomponent | |
parent | Remove old C code. (diff) | |
download | calp-feefb97cf9118c8e5d7018e33887a371dadc5eab.tar.gz calp-feefb97cf9118c8e5d7018e33887a371dadc5eab.tar.xz |
Minor cleanup in scheme code.
Diffstat (limited to '')
-rw-r--r-- | module/vcomponent.scm | 36 | ||||
-rw-r--r-- | module/vcomponent/base.scm | 27 | ||||
-rw-r--r-- | module/vcomponent/primitive.scm | 22 | ||||
-rw-r--r-- | module/vcomponent/timezone.scm | 3 |
4 files changed, 18 insertions, 70 deletions
diff --git a/module/vcomponent.scm b/module/vcomponent.scm index e7ffb785..4d13dbc8 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -32,13 +32,7 @@ ;; 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)))) - )) + (make-tz-set tz))) (for ev in (filter (lambda (o) (eq? 'VEVENT (type o))) (children cal)) (define dptr (attr* ev 'DTSTART)) @@ -50,12 +44,10 @@ (let ((d (set (date-hour date) = (+ 1)))) (set! (attr ev 'DTEND) d eptr (attr* ev 'DTEND)) - d - )] + d)] [(value eptr) => parse-datetime] [else - (set (date-hour date) = (+ 1))]) - ) + (set (date-hour date) = (+ 1))])) (set! (value dptr) (date->time-utc date) (value eptr) (date->time-utc end-date)) @@ -70,21 +62,6 @@ (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) (primitive-make-vcomponent) @@ -121,9 +98,10 @@ (unless (find (lambda (z) (string=? (attr z "TZID") (attr component "TZID"))) - (filter (lambda (o) (eq? 'VTIMEZONE (type o))) (children accum))) - (push-child! accum component))) - (else (push-child! accum component))))) + (filter (lambda (o) (eq? 'VTIMEZONE (type o))) + (children accum))) + (add-child! accum component))) + (else (add-child! accum component))))) ;; return accum)) diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm index 246566ee..69fab656 100644 --- a/module/vcomponent/base.scm +++ b/module/vcomponent/base.scm @@ -6,6 +6,8 @@ :use-module (ice-9 hash-table) :use-module ((ice-9 optargs) :select (define*-public))) +(export add-child!) + ;; vline → value (define-public value (make-procedure-with-setter @@ -29,25 +31,10 @@ (as-string attr) (make-vline value)))) -;; (define-public (values-left-count attr-list) -;; (length (take-while identity attr-list))) - -;; (define-public (value-count attr-list) -;; (length (take-while identity (cdr (drop-while identity attr-list))))) - -;; (define (get-first c a) -;; (and=> (car (get-attr c a)) car)) - -;; (define (set-first! c a v) -;; (and=> (car (get-attr c a)) -;; (lambda (f) (set! (car f) v)))) - (define-public attr (make-procedure-with-setter -; get-first set-first! get-attr - set-attr! - )) + set-attr!)) (define-public prop @@ -68,11 +55,9 @@ )) (define-public (parent c) (struct-ref c 2)) -(define-public push-child! add-child!) + (define-public (attributes component) - (hash-map->list cons (struct-ref component 3)) - #; (map string->symbol (%vcomponent-attribute-list component)) - ) + (hash-map->list cons (struct-ref component 3))) (define*-public (children component) (struct-ref component 1)) @@ -92,8 +77,6 @@ (hash-map->list (lambda (key value) (cons key (copy-vline value))) (struct-ref component 3))))) -;; (define-public filter-children! %vcomponent-filter-children!) - (define-public (extract field) (lambda (e) (attr e field))) diff --git a/module/vcomponent/primitive.scm b/module/vcomponent/primitive.scm index 2cf12508..5fef08cc 100644 --- a/module/vcomponent/primitive.scm +++ b/module/vcomponent/primitive.scm @@ -1,23 +1,9 @@ ;;; 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) - - (make-vcomponent add-line! add-child! make-vline add-attribute! parse-cal-path) - ) + #:export (make-vcomponent + add-line! add-child! + make-vline add-attribute! + parse-cal-path)) (load-extension "libguile-calendar" "init_lib") diff --git a/module/vcomponent/timezone.scm b/module/vcomponent/timezone.scm index 4a312288..dde32cc2 100644 --- a/module/vcomponent/timezone.scm +++ b/module/vcomponent/timezone.scm @@ -68,7 +68,8 @@ ;; 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. |