1 files changed, 170 insertions, 0 deletions
diff --git a/modules/prxml/src/main/clojure/clojure/contrib/prxml.clj b/modules/prxml/src/main/clojure/clojure/contrib/prxml.clj
new file mode 100644
index 00000000..2c2ec761
--- /dev/null
+++ b/modules/prxml/src/main/clojure/clojure/contrib/prxml.clj
@@ -0,0 +1,170 @@
+;;; prxml.clj -- compact syntax for generating XML
+
+;; by Stuart Sierra, http://stuartsierra.com/
+;; 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 (http://opensource.org/licenses/eclipse-1.0.php)
+;; 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.
+
+
+(ns 
+  ^{:author "Stuart Sierra",
+     :doc "Compact syntax for generating XML. See the documentation of \"prxml\" 
+for details."}
+  clojure.contrib.prxml
+  (:use [clojure.contrib.string :only (escape as-str)]))
+
+(def
+ ^{:doc "If true, empty tags will have a space before the closing />"}
+ *html-compatible* false)
+
+(def
+ ^{: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 {\< "&lt;"
+           \> "&gt;"
+           \& "&amp;"
+           \' "&apos;"
+           \" "&quot;"} s))
+
+(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"}
+                     attrs)]
+    ;; 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*
+      (newline)
+      (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*
+                (newline)
+                (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)))