From 81fa92ad0c5537c41419fa1e55c6130bf0558c9f Mon Sep 17 00:00:00 2001 From: rekado 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