weavejester · weavejester · Mar 29, 2016 · Dec 12, 2015
diff --git a/src/hiccup/compiler.clj b/src/hiccup/compiler.clj
@@ -1,7 +1,8 @@
 (ns hiccup.compiler
   "Internal functions for compilation."
   (:use hiccup.util)
-  (:import [clojure.lang IPersistentVector ISeq Named]))
+  (:import [clojure.lang IPersistentVector ISeq Named]
+           [hiccup.util RawString]))
 
 (defn- xml-mode? []
   (#{:xml :xhtml} *html-mode*))
@@ -86,12 +87,15 @@
   ISeq
   (render-html [this]
     (apply str (map render-html this)))
+  RawString
+  (render-html [this]
+    (str this))
   Named
   (render-html [this]
-    (name this))
+    (escape-html (name this)))
   Object
   (render-html [this]
-    (str this))
+    (escape-html (str this)))
   nil
   (render-html [this]
     ""))
@@ -237,8 +241,11 @@
   (doall (for [expr content]
            (cond
             (vector? expr) (compile-element expr)
-            (literal? expr) expr
-            (hint? expr String) expr
+            (string? expr) (escape-html expr)
+            (keyword? expr) (escape-html (name expr))
+            (raw-string? expr) expr
+            (literal? expr) (escape-html expr)
+            (hint? expr String) `(escape-html ~expr)
             (hint? expr Number) expr
             (seq? expr) (compile-form expr)
             :else `(#'render-html ~expr)))))

diff --git a/src/hiccup/core.clj b/src/hiccup/core.clj
@@ -10,8 +10,6 @@
   (if-let [mode (and (map? options) (:mode options))]
     (binding [*html-mode* mode]
       `(binding [*html-mode* ~mode]
-         ~(apply compile-html content)))
-    (apply compile-html options content)))
+         (raw-string ~(apply compile-html content))))
+    `(raw-string ~(apply compile-html options content))))
 
-(def ^{:doc "Alias for hiccup.util/escape-html"}
-  h escape-html)
diff --git a/src/hiccup/form.clj b/src/hiccup/form.clj
@@ -98,7 +98,7 @@
   ([name] (text-area name nil))
   ([name value]
     [:textarea {:name (make-name name), :id (make-id name)}
-      (escape-html value)]))
+      value]))
 
 (defelem file-upload
   "Creates a file upload input."

diff --git a/src/hiccup/page.clj b/src/hiccup/page.clj
@@ -6,16 +6,16 @@
 
 (def doctype
   {:html4
-   (str "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\" "
-        "\"http://www.w3.org/TR/html4/strict.dtd\">\n")
+   (raw-string "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\" "
+               "\"http://www.w3.org/TR/html4/strict.dtd\">\n")
    :xhtml-strict
-   (str "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" "
-        "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n")
+   (raw-string "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" "
+               "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n")
    :xhtml-transitional
-   (str "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" "
-        "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n")
+   (raw-string "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" "
+               "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n")
    :html5
-   "<!DOCTYPE html>\n"})
+   (raw-string "<!DOCTYPE html>\n")})
 
 (defelem xhtml-tag
   "Create an XHTML element for the specified language."
@@ -28,7 +28,7 @@
 (defn xml-declaration
   "Create a standard XML declaration for the following encoding."
   [encoding]
-  (str "<?xml version=\"1.0\" encoding=\"" encoding "\"?>\n"))
+  (raw-string "<?xml version=\"1.0\" encoding=\"" encoding "\"?>\n"))
 
 (defmacro html4
   "Create a HTML 4 document with the supplied contents. The first argument

diff --git a/src/hiccup/util.clj b/src/hiccup/util.clj
@@ -52,6 +52,24 @@
   String
   (to-uri [s] (URI. s)))
 
