aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-07-17 23:58:20 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-07-17 23:58:20 +0200
commitd74deac624de47c672e81c33db5fc39f244ec0ca (patch)
tree6abe7952fb838f68addb316ccc3d5632d80ca6b0
parentResolve TODO about parameter name. (diff)
downloadcalp-d74deac624de47c672e81c33db5fc39f244ec0ca.tar.gz
calp-d74deac624de47c672e81c33db5fc39f244ec0ca.tar.xz
Properties now return alist instead of hashmap.
-rw-r--r--module/output/ical.scm10
-rw-r--r--module/output/xcal.scm46
-rw-r--r--module/vcomponent/base.scm4
-rw-r--r--module/vcomponent/describe.scm42
4 files changed, 50 insertions, 52 deletions
diff --git a/module/output/ical.scm b/module/output/ical.scm
index d0dcd98c..9e147316 100644
--- a/module/output/ical.scm
+++ b/module/output/ical.scm
@@ -133,21 +133,19 @@
(define-public (component->ical-string component)
(format #t "BEGIN:~a\r\n" (type component))
- ;; TODO this leaks internal information,
- ;; write a better API for vcomponent.
- (hash-for-each
+ (for-each
;; Special cases depending on key.
;; Value formatting is handled in @code{value-format}.
- (match-lambda*
+ (match-lambda
[(? (compose internal-field? car)) 'noop]
- [(key (vlines ...))
+ [(key vlines ...)
(for vline in vlines
(display (vline->string vline))
(display "\r\n"))]
- [(key vline)
+ [(key . vline)
(display (vline->string vline))
(display "\r\n")])
(properties component))
diff --git a/module/output/xcal.scm b/module/output/xcal.scm
index b4fee9b7..b2c3f899 100644
--- a/module/output/xcal.scm
+++ b/module/output/xcal.scm
@@ -101,30 +101,28 @@
(remove null?
`(,tagsymb
- ;; TODO only have <properties> when it's non-empty.
- ;; This becomes MUCH easier once properties stop returning
- ;; a hash-map...
- (properties
- ,@(filter
- identity
- (hash-map->list
- (match-lambda*
- [(? (compose internal-field? car)) #f]
-
- [(key (vlines ...))
- (remove null?
- `(,(downcase-symbol key)
- ,(parameters-tag (reduce assq-merge
- '() (map parameters vlines)))
- ,@(for vline in vlines
- (vline->value-tag vline))))]
-
- [(key vline)
- (remove null?
- `(,(downcase-symbol key)
- ,(parameters-tag (parameters vline))
- ,(vline->value-tag vline)))])
- (properties component))))
+ ;; only have <properties> when it's non-empty.
+ ,(let ((props
+ (filter-map
+ (match-lambda
+ [(? (compose internal-field? car)) #f]
+
+ [(key vlines ...)
+ (remove null?
+ `(,(downcase-symbol key)
+ ,(parameters-tag (reduce assq-merge
+ '() (map parameters vlines)))
+ ,@(for vline in vlines
+ (vline->value-tag vline))))]
+
+ [(key . vline)
+ (remove null?
+ `(,(downcase-symbol key)
+ ,(parameters-tag (parameters vline))
+ ,(vline->value-tag vline)))])
+ (properties component))))
+ (unless (null? props)
+ `(properties ,@props)))
,(unless (null? (children component))
`(components ,@(map vcomponent->sxcal (children component)))))))
diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 7f90cdf4..a93ff6da 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -156,10 +156,10 @@
(hash-map->list list (get-vline-parameters vline)))
(define-public (properties component)
- (get-component-properties component))
+ (hash-map->list cons (get-component-properties component)))
(define-public (property-keys component)
- (map car (hash-map->list cons (get-component-properties component))))
+ (map car (get-component-properties component)))
(define (copy-vline vline)
(make-vline (vline-key vline)
diff --git a/module/vcomponent/describe.scm b/module/vcomponent/describe.scm
index f6c77f55..69084679 100644
--- a/module/vcomponent/describe.scm
+++ b/module/vcomponent/describe.scm
@@ -7,31 +7,33 @@
(define ii (make-string indent #\space))
(define iii (make-string (1+ indent) #\space))
- (define maxlen (find-max (hash-map->list
- (lambda (a _) (string-length (symbol->string a)))
- (properties vcomponent))))
+ (define maxlen (find-max (map
+ (lambda (a) (string-length (symbol->string a)))
+ (map car (properties vcomponent)))))
(format #t "~aBEGIN ~a~%" ii (type vcomponent))
- (hash-for-each (lambda (key values)
- (define (out vline)
- (format #t "~a~a = ~a"
- iii
- (trim-to-width (symbol->string key) maxlen)
- (trim-to-width
- (format #f "~a" (value vline))
- (- 80 indent maxlen)))
- (awhen (parameters vline)
- (display " ;")
- (for (key value) in it
- (format #t " ~a=~a" key value)))
- (newline))
- (if (list? values)
- (for-each out values)
- (out values)))
- (properties vcomponent))
+ (for-each (lambda (kv)
+ (let* ((key . values) kv)
+ (define (out vline)
+ (format #t "~a~a = ~a"
+ iii
+ (trim-to-width (symbol->string key) maxlen)
+ (trim-to-width
+ (format #f "~a" (value vline))
+ (- 80 indent maxlen)))
+ (awhen (parameters vline)
+ (display " ;")
+ (for (key value) in it
+ (format #t " ~a=~a" key value)))
+ (newline))
+ (if (list? values)
+ (for-each out values)
+ (out values))))
+ (properties vcomponent))
(for child in (children vcomponent)
+
(describe child (+ indent 2)))
(format #t "~aEND ~a~%" ii (type vcomponent)))