(in-package :web-user)
CL-XML: How To: Transform Documents
20031024
james anderson (c)2003,
Transformations
(defVar *dm*)
(setq *dm* (parse-document "file://xml/documentation/howto/howto.xml"))
(defun write-items-as-tables (doc)
(flet
((section-element-p (n) (eq (name n) '||::section))
(item-element-p (n) (eq (name n) '||::item)))
(let*
((root (root doc))
(sections (remove-if-not #'section-element-p (children root)))
(items
(reduce #'append
(mapcar
#'(lambda (section) (remove-if-not #'item-element-p (children section)))
sections))))
(xml (||::html (xmlns:|| "http://www.w3.org/1999/xhtml")) (xml ||::head)
(xml ||::body
(xml ||::table
(xml ||::tr
(dolist (a (attributes (first items)))
(xml ||::th (encode-node (name a))))
(dolist (c (children (first items)))
(xml ||::th (encode-node (name c)))))
(dolist (i items)
(xml ||::tr
(dolist (a (attributes i)) (xml ||::td (encode-node (value a))))
(dolist (c (children i))
(xml ||::td (encode-node (value-string c))))))))))))
(with-xml-writer (*trace-output*) (write-items-as-tables *dm*))
(defparameter *svg-dm*
(parse-document "file://xml/documentation/howto/shapes-line-01-t.svg"))
(defun write-items-as-tables (doc svg)
(flet
((section-element-p (n) (eq (name n) '||::section))
(item-element-p (n) (eq (name n) '||::item)))
(let*
((root (root doc))
(sections (remove-if-not #'section-element-p (children root)))
(items
(reduce #'append
(mapcar
#'(lambda (section) (remove-if-not #'item-element-p (children section)))
sections))))
(xml (||::html (xmlns:|| "http://www.w3.org/1999/xhtml")) (xml ||::head)
(xml ||::body
(xml ||::table
(xml ||::tr
(dolist (a (attributes (first items)))
(xml ||::th (encode-node (name a))))
(dolist (c (children (first items)))
(xml ||::th (encode-node (name c)))))
(dolist (i items)
(xml ||::tr
(dolist (a (attributes i)) (xml ||::td (encode-node (value a))))
(dolist (c (children i))
(xml ||::td (encode-node (value-string c)))))))
(xml ||::hr) (encode-node (root svg)))))))
(with-open-file
(stream "xml:documentation;howto;howto-svg.html" :direction :output :if-exists
:supersede :if-does-not-exist :create)
(with-xml-writer (stream) (write-items-as-tables *dm* *svg-dm*)))
:eof