+(deftype RawString [^String s]
+  Object
+  (^String toString [this] s)
+  (^boolean equals [this other]
+    (and (instance? RawString other)
+         (= s  (.toString other)))))
+
+(defn raw-string
+  "Wraps a string to an object that will be pasted to HTML without escaping."
+  ([] (RawString. ""))
+  ([x] (RawString. x))
+  ([x & xs] (RawString. (apply str x xs))))
+
+(defn raw-string?
+  "Returns true if x is a RawString"
+  [x]
+  (instance? RawString x))
+
 (defn escape-html
   "Change special characters into HTML character entities."
   [text]

diff --git a/test/hiccup/test/core.clj b/test/hiccup/test/core.clj
@@ -1,110 +1,117 @@
 (ns hiccup.test.core
   (:use clojure.test
-        hiccup.core))
+        hiccup.core
+        hiccup.util))
+
+(deftest return-types
+  (testing "html returns a RawString"
+    (is (raw-string? (html [:div]))))
+  (testing "converting to string"
+    (= (str (html [:div])) "<div></div>")))
 
 (deftest tag-names
   (testing "basic tags"
-    (is (= (html [:div]) "<div></div>"))
-    (is (= (html ["div"]) "<div></div>"))
-    (is (= (html ['div]) "<div></div>")))
+    (is (= (str (html [:div])) "<div></div>"))
+    (is (= (str (html ["div"])) "<div></div>"))
+    (is (= (str (html ['div])) "<div></div>")))
   (testing "tag syntax sugar"
-    (is (= (html [:div#foo]) "<div id=\"foo\"></div>"))
-    (is (= (html [:div.foo]) "<div class=\"foo\"></div>"))
-    (is (= (html [:div.foo (str "bar" "baz")])
+    (is (= (str (html [:div#foo])) "<div id=\"foo\"></div>"))
+    (is (= (str (html [:div.foo])) "<div class=\"foo\"></div>"))
+    (is (= (str (html [:div.foo (str "bar" "baz")]))
            "<div class=\"foo\">barbaz</div>"))
-    (is (= (html [:div.a.b]) "<div class=\"a b\"></div>"))
-    (is (= (html [:div.a.b.c]) "<div class=\"a b c\"></div>"))
-    (is (= (html [:div#foo.bar.baz])
+    (is (= (str (html [:div.a.b])) "<div class=\"a b\"></div>"))
+    (is (= (str (html [:div.a.b.c])) "<div class=\"a b c\"></div>"))
+    (is (= (str (html [:div#foo.bar.baz]))
            "<div class=\"bar baz\" id=\"foo\"></div>"))))
 
 (deftest tag-contents
   (testing "empty tags"
-    (is (= (html [:div]) "<div></div>"))
-    (is (= (html [:h1]) "<h1></h1>"))
-    (is (= (html [:script]) "<script></script>"))
-    (is (= (html [:text]) "<text></text>"))
-    (is (= (html [:a]) "<a></a>"))
-    (is (= (html [:iframe]) "<iframe></iframe>"))
-    (is (= (html [:title]) "<title></title>"))
-    (is (= (html [:section]) "<section></section>"))
-    (is (= (html [:select]) "<select></select>"))
-    (is (= (html [:object]) "<object></object>"))
-    (is (= (html [:video]) "<video></video>")))
+    (is (= (str (html [:div])) "<div></div>"))
+    (is (= (str (html [:h1])) "<h1></h1>"))
+    (is (= (str (html [:script])) "<script></script>"))
+    (is (= (str (html [:text])) "<text></text>"))
+    (is (= (str (html [:a])) "<a></a>"))
+    (is (= (str (html [:iframe])) "<iframe></iframe>"))
+    (is (= (str (html [:title])) "<title></title>"))
+    (is (= (str (html [:section])) "<section></section>"))
+    (is (= (str (html [:select])) "<select></select>"))
+    (is (= (str (html [:object])) "<object></object>"))
+    (is (= (str (html [:video])) "<video></video>")))
   (testing "void tags"
-    (is (= (html [:br]) "<br />"))
-    (is (= (html [:link]) "<link />"))
-    (is (= (html [:colgroup {:span 2}]) "<colgroup span=\"2\"></colgroup>"))
-    (is (= (html [:colgroup [:col]]) "<colgroup><col /></colgroup>")))
+    (is (= (str (html [:br])) "<br />"))
+    (is (= (str (html [:link])) "<link />"))
+    (is (= (str (html [:colgroup {:span 2}])) "<colgroup span=\"2\"></colgroup>"))
+    (is (= (str (html [:colgroup [:col]])) "<colgroup><col /></colgroup>")))
   (testing "tags containing text"
-    (is (= (html [:text "Lorem Ipsum"]) "<text>Lorem Ipsum</text>")))
+    (is (= (str (html [:text "Lorem Ipsum"])) "<text>Lorem Ipsum</text>")))
   (testing "contents are concatenated"
-    (is (= (html [:body "foo" "bar"]) "<body>foobar</body>"))
-    (is (= (html [:body [:p] [:br]]) "<body><p></p><br /></body>")))
+    (is (= (str (html [:body "foo" "bar"])) "<body>foobar</body>"))
+    (is (= (str (html [:body [:p] [:br]])) "<body><p></p><br /></body>")))
   (testing "seqs are expanded"
-    (is (= (html [:body (list "foo" "bar")]) "<body>foobar</body>"))
-    (is (= (html (list [:p "a"] [:p "b"])) "<p>a</p><p>b</p>")))
+    (is (= (str (html [:body (list "foo" "bar")])) "<body>foobar</body>"))
+    (is (= (str (html (list [:p "a"] [:p "b"]))) "<p>a</p><p>b</p>")))
   (testing "keywords are turned into strings"
-    (is (= (html [:div :foo]) "<div>foo</div>")))
+    (is (= (str (html [:div :foo])) "<div>foo</div>")))
   (testing "vecs don't expand - error if vec doesn't have tag name"
     (is (thrown? IllegalArgumentException
                  (html (vector [:p "a"] [:p "b"])))))
   (testing "tags can contain tags"
-    (is (= (html [:div [:p]]) "<div><p></p></div>"))
-    (is (= (html [:div [:b]]) "<div><b></b></div>"))
-    (is (= (html [:p [:span [:a "foo"]]])
+    (is (= (str (html [:div [:p]])) "<div><p></p></div>"))
+    (is (= (str (html [:div [:b]])) "<div><b></b></div>"))
+    (is (= (str (html [:p [:span [:a "foo"]]]))
            "<p><span><a>foo</a></span></p>"))))
 
 (deftest tag-attributes
   (testing "tag with blank attribute map"
-    (is (= (html [:xml {}]) "<xml></xml>")))
+    (is (= (str (html [:xml {}])) "<xml></xml>")))
   (testing "tag with populated attribute map"
-    (is (= (html [:xml {:a "1", :b "2"}]) "<xml a=\"1\" b=\"2\"></xml>"))
-    (is (= (html [:img {"id" "foo"}]) "<img id=\"foo\" />"))
-    (is (= (html [:img {'id "foo"}]) "<img id=\"foo\" />"))
-    (is (= (html [:xml {:a "1", 'b "2", "c" "3"}])
+    (is (= (str (html [:xml {:a "1", :b "2"}])) "<xml a=\"1\" b=\"2\"></xml>"))
+    (is (= (str (html [:img {"id" "foo"}])) "<img id=\"foo\" />"))
+    (is (= (str (html [:img {'id "foo"}])) "<img id=\"foo\" />"))
+    (is (= (str (html [:xml {:a "1", 'b "2", "c" "3"}]))
            "<xml a=\"1\" b=\"2\" c=\"3\"></xml>")))
   (testing "attribute values are escaped"
-    (is (= (html [:div {:id "\""}]) "<div id=\"&quot;\"></div>")))
+    (is (= (str (html [:div {:id "\""}])) "<div id=\"&quot;\"></div>")))
   (testing "boolean attributes"
-    (is (= (html [:input {:type "checkbox" :checked true}])
+    (is (= (str (html [:input {:type "checkbox" :checked true}]))
            "<input checked=\"checked\" type=\"checkbox\" />"))
-    (is (= (html [:input {:type "checkbox" :checked false}])
+    (is (= (str (html [:input {:type "checkbox" :checked false}]))
            "<input type=\"checkbox\" />")))
   (testing "nil attributes"
-    (is (= (html [:span {:class nil} "foo"])
+    (is (= (str (html [:span {:class nil} "foo"]))
            "<span>foo</span>")))
   (testing "resolving conflicts between attributes in the map and tag"
-    (is (= (html [:div.foo {:class "bar"} "baz"])
+    (is (= (str (html [:div.foo {:class "bar"} "baz"]))
            "<div class=\"foo bar\">baz</div>"))
-    (is (= (html [:div#bar.foo {:id "baq"} "baz"])
+    (is (= (str (html [:div#bar.foo {:id "baq"} "baz"]))
            "<div class=\"foo\" id=\"baq\">baz</div>"))))
 
 (deftest compiled-tags
   (testing "tag content can be vars"
-    (is (= (let [x "foo"] (html [:span x])) "<span>foo</span>")))
+    (is (= (let [x "foo"] (str (html [:span x]))) "<span>foo</span>")))
   (testing "tag content can be forms"
-    (is (= (html [:span (str (+ 1 1))]) "<span>2</span>"))
-    (is (= (html [:span ({:foo "bar"} :foo)]) "<span>bar</span>")))
+    (is (= (str (html [:span (str (+ 1 1))])) "<span>2</span>"))
+    (is (= (str (html [:span ({:foo "bar"} :foo)])) "<span>bar</span>")))
   (testing "attributes can contain vars"
     (let [x "foo"]
-      (is (= (html [:xml {:x x}]) "<xml x=\"foo\"></xml>"))
-      (is (= (html [:xml {x "x"}]) "<xml foo=\"x\"></xml>"))
-      (is (= (html [:xml {:x x} "bar"]) "<xml x=\"foo\">bar</xml>"))))
+      (is (= (str (html [:xml {:x x}])) "<xml x=\"foo\"></xml>"))
+      (is (= (str (html [:xml {x "x"}])) "<xml foo=\"x\"></xml>"))
+      (is (= (str (html [:xml {:x x} "bar"])) "<xml x=\"foo\">bar</xml>"))))
   (testing "attributes are evaluated"
-    (is (= (html [:img {:src (str "/foo" "/bar")}])
+    (is (= (str (html [:img {:src (str "/foo" "/bar")}]))
            "<img src=\"/foo/bar\" />"))
-    (is (= (html [:div {:id (str "a" "b")} (str "foo")])
+    (is (= (str (html [:div {:id (str "a" "b")} (str "foo")]))
            "<div id=\"ab\">foo</div>")))
   (testing "type hints"
     (let [string "x"]
-      (is (= (html [:span ^String string]) "<span>x</span>"))))
+      (is (= (str (html [:span ^String string])) "<span>x</span>"))))
   (testing "optimized forms"
-    (is (= (html [:ul (for [n (range 3)]
-                        [:li n])])
+    (is (= (str (html [:ul (for [n (range 3)]
+                             [:li n])]))
            "<ul><li>0</li><li>1</li><li>2</li></ul>"))
-    (is (= (html [:div (if true
-                         [:span "foo"]
-                         [:span "bar"])])
+    (is (= (str (html [:div (if true
+                              [:span "foo"]
+                              [:span "bar"])]))
            "<div><span>foo</span></div>")))
   (testing "values are evaluated only once"
     (let [times-called (atom 0)
@@ -114,16 +121,50 @@
 
 (deftest render-modes
   (testing "closed tag"
-    (is (= (html [:p] [:br]) "<p></p><br />"))
-    (is (= (html {:mode :xhtml} [:p] [:br]) "<p></p><br />"))
-    (is (= (html {:mode :html} [:p] [:br]) "<p></p><br>"))
-    (is (= (html {:mode :xml} [:p] [:br]) "<p /><br />"))
-    (is (= (html {:mode :sgml} [:p] [:br]) "<p><br>")))
+    (is (= (str (html [:p] [:br])) "<p></p><br />"))
+    (is (= (str (html {:mode :xhtml} [:p] [:br])) "<p></p><br />"))
+    (is (= (str (html {:mode :html} [:p] [:br])) "<p></p><br>"))
+    (is (= (str (html {:mode :xml} [:p] [:br])) "<p /><br />"))
+    (is (= (str (html {:mode :sgml} [:p] [:br])) "<p><br>")))
   (testing "boolean attributes"
-    (is (= (html {:mode :xml} [:input {:type "checkbox" :checked true}])
+    (is (= (str (html {:mode :xml} [:input {:type "checkbox" :checked true}]))
            "<input checked=\"checked\" type=\"checkbox\" />"))
-    (is (= (html {:mode :sgml} [:input {:type "checkbox" :checked true}])
+    (is (= (str (html {:mode :sgml} [:input {:type "checkbox" :checked true}]))
            "<input checked type=\"checkbox\">")))
   (testing "laziness and binding scope"
-    (is (= (html {:mode :sgml} [:html [:link] (list [:link])])
+    (is (= (str (html {:mode :sgml} [:html [:link] (list [:link])]))
            "<html><link><link></html>"))))
+
+(deftest auto-escaping
+  (testing "literals"
+    (is (= (str (html "<>")) "&lt;&gt;"))
+    (is (= (str (html :<>)) "&lt;&gt;"))
+    (is (= (str (html ^String (str "<>"))) "&lt;&gt;"))
+    (is (= (str (html {"<foo>" "<bar>"})) "{&quot;&lt;foo&gt;&quot; &quot;&lt;bar&gt;&quot;}"))
+    (is (= (str (html #{"<>"})) "#{&quot;&lt;&gt;&quot;}"))
+    (is (= (str (html 1)) "1"))
+    (is (= (str (html ^Number (+ 1 1))) "2")))
+  (testing "non-literals"
+    (is (= (str (html (list [:p "<foo>"] [:p "<bar>"])))
+           "<p>&lt;foo&gt;</p><p>&lt;bar&gt;</p>"))
+    (is (= (str (html ((constantly "<foo>")))) "&lt;foo&gt;"))
+    (is (= (let [x "<foo>"] (str (html x))) "&lt;foo&gt;")))
+  (testing "optimized forms"
+    (is (= (str (html (if true :<foo> :<bar>))) "&lt;foo&gt;"))
+    (is (= (str (html (for [x [:<foo>]] x))) "&lt;foo&gt;")))
+  (testing "elements"
+    (is (= (str (html [:p "<>"])) "<p>&lt;&gt;</p>"))
+    (is (= (str (html [:p :<>])) "<p>&lt;&gt;</p>"))
+    (is (= (str (html [:p {} {"<foo>" "<bar>"}]))
+           "<p>{&quot;&lt;foo&gt;&quot; &quot;&lt;bar&gt;&quot;}</p>"))
+    (is (= (str (html [:p {} #{"<foo>"}]))
+           "<p>#{&quot;&lt;foo&gt;&quot;}</p>"))
+    (is (= (str (html [:p {:class "<\">"}]))
+           "<p class=\"&lt;&quot;&gt;\"></p>"))
+    (is (= (str (html [:ul [:li "<foo>"]]))
+           "<ul><li>&lt;foo&gt;</li></ul>")))
+  (testing "raw strings"
+    (is (= (str (html (raw-string "<foo>"))) "<foo>"))
+    (is (= (str (html [:p (raw-string "<foo>")])) "<p><foo></p>"))
+    (is (= (str (html (html [:p "<>"]))) "<p>&lt;&gt;</p>"))
+    (is (= (str (html [:ul (html [:li "<>"])])) "<ul><li>&lt;&gt;</li></ul>"))))
diff --git a/test/hiccup/test/def.clj b/test/hiccup/test/def.clj
@@ -5,13 +5,13 @@
 (deftest test-defhtml
   (testing "basic html function"
     (defhtml basic-fn [x] [:span x])
-    (is (= (basic-fn "foo") "<span>foo</span>")))
+    (is (= (str (basic-fn "foo")) "<span>foo</span>")))
   (testing "html function with overloads"
     (defhtml overloaded-fn
       ([x] [:span x])
       ([x y] [:span x [:div y]]))
-    (is (= (overloaded-fn "foo") "<span>foo</span>"))
-    (is (= (overloaded-fn "foo" "bar")
+    (is (= (str (overloaded-fn "foo")) "<span>foo</span>"))
+    (is (= (str (overloaded-fn "foo" "bar"))
            "<span>foo<div>bar</div></span>"))))
 
 (deftest test-defelem