Code: Select all
(define (sxml-xml:sxml-xml))
(context 'sxml-xml)
(define (indent)
(write-buffer sxml-xml:buff (dup { } (* level 2))))
(define (newline)
(if-not prev-char-newline (write-buffer sxml-xml:buff "\n"))
(set 'prev-char-newline true))
(define (sxml-xml expr (level 0))
(if (not sxml-xml:buff)
(set 'sxml-xml:buff {&?xml version="1.0"?>}))
(cond
((or (atom? expr) (quote? expr))
(write-buffer sxml-xml:buff expr)
(set 'prev-char-newline nil)
(set 'prev-atom true))
((list? (first expr))
(sxml-xml (first expr) (+ level 1))
(dolist (s (rest expr))
(sxml-xml s (+ level 1))))
((symbol? (first expr))
(newline)
(indent)
(write-buffer sxml-xml:buff (string "<" (sym (first expr)) ">"))
(set 'prev-char-newline nil)
(dolist (s (rest expr))
(sxml-xml s (+ level 1)))
(if prev-atom "" (indent))
(write-buffer sxml-xml:buff (string "</" (sym (first expr)) ">"))
(set 'prev-char-newline nil)
(newline)
(set 'prev-atom nil))
(true
(indent)
(println "<error>" (string expr) "<error>"))))
(context MAIN)
(xml-type-tags nil)
; some sample xml to process
(set 'xml-sample (xml-parse [text]<?xml version="1.0"?>
<methodResponse>
<params>
<param>
<value>
<array>
<data>
<value>
<struct>
<member>
<name>description name 1</name>
<value>description value 1</value>
</member>
<member>
<name>title name 1</name>
<value>title value 1</value>
</member>
</struct>
</value>
</data>
</array>
</value>
</param>
</params>
</methodResponse>
[/text] 15))
(sxml-xml xml-sample)
(println sxml-xml:buff)
Code: Select all
<struct>
<sxml-xml:member>
<sxml-xml:name>description name 1</sxml-xml:name>
<value>description value 1</value>
</sxml-xml:member>
<sxml-xml:member>
<sxml-xml:name>title name 1</sxml-xml:name>
<value>title value 1</value>
</sxml-xml:member>
</struct>