Multi-valued TEXT fields now always lists.

2 files changed, 7 insertions, 10 deletions

diff --git a/module/vcomponent/parse/component.scm b/module/vcomponent/parse/component.scm
index 690c0698..69b833dd 100644
--- a/module/vcomponent/parse/component.scm
+++ b/module/vcomponent/parse/component.scm
@@ -92,7 +92,7 @@
            (string-split value #\,)))))
 
 (define* (enum-parser enum optional: allow-other)
-  (let ((parser (get-parser 'TEXT)))
+  (let ((parser (compose car (get-parser 'TEXT))))
     (lambda (params value)
       (let ((vv (parser params value)))
         (when (list? vv)
@@ -130,9 +130,9 @@
                              CONTACT RELATED-TO UID))
            (lambda (params value)
              (let ((v ((get-parser 'TEXT) params value)))
-               (when (list? v)
+               (unless (= 1 (length v))
                  (warning "List in non-list field: ~s" v))
-               v))]
+               (car v)))]
 
           ;; TEXT, but allow a list
           [(memv key '(CATEGORIES RESOURCES))
@@ -140,7 +140,7 @@
 
           [(memv key '(VERSION))
            (lambda (params value)
-             (let ((v ((get-parser 'TEXT) params value)))
+             (let ((v (car ((get-parser 'TEXT) params value))))
                (unless (and (string? v) (string=? "2.0" v))
                  (warning "File of unsuported version. Proceed with caution"))))]
 
@@ -197,11 +197,11 @@
            (get-parser 'CAL-ADDRESS)]
 
           [(x-property? key)
-           (get-parser 'TEXT)]
+           (compose car (get-parser 'TEXT))]
 
           [else
            (warning "Unknown key ~a" key)
-           (get-parser 'TEXT)])))
+           (compose car (get-parser 'TEXT))])))
 
     ;; If we produced a list create multiple VLINES from it.
     ;; NOTE that the created vlines share parameter tables.
diff --git a/module/vcomponent/parse/types.scm b/module/vcomponent/parse/types.scm
index 3cd7dd29..7e4df6b7 100644
--- a/module/vcomponent/parse/types.scm
+++ b/module/vcomponent/parse/types.scm
@@ -79,10 +79,7 @@
              (str '())
              (done '()))
     (if (null? rem)
-        (let ((final (reverse-list->string str)))
-         (if (null? done)
-             final
-             (cons final done)))
+        (cons (reverse-list->string str) done)
         (case (car rem)
           [(#\\)
            (case (cadr rem)