Fetching contributors…
Cannot retrieve contributors at this time
177 lines (138 sloc) 5.06 KB
;;; prxml.clj -- compact syntax for generating XML
;; by Stuart Sierra,
;; March 29, 2009
;; Copyright (c) 2009 Stuart Sierra. All rights reserved. The use and
;; distribution terms for this software are covered by the Eclipse
;; Public License 1.0 (
;; which can be found in the file epl-v10.html at the root of this
;; distribution. By using this software in any fashion, you are
;; agreeing to be bound by the terms of this license. You must not
;; remove this notice, or any other, from this software.
;; Change Log
;; March 29, 2009: added *prxml-indent*
;; January 4, 2009: initial version
;; See function "prxml" at the bottom of this file for documentation.
^{:author "Stuart Sierra",
:doc "Compact syntax for generating XML. See the documentation of \"prxml\"
for details."}
(:use [clojure.string :only (escape)]))
^{:doc "If true, empty tags will have a space before the closing />"}
*html-compatible* false)
^{:doc "The number of spaces to indent sub-tags. nil for no indent
and no extra line-breaks."}
*prxml-indent* nil)
(def ^{:private true} *prxml-tag-depth* 0)
(def ^{:private true} print-xml) ; forward declaration
(defn- escape-xml [s]
(escape s {\< "&lt;"
\> "&gt;"
\& "&amp;"
\' "&apos;"
\" "&quot;"}))
(defn- as-str
(if (instance? clojure.lang.Named x)
(name x)
(str x)))
(defn- prxml-attribute [name value]
(print " ")
(print (as-str name))
(print "=\"")
(print (escape-xml (str value)))
(print "\""))
(defmulti ^{:private true} print-xml-tag (fn [tag attrs content] tag))
(defmethod print-xml-tag :raw! [tag attrs contents]
(doseq [c contents] (print c)))
(defmethod print-xml-tag :comment! [tag attrs contents]
(print "<!-- ")
(doseq [c contents] (print c))
(print " -->"))
(defmethod print-xml-tag :decl! [tag attrs contents]
(let [attrs (merge {:version "1.0" :encoding "UTF-8"}
;; Must enforce ordering of pseudo-attributes:
(print "<?xml version=\"")
(print (:version attrs))
(print "\" encoding=\"")
(print (:encoding attrs))
(print "\"")
(when (:standalone attrs)
(print " standalone=\"")
(print (:standalone attrs))
(print "\""))
(print "?>")))
(defmethod print-xml-tag :cdata! [tag attrs contents]
(print "<![CDATA[")
(doseq [c contents] (print c))
(print "]]>"))
(defmethod print-xml-tag :doctype! [tag attrs contents]
(print "<!DOCTYPE ")
(doseq [c contents] (print c))
(print ">"))
(defmethod print-xml-tag :default [tag attrs contents]
(let [tag-name (as-str tag)]
(when *prxml-indent*
(dotimes [n (* *prxml-tag-depth* *prxml-indent*)] (print " ")))
(print "<")
(print tag-name)
(doseq [[name value] attrs]
(prxml-attribute name value))
(if (seq contents)
(do ;; not an empty tag
(print ">")
(if (every? string? contents)
;; tag only contains strings:
(do (doseq [c contents] (print-xml c))
(print "</") (print tag-name) (print ">"))
;; tag contains sub-tags:
(do (binding [*prxml-tag-depth* (inc *prxml-tag-depth*)]
(doseq [c contents] (print-xml c)))
(when *prxml-indent*
(dotimes [n (* *prxml-tag-depth* *prxml-indent*)] (print " ")))
(print "</") (print tag-name) (print ">"))))
;; empty tag:
(print (if *html-compatible* " />" "/>")))))
(defmulti ^{:private true} print-xml class)
(defmethod print-xml clojure.lang.IPersistentVector [x]
(let [[tag & contents] x
[attrs content] (if (map? (first contents))
[(first contents) (rest contents)]
[{} contents])]
(print-xml-tag tag attrs content)))
(defmethod print-xml clojure.lang.ISeq [x]
;; Recurse into sequences, so we can use (map ...) inside prxml.
(doseq [c x] (print-xml c)))
(defmethod print-xml clojure.lang.Keyword [x]
(print-xml-tag x {} nil))
(defmethod print-xml String [x]
(print (escape-xml x)))
(defmethod print-xml nil [x])
(defmethod print-xml :default [x]
(print x))
(defn prxml
"Print XML to *out*. Vectors become XML tags: the first item is the
tag name; optional second item is a map of attributes.
Sequences are processed recursively, so you can use map and other
sequence functions inside prxml.
(prxml [:p {:class \"greet\"} [:i \"Ladies & gentlemen\"]])
; => <p class=\"greet\"><i>Ladies &amp; gentlemen</i></p>
PSEUDO-TAGS: some keywords have special meaning:
:raw! do not XML-escape contents
:comment! create an XML comment
:decl! create an XML declaration, with attributes
:cdata! create a CDATA section
:doctype! create a DOCTYPE!
(prxml [:p [:raw! \"<i>here & gone</i>\"]])
; => <p><i>here & gone</i></p>
(prxml [:decl! {:version \"1.1\"}])
; => <?xml version=\"1.1\" encoding=\"UTF-8\"?>"
[& args]
(doseq [arg args] (print-xml arg)))