>> 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 <rek...@elephly.net>
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
