bug#20339: sxml simple: sxml->xml mishandles namespaces?

[Ricardo Wurmus]

>> Since xml->sxml accepts a namespace alist I suppose it would make sense
>> to extend sxml->xml to do the same.

Attached is a minimal patch to extend "sxml->xml" such that it accepts an
optional keyword argument "namespaces" with an alist of prefixes to
URLs, analogous to "xml->sxml".

When the namespaces alist is provided, "xmlns:prefix=url" attributes are
prepended to the element's list of attributes.


    ;; Define SVG document with namespaces
    (define the-svg "<svg xmlns='http://www.w3.org/2000/svg'
       xmlns:xlink='http://www.w3.org/1999/xlink'>
    <rect x='5' y='5' width='20' height='20'
          stroke-width='2' stroke='purple' fill='yellow'
          id='rect1' />
    <rect x='30' y='5' width='20' height='20'
          ry='5' rx='8' stroke-width='2' stroke='purple' fill='blue'
          xlink:href='#rect1' />
    </svg>")

    ;; Define alist of namespaces
    (define ns '((svg . "http://www.w3.org/2000/svg";)
                 (xlink . "http://www.w3.org/1999/xlink";)))

    ;; Convert to SXML, abbreviate namespaces according to ns alist
    (define the-sxml (xml->sxml the-svg #:namespaces ns))

    ;; Convert back to XML
    (sxml->xml the-sxml #:namespaces ns)

    => <svg:svg xmlns:svg="http://www.w3.org/2000/svg";
                xmlns:xlink="http://www.w3.org/1999/xlink";>
         <svg:rect y="5" x="5"
                   width="20"
                   stroke-width="2"
                   stroke="purple"
                   id="rect1"
                   height="20"
                   fill="yellow" />
         <svg:rect xlink:href="#rect1"
                   y="5" x="30"
                   width="20"
                   stroke-width="2"
                   stroke="purple"
                   ry="5" rx="8"
                   height="20"
                   fill="blue" />
       </svg:svg>

Does this do what you want?

~~ Ricardo

>From 81fa92ad0c5537c41419fa1e55c6130bf0558c9f Mon Sep 17 00:00:00 2001
From: rekado <address@hidden>
Date: Wed, 22 Apr 2015 13:09:27 +0200
Subject: [PATCH] Write XML namespaces when serializing.

* module/sxml/simple.scm (sxml->xml): Add optional keyword argument
  "namespaces".
---
 module/sxml/simple.scm | 17 ++++++++++++-----
 1 file changed, 12 insertions(+), 5 deletions(-)

diff --git a/module/sxml/simple.scm b/module/sxml/simple.scm
index 703ad91..8cc20dd 100644
--- a/module/sxml/simple.scm
+++ b/module/sxml/simple.scm
@@ -311,7 +311,8 @@ port."
   (display str port)
   (display "?>" port))
 
-(define* (sxml->xml tree #:optional (port (current-output-port)))
+(define* (sxml->xml tree #:optional (port (current-output-port)) #:key
+                    (namespaces '()))
   "Serialize the sxml tree @var{tree} as XML. The output will be written
 to the current output port, unless the optional argument @var{port} is
 present."
@@ -322,7 +323,7 @@ present."
         (let ((tag (car tree)))
           (case tag
             ((*TOP*)
-             (sxml->xml (cdr tree) port))
+             (sxml->xml (cdr tree) port #:namespaces namespaces))
             ((*ENTITY*)
              (if (and (list? (cdr tree)) (= (length (cdr tree)) 1))
                  (entity->xml (cadr tree) port)
@@ -335,10 +336,16 @@ present."
              (let* ((elems (cdr tree))
                     (attrs (and (pair? elems) (pair? (car elems))
                                 (eq? '@ (caar elems))
-                                (cdar elems))))
-               (element->xml tag attrs (if attrs (cdr elems) elems) port)))))
+                                (cdar elems)))
+                    (xmlns (map (lambda (x)
+                                  (cons (symbol-append 'xmlns: (car x))
+                                        (cdr x)))
+                                namespaces)))
+               (element->xml tag
+                             (if attrs (append xmlns attrs) xmlns)
+                             (if attrs (cdr elems) elems) port)))))
         ;; A nodelist.
-        (for-each (lambda (x) (sxml->xml x port)) tree)))
+        (for-each (lambda (x) (sxml->xml x port #:namespaces namespaces)) 
tree)))
    ((string? tree)
     (string->escaped-xml tree port))
    ((null? tree) *unspecified*)
-- 
2.1.0