From 00a66eca0f32fcf585d2c21375641020e877e3ea Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Wed, 13 Dec 2023 11:06:57 +0100
Subject: Update things depending on namespaced sxml.

Update all code to emit correctly formed namespaced sxml objects,
instead of the old list based approach.

Also introduces a number of typechecks which in semi-related parts of
the code.

Note that the webdav-server test is currently broken.
---
 module/vcomponent/formats/xcal/output.scm | 94 +++++++++++++++----------------
 1 file changed, 47 insertions(+), 47 deletions(-)

(limited to 'module/vcomponent/formats/xcal/output.scm')

diff --git a/module/vcomponent/formats/xcal/output.scm b/module/vcomponent/formats/xcal/output.scm
index a5f8a934..f0c11a4e 100644
--- a/module/vcomponent/formats/xcal/output.scm
+++ b/module/vcomponent/formats/xcal/output.scm
@@ -59,9 +59,10 @@
 
     [(memv k '(GEO))
      (lambda (_ v)
-       `(,(xml xcal 'geo)
-         (latitude ,(geo-latitude v))
-         (longitude ,(geo-longitude v))))]
+       ((xml xcal 'geo)
+        (list
+         ((xml xcal 'latitude)  (geo-latitude v))
+         ((xml xcal 'longitude) (geo-longitude v)))))]
 
     [(memv k '(RRULE))
      (get-writer 'RECUR)]
@@ -84,60 +85,59 @@
   (if (or (eq? tag 'VALUE)
           (internal-field? tag))
       #f
-      `(,(xml xcal (downcase-symbol tag))
-        ,@(map (lambda (v)
-                 ;; TODO parameter types!!!! (rfc6321 3.5.)
-                 `(,(xml xcal 'text) ,(->string v)))
-               value))))
+      (apply (xml xcal (downcase-symbol tag))
+             (map (lambda (v)
+                    ;; TODO parameter types!!!! (rfc6321 3.5.)
+                    ((xml xcal 'text) (->string v)))
+                  value))))
 
-;; ((key value ...) ...) -> `(parameters , ... )
+;; ((key value ...) ...) -> #<xml parameters>
 (define (parameters-tag parameters)
   (define outparams (filter-map
                      (lambda (x) (property->value-tag x))
                      parameters))
 
-  (unless (null? outparams)
-    `(,(xml xcal 'parameters) ,@outparams)))
+  (apply (xml xcal 'parameters) outparams))
 
 (define (vcomponent->sxcal component)
 
   (define tagsymb (downcase-symbol (type component)))
 
-  (remove null?
-   `(,(xml xcal tagsymb)
-     ;; only have <properties> when it's non-empty.
-     ,(let ((props
-             (filter-map
-              (match-lambda
-                [(? (compose internal-field? car)) #f]
-
-                [(key (vlines ...))
-                 (remove null?
-                         `(,(xml xcal (downcase-symbol key))
-                           ,(parameters-tag (reduce assq-merge
-                                                    '()
-                                                    (map parameters vlines)))
-                           ,@(for vline in vlines
-                                  (vline->value-tag vline))))]
-
-                [(key vline)
-                 (remove null?
-                         `(,(xml xcal (downcase-symbol key))
-                           ,(parameters-tag (parameters vline))
-                           ,(vline->value-tag vline)))])
-              ;; NOTE this sort is unnecesasary, but here so tests can work
-              ;; Possibly add it as a flag instead
-              (sort* (properties component)
-                     string< (compose symbol->string car)))))
-        (unless (null? props)
-          `(,(xml xcal 'properties)
-            ;; NOTE
-            ;; (x-hnh-calendar-name (text ,(prop (parent component) 'NAME)))
-            ,@props)))
-     ,(unless (null? (children component))
-        `(,(xml xcal 'components)
-          ,@(map vcomponent->sxcal (children component)))))))
+  (apply (xml xcal tagsymb)
+         (remove (compose null? xml-element-children)
+                 ;; only have <properties> when it's non-empty.
+                 (list
+                  (let ((props
+                         (filter-map
+                          (match-lambda
+                            [(? (compose internal-field? car)) #f]
+
+                            [(key (vlines ...))
+                             (apply (xml xcal (downcase-symbol key))
+                                    (remove (compose null? xml-element-children)
+                                            (cons
+                                             (parameters-tag (reduce assq-merge
+                                                                     '()
+                                                                     (map parameters vlines)))
+                                             (map vline->value-tag vlines))))]
+
+                            [(key vline)
+                             (apply (xml xcal (downcase-symbol key))
+                                    (remove (compose null? xml-element-children)
+                                            (list
+                                             (parameters-tag (parameters vline))
+                                             (vline->value-tag vline))))])
+                          ;; NOTE this sort is unnecesasary, but here so tests can work
+                          ;; Possibly add it as a flag instead
+                          (sort* (properties component)
+                                 string< (compose symbol->string car)))))
+                    (apply (xml xcal 'properties)
+                           ;; NOTE
+                           ;; (x-hnh-calendar-name (text ,(prop (parent component) 'NAME)))
+                           props))
+                  (apply (xml xcal 'components)
+                         (map vcomponent->sxcal (children component)))))))
 
 (define (ns-wrap sxml)
-  `(,(xml xcal 'icalendar)
-    ,sxml))
+  ((xml xcal 'icalendar)
+   sxml))
-- 
cgit v1.2.3