From d74deac624de47c672e81c33db5fc39f244ec0ca Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Fri, 17 Jul 2020 23:58:20 +0200
Subject: Properties now return alist instead of hashmap.

---
 module/output/ical.scm         | 10 ++++-----
 module/output/xcal.scm         | 46 ++++++++++++++++++++----------------------
 module/vcomponent/base.scm     |  4 ++--
 module/vcomponent/describe.scm | 42 ++++++++++++++++++++------------------
 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)))
-- 
cgit v1.2.3