├── deps.edn ├── .clj-kondo └── config.edn ├── resources └── clj-kondo.exports │ └── hiccup │ └── hiccup │ ├── config.edn │ └── hiccup │ └── hooks.clj ├── .gitignore ├── src ├── hiccup │ ├── middleware.clj │ ├── core.clj │ ├── element.clj │ ├── def.clj │ ├── page.clj │ ├── util.clj │ ├── form.clj │ └── compiler.clj └── hiccup2 │ └── core.clj ├── test ├── hiccup │ ├── middleware_test.clj │ ├── element_test.clj │ ├── def_test.clj │ ├── util_test.clj │ ├── page_test.clj │ ├── compiler_test.clj │ ├── core_test.clj │ └── form_test.clj └── hiccup2 │ ├── optimizations_test.clj │ └── core_test.clj ├── .github └── workflows │ └── test.yml ├── project.clj ├── CONTRIBUTING.md ├── CHANGELOG.md ├── doc └── syntax.md ├── README.md └── LICENSE.txt /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src" "resources"] 2 | :deps {org.clojure/clojure {:mvn/version "1.7.0"}}} 3 | -------------------------------------------------------------------------------- /.clj-kondo/config.edn: -------------------------------------------------------------------------------- 1 | {:config-paths ["../resources/clj-kondo.exports/hiccup/hiccup"] 2 | :ignore [:deprecated-var :deprecated-namespace]} 3 | -------------------------------------------------------------------------------- /resources/clj-kondo.exports/hiccup/hiccup/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as {hiccup.def/defhtml clojure.core/defn} 2 | :hooks {:analyze-call {hiccup.def/defelem hiccup.hooks/defelem}}} 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /codox 4 | /classes 5 | /checkouts 6 | pom.xml 7 | pom.xml.asc 8 | *.jar 9 | *.class 10 | .lein-* 11 | .nrepl-port 12 | .clj-kondo/* 13 | !.clj-kondo/config.edn 14 | /.cpcache 15 | -------------------------------------------------------------------------------- /src/hiccup/middleware.clj: -------------------------------------------------------------------------------- 1 | (ns hiccup.middleware 2 | "Ring middleware functions for Hiccup." 3 | (:require [hiccup.util :as util])) 4 | 5 | (defn wrap-base-url 6 | "Ring middleware that wraps the handler in the [[with-base-url]] function. 7 | The base URL may be specified as an argument. Otherwise, the `:context` key 8 | on the request map is used." 9 | ([handler] 10 | (wrap-base-url handler nil)) 11 | ([handler base-url] 12 | (fn [request] 13 | (util/with-base-url (or base-url (:context request)) 14 | (handler request))))) 15 | -------------------------------------------------------------------------------- /test/hiccup/middleware_test.clj: -------------------------------------------------------------------------------- 1 | (ns hiccup.middleware_test 2 | (:require [clojure.test :refer :all] 3 | [hiccup.core :refer [html]] 4 | [hiccup.element :refer [link-to]] 5 | [hiccup.middleware :refer :all])) 6 | 7 | (defn test-handler [request] 8 | {:status 200 9 | :headers {"Content-Type" "text/html"} 10 | :body (html [:html [:body (link-to "/bar" "bar")]])}) 11 | 12 | (deftest test-wrap-base-url 13 | (let [resp ((wrap-base-url test-handler "/foo") {})] 14 | (is (= (:body resp) 15 | "bar")))) 16 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: Tests 2 | on: [push, pull_request] 3 | jobs: 4 | test: 5 | runs-on: ubuntu-latest 6 | steps: 7 | - name: Checkout 8 | uses: actions/checkout@v3 9 | 10 | - name: Prepare java 11 | uses: actions/setup-java@v3 12 | with: 13 | distribution: 'zulu' 14 | java-version: '8' 15 | 16 | - name: Install clojure tools 17 | uses: DeLaGuardo/setup-clojure@10.1 18 | with: 19 | lein: 2.9.10 20 | 21 | - name: Cache clojure dependencies 22 | uses: actions/cache@v3 23 | with: 24 | path: ~/.m2/repository 25 | key: cljdeps-${{ hashFiles('project.clj') }} 26 | restore-keys: cljdeps- 27 | 28 | - name: Run tests 29 | run: lein test-all 30 | -------------------------------------------------------------------------------- /src/hiccup/core.clj: -------------------------------------------------------------------------------- 1 | (ns hiccup.core 2 | "Library for rendering a tree of vectors into a string of HTML. 3 | Pre-compiles where possible for performance." 4 | {:deprecated "2.0"} 5 | (:require [hiccup2.core :as hiccup2] 6 | [hiccup.util :as util])) 7 | 8 | (defmacro html 9 | "Render Clojure data structures to a string of HTML. Strings are **not** 10 | automatically escaped, but must be manually escaped with the [[h]] function. 11 | 12 | A literal option map may be specified as the first argument. It accepts the 13 | following keys: 14 | 15 | `:mode` 16 | : One of `:html`, `:xhtml`, `:xml` or `:sgml` (defaults to `:xhtml`). 17 | Controls how tags are rendered." 18 | {:deprecated "2.0"} 19 | [options & content] 20 | (if (map? options) 21 | `(str (hiccup2/html ~(assoc options :escape-strings? false) ~@content)) 22 | `(str (hiccup2/html {:escape-strings? false} ~options ~@content)))) 23 | 24 | (def ^{:deprecated 2.0} h 25 | "Escape strings within the [[html]] macro." 26 | util/escape-html) 27 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject hiccup "2.0.0" 2 | :description "A fast library for rendering HTML in Clojure" 3 | :url "http://github.com/weavejester/hiccup" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.7.0"]] 7 | :plugins [[lein-codox "0.10.8"]] 8 | :codox 9 | {:output-path "codox" 10 | :source-uri "http://github.com/weavejester/hiccup/blob/{version}/{filepath}#L{line}" 11 | :namespaces [#"^hiccup2?\.(?!compiler)"] 12 | :metadata {:doc/format :markdown}} 13 | :aliases 14 | {"test-all" ["with-profile" "default:+1.8:+1.9:+1.10:+1.11:+1.12" "test"]} 15 | :profiles 16 | {:dev {:dependencies [[criterium "0.4.4"]]} 17 | :1.8 {:dependencies [[org.clojure/clojure "1.8.0"]]} 18 | :1.9 {:dependencies [[org.clojure/clojure "1.9.0"]]} 19 | :1.10 {:dependencies [[org.clojure/clojure "1.10.3"]]} 20 | :1.11 {:dependencies [[org.clojure/clojure "1.11.4"]]} 21 | :1.12 {:dependencies [[org.clojure/clojure "1.12.1"]]}} 22 | :global-vars {*warn-on-reflection* true}) 23 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing Guidelines 2 | 3 | **Do** follow [the seven rules of a great Git commit message][1]. 4 | 5 | **Do** follow [the Clojure Style Guide][2]. 6 | 7 | **Do** include tests for your change when appropriate. 8 | 9 | **Do** ensure that the CI checks pass. 10 | 11 | **Do** squash the commits in your PR to remove corrections 12 | irrelevant to the code history, once the PR has been reviewed. 13 | 14 | **Do** feel free to pester the project maintainers about the PR if it 15 | hasn't been responded to. Sometimes notifications can be missed. 16 | 17 | **Don't** include more than one feature or fix in a single PR. 18 | 19 | **Don't** include changes unrelated to the purpose of the PR. This 20 | includes changing the project version number, adding lines to the 21 | `.gitignore` file, or changing the indentation or formatting. 22 | 23 | **Don't** open a new PR if changes are requested. Just push to the 24 | same branch and the PR will be updated. 25 | 26 | **Don't** overuse vertical whitespace; avoid multiple sequential blank 27 | lines. 28 | 29 | **Don't** docstring private vars or functions. 30 | 31 | [1]: https://chris.beams.io/posts/git-commit/#seven-rules 32 | [2]: https://github.com/bbatsov/clojure-style-guide 33 | -------------------------------------------------------------------------------- /src/hiccup/element.clj: -------------------------------------------------------------------------------- 1 | (ns hiccup.element 2 | "Functions for creating generic HTML elements." 3 | (:require [hiccup.def :refer [defelem]] 4 | [hiccup.util :as util])) 5 | 6 | (defn javascript-tag 7 | "Wrap the supplied javascript up in script tags and a CDATA section." 8 | [script] 9 | [:script {:type "text/javascript"} 10 | (str "//")]) 11 | 12 | (defelem link-to 13 | "Wraps some content in a HTML hyperlink with the supplied URL." 14 | [url & content] 15 | [:a {:href (util/to-uri url)} content]) 16 | 17 | (defelem mail-to 18 | "Wraps some content in a HTML hyperlink with the supplied e-mail 19 | address. If no content provided use the e-mail address as content." 20 | [e-mail & content] 21 | [:a {:href (str "mailto:" e-mail)} 22 | (or (seq content) e-mail)]) 23 | 24 | (defelem unordered-list 25 | "Wrap a collection in an unordered list." 26 | [coll] 27 | [:ul (for [x coll] [:li x])]) 28 | 29 | (defelem ordered-list 30 | "Wrap a collection in an ordered list." 31 | [coll] 32 | [:ol (for [x coll] [:li x])]) 33 | 34 | (defelem image 35 | "Create an image element." 36 | ([src] [:img {:src (util/to-uri src)}]) 37 | ([src alt] [:img {:src (util/to-uri src), :alt alt}])) 38 | 39 | -------------------------------------------------------------------------------- /test/hiccup/element_test.clj: -------------------------------------------------------------------------------- 1 | (ns hiccup.element_test 2 | (:require [clojure.test :refer :all] 3 | [hiccup.element :refer :all]) 4 | (:import java.net.URI)) 5 | 6 | (deftest javascript-tag-test 7 | (is (= (javascript-tag "alert('hello');") 8 | [:script {:type "text/javascript"} 9 | "//"]))) 10 | 11 | (deftest link-to-test 12 | (is (= (link-to "/") 13 | [:a {:href (URI. "/")} nil])) 14 | (is (= (link-to "/" "foo") 15 | [:a {:href (URI. "/")} (list "foo")])) 16 | (is (= (link-to "/" "foo" "bar") 17 | [:a {:href (URI. "/")} (list "foo" "bar")]))) 18 | 19 | (deftest mail-to-test 20 | (is (= (mail-to "foo@example.com") 21 | [:a {:href "mailto:foo@example.com"} "foo@example.com"])) 22 | (is (= (mail-to "foo@example.com" "foo") 23 | [:a {:href "mailto:foo@example.com"} (list "foo")]))) 24 | 25 | (deftest unordered-list-test 26 | (is (= (unordered-list ["foo" "bar" "baz"]) 27 | [:ul (list [:li "foo"] 28 | [:li "bar"] 29 | [:li "baz"])]))) 30 | 31 | (deftest ordered-list-test 32 | (is (= (ordered-list ["foo" "bar" "baz"]) 33 | [:ol (list [:li "foo"] 34 | [:li "bar"] 35 | [:li "baz"])]))) 36 | 37 | -------------------------------------------------------------------------------- /resources/clj-kondo.exports/hiccup/hiccup/hiccup/hooks.clj: -------------------------------------------------------------------------------- 1 | (ns hiccup.hooks 2 | (:require [clj-kondo.hooks-api :as api] 3 | [clojure.set :as set])) 4 | 5 | ;; See https://github.com/clj-kondo/clj-kondo/blob/master/doc/hooks.md 6 | 7 | (defn- parse-defn [elems] 8 | (let [[fhead fbody] (split-with #(not (or (api/vector-node? %) 9 | (api/list-node? %))) 10 | elems) 11 | arities (if (api/vector-node? (first fbody)) 12 | (list (api/list-node fbody)) 13 | fbody)] 14 | [fhead arities])) 15 | 16 | (defn- count-args [arity] 17 | (let [args (first (api/sexpr arity))] 18 | (if (= '& (fnext (reverse args))) 19 | true ; unbounded args 20 | (count args)))) 21 | 22 | (defn- dummy-arity [arg-count] 23 | (api/list-node 24 | (list 25 | (api/vector-node 26 | (vec (repeat arg-count (api/token-node '_))))))) 27 | 28 | (defn defelem [{:keys [node]}] 29 | (let [[_ & rest] (:children node) 30 | [fhead arities] (parse-defn rest) 31 | arg-counts (set (filter number? (map count-args arities))) 32 | dummy-arg-counts (set/difference (set (map inc arg-counts)) arg-counts) 33 | dummy-arities (for [n dummy-arg-counts] (dummy-arity n))] 34 | {:node 35 | (api/list-node 36 | (list* 37 | (api/token-node 'clojure.core/defn) 38 | (concat fhead arities dummy-arities)))})) 39 | -------------------------------------------------------------------------------- /src/hiccup/def.clj: -------------------------------------------------------------------------------- 1 | (ns hiccup.def 2 | "Macros for defining functions that generate HTML" 3 | (:require [hiccup.core :refer [html]])) 4 | 5 | (defmacro defhtml 6 | "Define a function, but wrap its output in an implicit [[hiccup.core/html]] 7 | macro." 8 | [name & fdecl] 9 | (let [[fhead fbody] (split-with #(not (or (list? %) (vector? %))) fdecl) 10 | wrap-html (fn [[args & body]] `(~args (html ~@body)))] 11 | `(defn ~name 12 | ~@fhead 13 | ~@(if (vector? (first fbody)) 14 | (wrap-html fbody) 15 | (map wrap-html fbody))))) 16 | 17 | (defn wrap-attrs 18 | "Add an optional attribute argument to a function that returns a element 19 | vector." 20 | [func] 21 | (fn [& args] 22 | (if (map? (first args)) 23 | (let [[tag & body] (apply func (rest args))] 24 | (if (map? (first body)) 25 | (apply vector tag (merge (first body) (first args)) (rest body)) 26 | (apply vector tag (first args) body))) 27 | (apply func args)))) 28 | 29 | (defn- update-arglists [arglists] 30 | (for [args arglists] 31 | (vec (cons 'attr-map? args)))) 32 | 33 | (defmacro defelem 34 | "Defines a function that will return a element vector. If the first argument 35 | passed to the resulting function is a map, it merges it with the attribute 36 | map of the returned element value." 37 | [name & fdecl] 38 | `(do (defn ~name ~@fdecl) 39 | (alter-meta! (var ~name) update-in [:arglists] #'update-arglists) 40 | (alter-var-root (var ~name) wrap-attrs))) 41 | -------------------------------------------------------------------------------- /src/hiccup2/core.clj: -------------------------------------------------------------------------------- 1 | (ns hiccup2.core 2 | "Library for rendering a tree of vectors into HTML. Pre-compiles where 3 | possible for performance. Strings are automatically escaped." 4 | {:added "2.0"} 5 | (:require [hiccup.compiler :as compiler] 6 | [hiccup.util :as util])) 7 | 8 | (defmacro html 9 | "Render Clojure data structures to a compiled representation of HTML. To turn 10 | the representation into a string, use clojure.core/str. Strings inside the 11 | macro are automatically HTML-escaped. To insert a string without it being 12 | escaped, use the [[raw]] function. 13 | 14 | A literal option map may be specified as the first argument. It accepts two 15 | keys that control how the HTML is outputted: 16 | 17 | `:mode` 18 | : One of `:html`, `:xhtml`, `:xml` or `:sgml` (defaults to `:xhtml`). 19 | Controls how tags are rendered. 20 | 21 | `:escape-strings?` 22 | : True if strings should be escaped (defaults to true)." 23 | {:added "2.0"} 24 | [options & content] 25 | (if (map? options) 26 | (let [mode (:mode options :xhtml) 27 | escape-strings? (:escape-strings? options true)] 28 | `(binding [util/*html-mode* ~mode 29 | util/*escape-strings?* ~escape-strings?] 30 | (util/raw-string ~(apply compiler/compile-html-with-bindings content)))) 31 | `(util/raw-string ~(apply compiler/compile-html-with-bindings options content)))) 32 | 33 | (def ^{:added "2.0"} raw 34 | "Short alias for [[hiccup.util/raw-string]]." 35 | util/raw-string) 36 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | ## 2.0.0 (2025-06-19) 2 | 3 | * Identical to 2.0.0-RC5 4 | 5 | ## 2.0.0-RC5 (2025-05-21) 6 | 7 | * Fixed emitting unevaluated forms for non-literal tags (#217) 8 | 9 | ## 2.0.0-RC4 (2024-11-29) 10 | 11 | * Fixed compiler bug that emitted unevaluated forms (#214) 12 | 13 | ## 2.0.0-RC3 (2024-02-11) 14 | 15 | * Optimized amount of bytecode generated (#206) 16 | * Fixed literal child elements from being escaped (#207) 17 | * Fixed formatting of nil elements at runtime (#208) 18 | 19 | ## 2.0.0-RC2 (2023-10-05) 20 | 21 | * Improved performance (#204) 22 | 23 | ## 2.0.0-RC1 (2023-06-21) 24 | 25 | * Reverted behaviour of `hiccup.core/h` to 1.0 (#198) 26 | 27 | ## 2.0.0-alpha2 (2019-01-22) 28 | 29 | * Fixed issue with dot-notation and non-literal classes (#151) 30 | 31 | ## 2.0.0-alpha1 (2017-01-15) 32 | 33 | * Added `hiccup2.core` namespace that escapes strings automatically 34 | * Added new syntax for class and style attributes 35 | * Fixed issue with pre-compiled `html` macro accepting new mode bindings 36 | 37 | ## 1.0.5 (2014-01-25) 38 | 39 | * Inverted container tag check to look for void tags instead 40 | * Added apostrophes to list of characters to escape 41 | 42 | ## 1.0.4 (2013-07-21) 43 | 44 | * Fixed merging of class and id attributes 45 | * Fixed keyword rendering 46 | * Added explicit ending tag for ` element." 29 | [type name value] 30 | [:input {:type type 31 | :name (make-name name) 32 | :id (make-id name) 33 | :value value}]) 34 | 35 | (defelem hidden-field 36 | "Creates a hidden input field." 37 | ([name] (hidden-field name nil)) 38 | ([name value] (input-field "hidden" name value))) 39 | 40 | (defelem text-field 41 | "Creates a new text input field." 42 | ([name] (text-field name nil)) 43 | ([name value] (input-field "text" name value))) 44 | 45 | (defelem password-field 46 | "Creates a new password field." 47 | ([name] (password-field name nil)) 48 | ([name value] (input-field "password" name value))) 49 | 50 | (defelem email-field 51 | "Creates a new email input field." 52 | ([name] (email-field name nil)) 53 | ([name value] (input-field "email" name value))) 54 | 55 | (defelem check-box 56 | "Creates a check box." 57 | ([name] (check-box name nil)) 58 | ([name checked?] (check-box name checked? "true")) 59 | ([name checked? value] 60 | [:input {:type "checkbox" 61 | :name (make-name name) 62 | :id (make-id name) 63 | :value value 64 | :checked checked?}])) 65 | 66 | (defelem radio-button 67 | "Creates a radio button." 68 | ([group] (radio-button group nil)) 69 | ([group checked?] (radio-button group checked? "true")) 70 | ([group checked? value] 71 | [:input {:type "radio" 72 | :name (make-name group) 73 | :id (make-id (str (util/as-str group) "-" (util/as-str value))) 74 | :value value 75 | :checked checked?}])) 76 | 77 | (defelem select-options 78 | "Creates a seq of option tags from a collection." 79 | ([coll] (select-options coll nil)) 80 | ([coll selected] 81 | (for [x coll] 82 | (if (sequential? x) 83 | (let [[text val] x] 84 | (if (sequential? val) 85 | [:optgroup {:label text} (select-options val selected)] 86 | [:option {:value val :selected (= val selected)} text])) 87 | [:option {:selected (= x selected)} x])))) 88 | 89 | (defelem drop-down 90 | "Creates a drop-down box using the `")) 31 | (is (= (html [:object]) "")) 32 | (is (= (html [:video]) ""))) 33 | (testing "void tags" 34 | (is (= (html [:br]) "
")) 35 | (is (= (html [:link]) "")) 36 | (is (= (html [:colgroup {:span 2}]) "")) 37 | (is (= (html [:colgroup [:col]]) ""))) 38 | (testing "tags containing text" 39 | (is (= (html [:text "Lorem Ipsum"]) "Lorem Ipsum"))) 40 | (testing "contents are concatenated" 41 | (is (= (html [:body "foo" "bar"]) "foobar")) 42 | (is (= (html [:body [:p] [:br]]) "


"))) 43 | (testing "seqs are expanded" 44 | (is (= (html [:body (list "foo" "bar")]) "foobar")) 45 | (is (= (html (list [:p "a"] [:p "b"])) "

a

b

"))) 46 | (testing "keywords are turned into strings" 47 | (is (= (html [:div :foo]) "
foo
"))) 48 | (testing "vecs don't expand - error if vec doesn't have tag name" 49 | (is (thrown? IllegalArgumentException 50 | (html (vector [:p "a"] [:p "b"]))))) 51 | (testing "tags can contain tags" 52 | (is (= (html [:div [:p]]) "

")) 53 | (is (= (html [:div [:b]]) "
")) 54 | (is (= (html [:p [:span [:a "foo"]]]) 55 | "

foo

")))) 56 | 57 | (deftest tag-attributes 58 | (testing "tag with blank attribute map" 59 | (is (= (html [:xml {}]) ""))) 60 | (testing "tag with populated attribute map" 61 | (is (= (html [:xml {:a 123}]) "")) 62 | (is (= (html [:xml {:a 'sym}]) "")) 63 | (is (= (html [:xml {:a :kw}]) "")) 64 | (is (= (html [:xml {:a [:kw :ns/ns-kw "str" 3 'sym]}]) "")) 65 | (is (= (html [:xml {:a "1", :b "2"}]) "")) 66 | (is (= (html [:img {"id" "foo"}]) "")) 67 | (is (= (html [:img {'id "foo"}]) "")) 68 | (is (= (html [:xml {:a "1", 'b "2", "c" "3"}]) 69 | ""))) 70 | (testing "attribute values are escaped" 71 | (is (= (html [:div {:id "\""}]) "
"))) 72 | (testing "boolean attributes" 73 | (is (= (html [:input {:type "checkbox" :checked true}]) 74 | "")) 75 | (is (= (html [:input {:type "checkbox" :checked false}]) 76 | ""))) 77 | (testing "nil attributes" 78 | (is (= (html [:span {:class nil} "foo"]) 79 | "foo"))) 80 | (testing "resolving conflicts between attributes in the map and tag" 81 | (is (= (html [:div.foo {:class "bar"} "baz"]) 82 | "
baz
")) 83 | (is (= (html [:div#bar.foo {:id "baq"} "baz"]) 84 | "
baz
"))) 85 | (testing "tag with vector class" 86 | (is (= (html [:div {:class [:bar]} "baz"]) 87 | "
baz
")) 88 | (is (= (html [:div.foo {:class ["bar"]} "baz"]) 89 | "
baz
")) 90 | (is (= (html [:div.foo {:class [:bar]} "baz"]) 91 | "
baz
")) 92 | (is (= (html [:div.foo {:class [:bar "box"]} "baz"]) 93 | "
baz
")) 94 | (is (= (html [:div.foo {:class ["bar" "box"]} "baz"]) 95 | "
baz
")) 96 | (is (= (html [:div.foo {:class [:bar :box]} "baz"]) 97 | "
baz
")) 98 | (is (= (html [:div.foo {:class [nil :bar nil]} "baz"]) 99 | "
baz
")))) 100 | 101 | (deftest compiled-tags 102 | (testing "tag content can be vars" 103 | (is (= (let [x "foo"] (html [:span x])) "foo"))) 104 | (testing "tag content can be forms" 105 | (is (= (html [:span (str (+ 1 1))]) "2")) 106 | (is (= (html [:span ({:foo "bar"} :foo)]) "bar"))) 107 | (testing "attributes can contain vars" 108 | (let [x "foo"] 109 | (is (= (html [:xml {:x x}]) "")) 110 | (is (= (html [:xml {x "x"}]) "")) 111 | (is (= (html [:xml {:x x} "bar"]) "bar")))) 112 | (testing "attributes are evaluated" 113 | (is (= (html [:img {:src (str "/foo" "/bar")}]) 114 | "")) 115 | (is (= (html [:div {:id (str "a" "b")} (str "foo")]) 116 | "
foo
"))) 117 | (testing "type hints" 118 | (let [string "x"] 119 | (is (= (html [:span ^String string]) "x")))) 120 | (testing "optimized forms" 121 | (is (= (html [:ul (for [n (range 3)] 122 | [:li n])]) 123 | "")) 124 | (is (= (html [:div (if true 125 | [:span "foo"] 126 | [:span "bar"])]) 127 | "
foo
")) 128 | (is (= (html (let [x "foo"] [:span x])) 129 | "foo")) 130 | (is (= (html (when true [:span "true"])) 131 | "true")) 132 | (is (= (html (when false [:span "true"])) 133 | ""))) 134 | (testing "values are evaluated only once" 135 | (let [times-called (atom 0) 136 | foo #(swap! times-called inc)] 137 | (html [:div (foo)]) 138 | (is (= @times-called 1)))) 139 | (testing "defer evaluation of non-literal class names when combined with tag classes" 140 | (let [x "attr-class"] 141 | (is (= (html [:div.tag-class {:class x}]) 142 | "
"))))) 143 | 144 | (deftest render-modes 145 | (testing "closed tag" 146 | (is (= (html [:p] [:br]) "


")) 147 | (is (= (html {:mode :xhtml} [:p] [:br]) "


")) 148 | (is (= (html {:mode :html} [:p] [:br]) "


")) 149 | (is (= (html {:mode :xml} [:p] [:br]) "


")) 150 | (is (= (html {:mode :sgml} [:p] [:br]) "


"))) 151 | (testing "boolean attributes" 152 | (is (= (html {:mode :xml} [:input {:type "checkbox" :checked true}]) 153 | "")) 154 | (is (= (html {:mode :sgml} [:input {:type "checkbox" :checked true}]) 155 | ""))) 156 | (testing "laziness and binding scope" 157 | (is (= (html {:mode :sgml} [:html [:link] (list [:link])]) 158 | "")))) 159 | -------------------------------------------------------------------------------- /test/hiccup/form_test.clj: -------------------------------------------------------------------------------- 1 | (ns hiccup.form_test 2 | (:require [clojure.test :refer :all] 3 | [hiccup.core :refer [html]] 4 | [hiccup.form :refer :all])) 5 | 6 | (deftest test-hidden-field 7 | (is (= (html (hidden-field :foo "bar")) 8 | ""))) 9 | 10 | (deftest test-hidden-field-with-extra-atts 11 | (is (= (html (hidden-field {:class "classy"} :foo "bar")) 12 | ""))) 13 | 14 | (deftest test-text-field 15 | (is (= (html (text-field :foo)) 16 | ""))) 17 | 18 | (deftest test-text-field-with-extra-atts 19 | (is (= (html (text-field {:class "classy"} :foo "bar")) 20 | ""))) 21 | 22 | (deftest test-check-box 23 | (is (= (html (check-box :foo true)) 24 | (str "")))) 26 | 27 | (deftest test-check-box-with-extra-atts 28 | (is (= (html (check-box {:class "classy"} :foo true 1)) 29 | (str "")))) 31 | 32 | (deftest test-password-field 33 | (is (= (html (password-field :foo "bar")) 34 | ""))) 35 | 36 | (deftest test-password-field-with-extra-atts 37 | (is (= (html (password-field {:class "classy"} :foo "bar")) 38 | ""))) 39 | 40 | (deftest test-email-field 41 | (is (= (html (email-field :foo "bar")) 42 | ""))) 43 | 44 | (deftest test-email-field-with-extra-atts 45 | (is (= (html (email-field {:class "classy"} :foo "bar")) 46 | ""))) 47 | 48 | (deftest test-radio-button 49 | (is (= (html (radio-button :foo true 1)) 50 | (str "")))) 52 | 53 | (deftest test-radio-button-with-extra-atts 54 | (is (= (html (radio-button {:class "classy"} :foo true 1)) 55 | (str "")))) 57 | 58 | (deftest test-select-options 59 | (are [x y] (= (html x) y) 60 | (select-options ["foo" "bar" "baz"]) 61 | "" 62 | (select-options ["foo" "bar"] "bar") 63 | "" 64 | (select-options [["Foo" 1] ["Bar" 2]]) 65 | "" 66 | (select-options [["Foo" [1 2]] ["Bar" [3 4]]]) 67 | (str "" 68 | "") 69 | (select-options [["Foo" [["bar" 1] ["baz" 2]]]]) 70 | (str "" 71 | "") 72 | (select-options [["Foo" [1 2]]] 2) 73 | (str "" 74 | ""))) 75 | 76 | 77 | 78 | (deftest test-drop-down 79 | (let [options ["op1" "op2"] 80 | selected "op1" 81 | select-options (html (select-options options selected))] 82 | (is (= (html (drop-down :foo options selected)) 83 | (str ""))))) 84 | 85 | (deftest test-drop-down-with-extra-atts 86 | (let [options ["op1" "op2"] 87 | selected "op1" 88 | select-options (html (select-options options selected))] 89 | (is (= (html (drop-down {:class "classy"} :foo options selected)) 90 | (str ""))))) 92 | 93 | (deftest test-text-area 94 | (is (= (html (text-area :foo "bar")) 95 | ""))) 96 | 97 | (deftest test-text-area-field-with-extra-atts 98 | (is (= (html (text-area {:class "classy"} :foo "bar")) 99 | ""))) 100 | 101 | (deftest test-text-area-escapes 102 | (is (= (html (text-area :foo "bar")) 103 | ""))) 104 | 105 | (deftest test-file-field 106 | (is (= (html (file-upload :foo)) 107 | ""))) 108 | 109 | (deftest test-file-field-with-extra-atts 110 | (is (= (html (file-upload {:class "classy"} :foo)) 111 | (str "")))) 113 | 114 | (deftest test-label 115 | (is (= (html (label :foo "bar")) 116 | ""))) 117 | 118 | (deftest test-label-with-extra-atts 119 | (is (= (html (label {:class "classy"} :foo "bar")) 120 | ""))) 121 | 122 | (deftest test-submit 123 | (is (= (html (submit-button "bar")) 124 | ""))) 125 | 126 | (deftest test-submit-button-with-extra-atts 127 | (is (= (html (submit-button {:class "classy"} "bar")) 128 | ""))) 129 | 130 | (deftest test-reset-button 131 | (is (= (html (reset-button "bar")) 132 | ""))) 133 | 134 | (deftest test-reset-button-with-extra-atts 135 | (is (= (html (reset-button {:class "classy"} "bar")) 136 | ""))) 137 | 138 | (deftest test-form-to 139 | (is (= (html (form-to [:post "/path"] "foo" "bar")) 140 | "

foobar
"))) 141 | 142 | (deftest test-form-to-with-hidden-method 143 | (is (= (html (form-to [:put "/path"] "foo" "bar")) 144 | (str "
" 145 | "" 146 | "foobar
")))) 147 | 148 | (deftest test-form-to-with-extr-atts 149 | (is (= (html (form-to {:class "classy"} [:post "/path"] "foo" "bar")) 150 | "
foobar
"))) 151 | 152 | (deftest test-with-group 153 | (testing "hidden-field" 154 | (is (= (html (with-group :foo (hidden-field :bar "val"))) 155 | ""))) 156 | (testing "text-field" 157 | (is (= (html (with-group :foo (text-field :bar))) 158 | ""))) 159 | (testing "checkbox" 160 | (is (= (html (with-group :foo (check-box :bar))) 161 | ""))) 162 | (testing "password-field" 163 | (is (= (html (with-group :foo (password-field :bar))) 164 | ""))) 165 | (testing "radio-button" 166 | (is (= (html (with-group :foo (radio-button :bar false "val"))) 167 | ""))) 168 | (testing "drop-down" 169 | (is (= (html (with-group :foo (drop-down :bar []))) 170 | (str "")))) 171 | (testing "text-area" 172 | (is (= (html (with-group :foo (text-area :bar))) 173 | (str "")))) 174 | (testing "file-upload" 175 | (is (= (html (with-group :foo (file-upload :bar))) 176 | ""))) 177 | (testing "label" 178 | (is (= (html (with-group :foo (label :bar "Bar"))) 179 | ""))) 180 | (testing "multiple with-groups" 181 | (is (= (html (with-group :foo (with-group :bar (text-field :baz)))) 182 | ""))) 183 | (testing "multiple elements" 184 | (is (= (html (with-group :foo (label :bar "Bar") (text-field :var))) 185 | "")))) 186 | -------------------------------------------------------------------------------- /test/hiccup2/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns hiccup2.core_test 2 | (:require [clojure.test :refer :all] 3 | [hiccup2.core :refer :all] 4 | [hiccup.util :as util])) 5 | 6 | (deftest return-types 7 | (testing "html returns a RawString" 8 | (is (util/raw-string? (html [:div])))) 9 | (testing "converting to string" 10 | (is (= (str (html [:div])) "
")))) 11 | 12 | (deftest tag-names 13 | (testing "basic tags" 14 | (is (= (str (html [:div])) "
")) 15 | (is (= (str (html ["div"])) "
")) 16 | (is (= (str (html ['div])) "
"))) 17 | (testing "tag syntax sugar" 18 | (is (= (str (html [:div#foo])) "
")) 19 | (is (= (str (html [:div.foo])) "
")) 20 | (is (= (str (html [:div.foo (str "bar" "baz")])) 21 | "
barbaz
")) 22 | (is (= (str (html [:div.a.b])) "
")) 23 | (is (= (str (html [:div.a.b.c])) "
")) 24 | (is (= (str (html [:div#foo.bar.baz])) 25 | "
")))) 26 | 27 | (deftest tag-contents 28 | (testing "empty tags" 29 | (is (= (str (html [:div])) "
")) 30 | (is (= (str (html [:h1])) "

")) 31 | (is (= (str (html [:script])) "")) 32 | (is (= (str (html [:text])) "")) 33 | (is (= (str (html [:a])) "")) 34 | (is (= (str (html [:iframe])) "")) 35 | (is (= (str (html [:title])) "")) 36 | (is (= (str (html [:section])) "
")) 37 | (is (= (str (html [:select])) "")) 38 | (is (= (str (html [:object])) "")) 39 | (is (= (str (html [:video])) ""))) 40 | (testing "void tags" 41 | (is (= (str (html [:br])) "
")) 42 | (is (= (str (html [:link])) "")) 43 | (is (= (str (html [:colgroup {:span 2}])) "")) 44 | (is (= (str (html [:colgroup [:col]])) ""))) 45 | (testing "tags containing text" 46 | (is (= (str (html [:text "Lorem Ipsum"])) "Lorem Ipsum"))) 47 | (testing "contents are concatenated" 48 | (is (= (str (html [:body "foo" "bar"])) "foobar")) 49 | (is (= (str (html [:body [:p] [:br]])) "


"))) 50 | (testing "seqs are expanded" 51 | (is (= (str (html [:body (list "foo" "bar")])) "foobar")) 52 | (is (= (str (html (list [:p "a"] [:p "b"]))) "

a

b

"))) 53 | (testing "keywords are turned into strings" 54 | (is (= (str (html [:div :foo])) "
foo
"))) 55 | (testing "vecs don't expand - error if vec doesn't have tag name" 56 | (is (thrown? IllegalArgumentException 57 | (html (vector [:p "a"] [:p "b"]))))) 58 | (testing "tags can contain tags" 59 | (is (= (str (html [:div [:p]])) "

")) 60 | (is (= (str (html [:div [:b]])) "
")) 61 | (is (= (str (html [:p [:span [:a "foo"]]])) 62 | "

foo

")))) 63 | 64 | (deftest tag-attributes 65 | (testing "tag with blank attribute map" 66 | (is (= (str (html [:xml {}])) ""))) 67 | (testing "tag with populated attribute map" 68 | (is (= (str (html [:xml {:a "1", :b "2"}])) "")) 69 | (is (= (str (html [:img {"id" "foo"}])) "")) 70 | (is (= (str (html [:img {'id "foo"}])) "")) 71 | (is (= (str (html [:xml {:a "1", 'b "2", "c" "3"}])) 72 | ""))) 73 | (testing "attribute values are escaped" 74 | (is (= (str (html [:div {:id "\""}])) "
"))) 75 | (testing "boolean attributes" 76 | (is (= (str (html [:input {:type "checkbox" :checked true}])) 77 | "")) 78 | (is (= (str (html [:input {:type "checkbox" :checked false}])) 79 | ""))) 80 | (testing "nil attributes" 81 | (is (= (str (html [:span {:class nil} "foo"])) 82 | "foo"))) 83 | (testing "vector attributes" 84 | (is (= (str (html [:span {:class ["bar" "baz"]} "foo"])) 85 | "foo")) 86 | (is (= (str (html [:span {:class ["baz"]} "foo"])) 87 | "foo")) 88 | (is (= (str (html [:span {:class "baz bar"} "foo"])) 89 | "foo"))) 90 | (testing "map attributes" 91 | (is (= (str (html [:span {:style {:background-color :blue, :color "red", 92 | :line-width 1.2, :opacity "100%"}} "foo"])) 93 | "foo"))) 94 | (testing "resolving conflicts between attributes in the map and tag" 95 | (is (= (str (html [:div.foo {:class "bar"} "baz"])) 96 | "
baz
")) 97 | (is (= (str (html [:div.foo {:class ["bar"]} "baz"])) 98 | "
baz
")) 99 | (is (= (str (html [:div#bar.foo {:id "baq"} "baz"])) 100 | "
baz
")))) 101 | 102 | (deftest compiled-tags 103 | (testing "tag content can be vars" 104 | (is (= (let [x "foo"] (str (html [:span x]))) "foo"))) 105 | (testing "tag content can be forms" 106 | (is (= (str (html [:span (str (+ 1 1))])) "2")) 107 | (is (= (str (html [:span ({:foo "bar"} :foo)])) "bar"))) 108 | (testing "attributes can contain vars" 109 | (let [x "foo"] 110 | (is (= (str (html [:xml {:x x}])) "")) 111 | (is (= (str (html [:xml {x "x"}])) "")) 112 | (is (= (str (html [:xml {:x x} "bar"])) "bar")))) 113 | (testing "attributes are evaluated" 114 | (is (= (str (html [:img {:src (str "/foo" "/bar")}])) 115 | "")) 116 | (is (= (str (html [:div {:id (str "a" "b")} (str "foo")])) 117 | "
foo
"))) 118 | (testing "vector attributes are evaluated" 119 | (let [x "bar"] 120 | (is (= (str (html [:span {:class ["foo" x]}])) 121 | "")))) 122 | (testing "map attributes are evaluated" 123 | (let [color "red" 124 | bg-color :blue] 125 | (is (= (str (html [:span {:style {:background-color bg-color, :color color}} "foo"])) 126 | "foo")))) 127 | (testing "type hints" 128 | (let [string "x"] 129 | (is (= (str (html [:span ^String string])) "x")))) 130 | (testing "optimized forms" 131 | (is (= (str (html [:ul (for [n (range 3)] 132 | [:li n])])) 133 | "")) 134 | (is (= (str (html [:div (if true 135 | [:span "foo"] 136 | [:span "bar"])])) 137 | "
foo
"))) 138 | (testing "values are evaluated only once" 139 | (let [times-called (atom 0) 140 | foo #(swap! times-called inc)] 141 | (html [:div (foo)]) 142 | (is (= @times-called 1))))) 143 | 144 | (deftest render-modes 145 | (testing "closed tag" 146 | (is (= (str (html [:p] [:br])) "


")) 147 | (is (= (str (html {:mode :xhtml} [:p] [:br])) "


")) 148 | (is (= (str (html {:mode :html} [:p] [:br])) "


")) 149 | (is (= (str (html {:mode :xml} [:p] [:br])) "


")) 150 | (is (= (str (html {:mode :sgml} [:p] [:br])) "


"))) 151 | (testing "boolean attributes" 152 | (is (= (str (html {:mode :xml} [:input {:type "checkbox" :checked true}])) 153 | "")) 154 | (is (= (str (html {:mode :sgml} [:input {:type "checkbox" :checked true}])) 155 | ""))) 156 | (testing "laziness and binding scope" 157 | (is (= (str (html {:mode :sgml} [:html [:link] (list [:link])])) 158 | ""))) 159 | (testing "function binding scope" 160 | (let [f #(html [:p "<>" [:br]])] 161 | (is (= (str (html (f))) "

<>

")) 162 | (is (= (str (html {:escape-strings? false} (f))) "

<>

")) 163 | (is (= (str (html {:mode :html} (f))) "

<>

")) 164 | (is (= (str (html {:escape-strings? false, :mode :html} (f))) "

<>

"))))) 165 | 166 | (deftest auto-escaping 167 | (testing "literals" 168 | (is (= (str (html "<>")) "<>")) 169 | (is (= (str (html :<>)) "<>")) 170 | (is (= (str (html ^String (str "<>"))) "<>")) 171 | (is (= (str (html {} {"" ""})) "{"<a>" "<b>"}")) 172 | (is (= (str (html #{"<>"})) "#{"<>"}")) 173 | (is (= (str (html 1)) "1")) 174 | (is (= (str (html ^Number (+ 1 1))) "2"))) 175 | (testing "non-literals" 176 | (is (= (str (html (list [:p ""] [:p ""]))) 177 | "

<foo>

<bar>

")) 178 | (is (= (str (html ((constantly "")))) "<foo>")) 179 | (is (= (let [x ""] (str (html x))) "<foo>"))) 180 | (testing "optimized forms" 181 | (is (= (str (html (if true : :))) "<foo>")) 182 | (is (= (str (html (for [x [:]] x))) "<foo>"))) 183 | (testing "elements" 184 | (is (= (str (html [:p "<>"])) "

<>

")) 185 | (is (= (str (html [:p :<>])) "

<>

")) 186 | (is (= (str (html [:p {} {"" ""}])) 187 | "

{"<foo>" "<bar>"}

")) 188 | (is (= (str (html [:p {} #{""}])) 189 | "

#{"<foo>"}

")) 190 | (is (= (str (html [:p {:class "<\">"}])) 191 | "

")) 192 | (is (= (str (html [:p {:class ["<\">"]}])) 193 | "

")) 194 | (is (= (str (html [:ul [:li ""]])) 195 | "
  • <foo>
"))) 196 | (testing "raw strings" 197 | (is (= (str (html (util/raw-string ""))) "")) 198 | (is (= (str (html [:p (util/raw-string "")])) "

")) 199 | (is (= (str (html (html [:p "<>"]))) "

<>

")) 200 | (is (= (str (html [:ul (html [:li "<>"])])) "
  • <>
")))) 201 | 202 | (deftest html-escaping 203 | (testing "precompilation" 204 | (is (= (str (html {:escape-strings? true} [:p "<>"])) "

<>

")) 205 | (is (= (str (html {:escape-strings? false} [:p "<>"])) "

<>

"))) 206 | (testing "dynamic generation" 207 | (let [x [:p "<>"]] 208 | (is (= (str (html {:escape-strings? true} x)) "

<>

")) 209 | (is (= (str (html {:escape-strings? false} x)) "

<>

")))) 210 | (testing "attributes" 211 | (is (= (str (html {:escape-strings? true} [:p {:class "<>"}])) 212 | "

")) 213 | (is (= (str (html {:escape-strings? false} [:p {:class "<>"}])) 214 | "

"))) 215 | (testing "raw strings" 216 | (is (= (str (html {:escape-strings? true} [:p (util/raw-string "<>")])) 217 | "

<>

")) 218 | (is (= (str (html {:escape-strings? false} [:p (util/raw-string "<>")])) 219 | "

<>

")) 220 | (is (= (str (html {:escape-strings? true} [:p (raw "<>")])) 221 | "

<>

")) 222 | (is (= (str (html {:escape-strings? false} [:p (raw "<>")])) 223 | "

<>

")))) 224 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Eclipse Public License - v 1.0 2 | 3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 4 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 5 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 6 | 7 | 1. DEFINITIONS 8 | 9 | "Contribution" means: 10 | a) in the case of the initial Contributor, the initial code and 11 | documentation distributed under this Agreement, and 12 | b) in the case of each subsequent Contributor: 13 | i) changes to the Program, and 14 | ii) additions to the Program; 15 | 16 | where such changes and/or additions to the Program originate from and are 17 | distributed by that particular Contributor. A Contribution 'originates' from a 18 | Contributor if it was added to the Program by such Contributor itself or 19 | anyone acting on such Contributor's behalf. Contributions do not include 20 | additions to the Program which: (i) are separate modules of software 21 | distributed in conjunction with the Program under their own license agreement, 22 | and (ii) are not derivative works of the Program. 23 | "Contributor" means any person or entity that distributes the Program. 24 | 25 | "Licensed Patents" mean patent claims licensable by a Contributor which are 26 | necessarily infringed by the use or sale of its Contribution alone or when 27 | combined with the Program. 28 | 29 | "Program" means the Contributions distributed in accordance with this 30 | Agreement. 31 | 32 | "Recipient" means anyone who receives the Program under this Agreement, 33 | including all Contributors. 34 | 35 | 2. GRANT OF RIGHTS 36 | 37 | a) Subject to the terms of this Agreement, each Contributor hereby grants 38 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 39 | reproduce, prepare derivative works of, publicly display, publicly 40 | perform, distribute and sublicense the Contribution of such Contributor, 41 | if any, and such derivative works, in source code and object code form. 42 | 43 | b) Subject to the terms of this Agreement, each Contributor hereby grants 44 | Recipient a non-exclusive, worldwide, royalty-free patent license under 45 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 46 | transfer the Contribution of such Contributor, if any, in source code and 47 | object code form. This patent license shall apply to the combination of 48 | the Contribution and the Program if, at the time the Contribution is 49 | added by the Contributor, such addition of the Contribution causes such 50 | combination to be covered by the Licensed Patents. The patent license 51 | shall not apply to any other combinations which include the Contribution. 52 | No hardware per se is licensed hereunder. 53 | 54 | c) Recipient understands that although each Contributor grants the 55 | licenses to its Contributions set forth herein, no assurances are 56 | provided by any Contributor that the Program does not infringe the patent 57 | or other intellectual property rights of any other entity. Each 58 | Contributor disclaims any liability to Recipient for claims brought by 59 | any other entity based on infringement of intellectual property rights or 60 | otherwise. As a condition to exercising the rights and licenses granted 61 | hereunder, each Recipient hereby assumes sole responsibility to secure 62 | any other intellectual property rights needed, if any. For example, if a 63 | third party patent license is required to allow Recipient to distribute 64 | the Program, it is Recipient's responsibility to acquire that license 65 | before distributing the Program. 66 | 67 | d) Each Contributor represents that to its knowledge it has sufficient 68 | copyright rights in its Contribution, if any, to grant the copyright 69 | license set forth in this Agreement. 70 | 71 | 3. REQUIREMENTS 72 | A Contributor may choose to distribute the Program in object code form under 73 | its own license agreement, provided that: 74 | 75 | a) it complies with the terms and conditions of this Agreement; and 76 | 77 | b) its license agreement: 78 | i) effectively disclaims on behalf of all Contributors all 79 | warranties and conditions, express and implied, including warranties 80 | or conditions of title and non-infringement, and implied warranties 81 | or conditions of merchantability and fitness for a particular 82 | purpose; 83 | ii) effectively excludes on behalf of all Contributors all liability 84 | for damages, including direct, indirect, special, incidental and 85 | consequential damages, such as lost profits; 86 | iii) states that any provisions which differ from this Agreement are 87 | offered by that Contributor alone and not by any other party; and 88 | iv) states that source code for the Program is available from such 89 | Contributor, and informs licensees how to obtain it in a reasonable 90 | manner on or through a medium customarily used for software 91 | exchange. 92 | 93 | When the Program is made available in source code form: 94 | 95 | a) it must be made available under this Agreement; and 96 | 97 | b) a copy of this Agreement must be included with each copy of the 98 | Program. 99 | Contributors may not remove or alter any copyright notices contained within 100 | the Program. 101 | 102 | Each Contributor must identify itself as the originator of its Contribution, 103 | if any, in a manner that reasonably allows subsequent Recipients to identify 104 | the originator of the Contribution. 105 | 106 | 4. COMMERCIAL DISTRIBUTION 107 | Commercial distributors of software may accept certain responsibilities with 108 | respect to end users, business partners and the like. While this license is 109 | intended to facilitate the commercial use of the Program, the Contributor who 110 | includes the Program in a commercial product offering should do so in a manner 111 | which does not create potential liability for other Contributors. Therefore, 112 | if a Contributor includes the Program in a commercial product offering, such 113 | Contributor ("Commercial Contributor") hereby agrees to defend and indemnify 114 | every other Contributor ("Indemnified Contributor") against any losses, 115 | damages and costs (collectively "Losses") arising from claims, lawsuits and 116 | other legal actions brought by a third party against the Indemnified 117 | Contributor to the extent caused by the acts or omissions of such Commercial 118 | Contributor in connection with its distribution of the Program in a commercial 119 | product offering. The obligations in this section do not apply to any claims 120 | or Losses relating to any actual or alleged intellectual property 121 | infringement. In order to qualify, an Indemnified Contributor must: a) 122 | promptly notify the Commercial Contributor in writing of such claim, and b) 123 | allow the Commercial Contributor to control, and cooperate with the Commercial 124 | Contributor in, the defense and any related settlement negotiations. The 125 | Indemnified Contributor may participate in any such claim at its own expense. 126 | 127 | For example, a Contributor might include the Program in a commercial product 128 | offering, Product X. That Contributor is then a Commercial Contributor. If 129 | that Commercial Contributor then makes performance claims, or offers 130 | warranties related to Product X, those performance claims and warranties are 131 | such Commercial Contributor's responsibility alone. Under this section, the 132 | Commercial Contributor would have to defend claims against the other 133 | Contributors related to those performance claims and warranties, and if a 134 | court requires any other Contributor to pay any damages as a result, the 135 | Commercial Contributor must pay those damages. 136 | 137 | 5. NO WARRANTY 138 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN 139 | "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR 140 | IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE, 141 | NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each 142 | Recipient is solely responsible for determining the appropriateness of using 143 | and distributing the Program and assumes all risks associated with its 144 | exercise of rights under this Agreement , including but not limited to the 145 | risks and costs of program errors, compliance with applicable laws, damage to 146 | or loss of data, programs or equipment, and unavailability or interruption of 147 | operations. 148 | 149 | 6. DISCLAIMER OF LIABILITY 150 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 151 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 152 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 153 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 154 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 155 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 156 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 157 | OF SUCH DAMAGES. 158 | 159 | 7. GENERAL 160 | 161 | If any provision of this Agreement is invalid or unenforceable under 162 | applicable law, it shall not affect the validity or enforceability of the 163 | remainder of the terms of this Agreement, and without further action by the 164 | parties hereto, such provision shall be reformed to the minimum extent 165 | necessary to make such provision valid and enforceable. 166 | 167 | If Recipient institutes patent litigation against any entity (including a 168 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 169 | (excluding combinations of the Program with other software or hardware) 170 | infringes such Recipient's patent(s), then such Recipient's rights granted 171 | under Section 2(b) shall terminate as of the date such litigation is filed. 172 | 173 | All Recipient's rights under this Agreement shall terminate if it fails to 174 | comply with any of the material terms or conditions of this Agreement and does 175 | not cure such failure in a reasonable period of time after becoming aware of 176 | such noncompliance. If all Recipient's rights under this Agreement terminate, 177 | Recipient agrees to cease use and distribution of the Program as soon as 178 | reasonably practicable. However, Recipient's obligations under this Agreement 179 | and any licenses granted by Recipient relating to the Program shall continue 180 | and survive. 181 | 182 | Everyone is permitted to copy and distribute copies of this Agreement, but in 183 | order to avoid inconsistency the Agreement is copyrighted and may only be 184 | modified in the following manner. The Agreement Steward reserves the right to 185 | publish new versions (including revisions) of this Agreement from time to 186 | time. No one other than the Agreement Steward has the right to modify this 187 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 188 | Eclipse Foundation may assign the responsibility to serve as the Agreement 189 | Steward to a suitable separate entity. Each new version of the Agreement will 190 | be given a distinguishing version number. The Program (including 191 | Contributions) may always be distributed subject to the version of the 192 | Agreement under which it was received. In addition, after a new version of the 193 | Agreement is published, Contributor may elect to distribute the Program 194 | (including its Contributions) under the new version. Except as expressly 195 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 196 | licenses to the intellectual property of any Contributor under this Agreement, 197 | whether expressly, by implication, estoppel or otherwise. All rights in the 198 | Program not expressly granted under this Agreement are reserved. 199 | 200 | This Agreement is governed by the laws of the State of New York and the 201 | intellectual property laws of the United States of America. No party to this 202 | Agreement will bring a legal action under this Agreement more than one year 203 | after the cause of action arose. Each party waives its rights to a jury trial 204 | in any resulting litigation. 205 | -------------------------------------------------------------------------------- /src/hiccup/compiler.clj: -------------------------------------------------------------------------------- 1 | (ns hiccup.compiler 2 | "Internal functions for compilation." 3 | (:require [hiccup.util :as util] 4 | [clojure.string :as str]) 5 | (:import [clojure.lang IPersistentVector ISeq Named] 6 | [java.util Iterator] 7 | [hiccup.util RawString])) 8 | 9 | (defn- xml-mode? [] 10 | (#{:xml :xhtml} util/*html-mode*)) 11 | 12 | (defn- html-mode? [] 13 | (#{:html :xhtml} util/*html-mode*)) 14 | 15 | (defn escape-html 16 | "Change special characters into HTML character entities if 17 | hiccup.util/*escape-strings* is true." 18 | [text] 19 | (if util/*escape-strings?* 20 | (util/escape-html text) 21 | text)) 22 | 23 | (defn- end-tag [] 24 | (if (xml-mode?) " />" ">")) 25 | 26 | (defn iterate! [callback coll] 27 | (when coll 28 | (let [^Iterator iterator (.iterator ^Iterable coll)] 29 | (while (.hasNext iterator) 30 | (callback (.next iterator)))))) 31 | 32 | (defn- concatenate-strings [coll] 33 | (->> coll 34 | (partition-by string?) 35 | (mapcat (fn [group] 36 | (if (string? (first group)) 37 | [(apply str group)] 38 | group))))) 39 | 40 | (defmacro build-string [& strs] 41 | (let [strs (concatenate-strings strs) 42 | w (gensym)] 43 | (case (count strs) 44 | 0 "" 45 | 1 (let [arg (first strs)] 46 | (if (string? arg) 47 | arg 48 | `(String/valueOf (or ~arg "")))) 49 | `(let [~w (StringBuilder.)] 50 | ~@(map (fn [arg] 51 | (if (string? arg) 52 | `(.append ~w ~arg) 53 | `(.append ~w (or ~arg "")))) 54 | strs) 55 | (.toString ~w))))) 56 | 57 | (defn- render-style-map [value] 58 | (let [sb (StringBuilder.)] 59 | (iterate! 60 | (fn [[k v]] 61 | (.append sb (util/to-str k)) 62 | (.append sb ":") 63 | (.append sb (util/to-str v)) 64 | (.append sb ";")) 65 | (sort-by #(util/to-str (key %)) value)) 66 | (.toString sb))) 67 | 68 | (defn- render-attr-value [value] 69 | (cond 70 | (map? value) 71 | (render-style-map value) 72 | (sequential? value) 73 | (str/join " " (map util/to-str value)) 74 | :else 75 | value)) 76 | 77 | (defn- xml-attribute [name value] 78 | (build-string " " (util/to-str name) "=\"" 79 | (util/escape-html (render-attr-value value)) "\"")) 80 | 81 | (defn- render-attribute [[name value]] 82 | (cond 83 | (true? value) 84 | (if (xml-mode?) 85 | (xml-attribute name name) 86 | (build-string " " (util/to-str name))) 87 | (not value) 88 | "" 89 | :else 90 | (xml-attribute name value))) 91 | 92 | (defn render-attr-map 93 | "Render a map of attributes." 94 | [attrs] 95 | (if (= {} attrs) 96 | "" 97 | (let [sb (StringBuilder.)] 98 | (iterate! #(.append sb (render-attribute %)) 99 | (sort-by #(util/to-str (key %)) attrs)) 100 | (.toString sb)))) 101 | 102 | (def ^{:doc "A list of elements that must be rendered without a closing tag." 103 | :private true} 104 | void-tags 105 | #{"area" "base" "br" "col" "command" "embed" "hr" "img" "input" "keygen" "link" 106 | "meta" "param" "source" "track" "wbr"}) 107 | 108 | (defn- container-tag? 109 | "Returns true if the tag has content or is not a void tag. In non-HTML modes, 110 | all contentless tags are assumed to be void tags." 111 | [tag content] 112 | (or content 113 | (and (html-mode?) (not (void-tags tag))))) 114 | 115 | 116 | (defn- parse-tag [^String tag] 117 | (let [id-index (let [index (.indexOf tag "#")] (when (pos? index) index)) 118 | class-index (let [index (.indexOf tag ".")] (when (pos? index) index))] 119 | [(cond 120 | id-index (.substring tag 0 id-index) 121 | class-index (.substring tag 0 class-index) 122 | :else tag) 123 | (when id-index 124 | (if class-index 125 | (.substring tag (unchecked-inc-int id-index) class-index) 126 | (.substring tag (unchecked-inc-int id-index)))) 127 | (when class-index 128 | (.substring tag (unchecked-inc-int class-index)))])) 129 | 130 | (defn merge-classes [class classes] 131 | (cond 132 | (nil? class) classes 133 | (string? class) (build-string classes " " class) 134 | :else (build-string classes " " 135 | (str/join " " (keep #(some-> % name) class))))) 136 | 137 | (declare literal?) 138 | 139 | (defn- merge-classes-form [class-form classes] 140 | (if (literal? class-form) 141 | (merge-classes class-form classes) 142 | `(merge-classes ~class-form ~classes))) 143 | 144 | (defn- merge-attributes [map-attrs id classes] 145 | (-> map-attrs 146 | (cond-> id (assoc :id (or (:id map-attrs) id))) 147 | (cond-> classes (assoc :class (merge-classes (:class map-attrs) classes))))) 148 | 149 | (defn- merge-attributes-form [map-attrs id classes] 150 | (-> map-attrs 151 | (cond-> id (assoc :id (or (:id map-attrs) id))) 152 | (cond-> classes (assoc :class (merge-classes-form (:class map-attrs) classes))))) 153 | 154 | (defn- normalize-element* 155 | [[tag & content] merge-attributes-fn] 156 | (when (not (or (keyword? tag) (symbol? tag) (string? tag))) 157 | (throw (IllegalArgumentException. (str tag " is not a valid element name.")))) 158 | (let [[tag id class] (parse-tag (util/to-str tag)) 159 | classes (if class (str/replace class "." " ")) 160 | map-attrs (first content)] 161 | (if (map? map-attrs) 162 | [tag (merge-attributes-fn map-attrs id classes) (next content)] 163 | [tag (cond-> {} 164 | id (assoc :id id) 165 | classes (assoc :class classes)) 166 | content]))) 167 | 168 | (defn normalize-element 169 | "Ensure an element vector is of the form [tag-name attrs content]." 170 | [tag-content] 171 | (normalize-element* tag-content merge-attributes)) 172 | 173 | (defn- normalize-element-form 174 | [[tag & content :as tag-content]] 175 | (normalize-element* tag-content merge-attributes-form)) 176 | 177 | (defprotocol HtmlRenderer 178 | (render-html [this] 179 | "Turn a Clojure data type into a string of HTML.")) 180 | 181 | (defn render-element 182 | "Render an element vector as a HTML element." 183 | [element] 184 | (let [[tag attrs content] (normalize-element element)] 185 | (if (container-tag? tag content) 186 | (build-string "<" tag (render-attr-map attrs) ">" 187 | (render-html content) 188 | "") 189 | (build-string "<" tag (render-attr-map attrs) (end-tag))))) 190 | 191 | (extend-protocol HtmlRenderer 192 | IPersistentVector 193 | (render-html [this] 194 | (render-element this)) 195 | ISeq 196 | (render-html [this] 197 | (let [sb (StringBuilder.)] 198 | (iterate! #(.append sb (render-html %)) this) 199 | (.toString sb))) 200 | RawString 201 | (render-html [this] 202 | (str this)) 203 | Named 204 | (render-html [this] 205 | (escape-html (name this))) 206 | Object 207 | (render-html [this] 208 | (escape-html (str this))) 209 | nil 210 | (render-html [this] 211 | "")) 212 | 213 | (defn- unevaluated? 214 | "True if the expression has not been evaluated." 215 | [expr] 216 | (or (symbol? expr) 217 | (and (seq? expr) 218 | (not= (first expr) `quote)))) 219 | 220 | (defn- literal? 221 | "True if x is a literal value that can be rendered as-is." 222 | [x] 223 | (and (not (unevaluated? x)) 224 | (or (not (or (vector? x) (map? x))) 225 | (every? literal? x)))) 226 | 227 | (defn compile-attr-map 228 | "Returns an unevaluated form that will render the supplied map as HTML 229 | attributes." 230 | [attrs] 231 | (if (every? literal? (mapcat identity attrs)) 232 | (render-attr-map attrs) 233 | `(render-attr-map ~attrs))) 234 | 235 | (defn- form-name 236 | "Get the name of the supplied form." 237 | [form] 238 | (if (and (seq? form) (symbol? (first form))) 239 | (name (first form)))) 240 | 241 | (declare compile-html) 242 | 243 | (defmulti compile-form 244 | "Pre-compile certain standard forms, where possible." 245 | {:private true} 246 | form-name) 247 | 248 | (defmethod compile-form "for" 249 | [[_ bindings body]] 250 | `(let [sb# (StringBuilder.)] 251 | (iterate! #(.append sb# %) (for ~bindings ~(compile-html body))) 252 | (.toString sb#))) 253 | 254 | (defmethod compile-form "if" 255 | [[_ condition & body]] 256 | `(if ~condition ~@(for [x body] (compile-html x)))) 257 | 258 | (defmethod compile-form "when" 259 | [[_ condition & body]] 260 | `(when ~condition 261 | ~@(butlast body) 262 | ~(compile-html (last body)))) 263 | 264 | (defmethod compile-form "let" 265 | [[_ bindings & body]] 266 | `(let ~bindings 267 | ~@(butlast body) 268 | ~(compile-html (last body)))) 269 | 270 | (defmethod compile-form :default 271 | [expr] 272 | `(render-html ~expr)) 273 | 274 | (defn- not-hint? 275 | "True if x is not hinted to be the supplied type." 276 | [x type] 277 | (if-let [hint (-> x meta :tag)] 278 | (not (isa? (eval hint) type)))) 279 | 280 | (defn- hint? 281 | "True if x is hinted to be the supplied type." 282 | [x type] 283 | (if-let [hint (-> x meta :tag)] 284 | (isa? (eval hint) type))) 285 | 286 | (defn- not-implicit-map? 287 | "True if we can infer that x is not a map." 288 | [x] 289 | (or (= (form-name x) "for") 290 | (not (unevaluated? x)) 291 | (not-hint? x java.util.Map))) 292 | 293 | (defn- element-compile-strategy 294 | "Returns the compilation strategy to use for a given element." 295 | [[tag attrs & content :as element]] 296 | (cond 297 | (every? literal? element) 298 | ::all-literal ; e.g. [:span "foo"] 299 | (and (literal? tag) (map? attrs)) 300 | ::literal-tag-and-attributes ; e.g. [:span {} x] 301 | (and (literal? tag) (not-implicit-map? attrs)) 302 | ::literal-tag-and-no-attributes ; e.g. [:span ^String x] 303 | (literal? tag) 304 | ::literal-tag ; e.g. [:span x] 305 | :else 306 | ::default)) ; e.g. [x] 307 | 308 | (declare compile-seq) 309 | 310 | (defmulti compile-element 311 | "Returns an unevaluated form that will render the supplied vector as a HTML 312 | element." 313 | {:private true} 314 | element-compile-strategy) 315 | 316 | (defmethod compile-element ::all-literal 317 | [element] 318 | (render-element (eval element))) 319 | 320 | (defmethod compile-element ::literal-tag-and-attributes 321 | [[tag attrs & content]] 322 | (let [[tag attrs _] (normalize-element-form [tag attrs])] 323 | (if (container-tag? tag content) 324 | `(build-string ~(str "<" tag) ~(compile-attr-map attrs) ">" 325 | ~@(compile-seq content) 326 | ~(str "")) 327 | `(build-string "<" ~tag ~(compile-attr-map attrs) ~(end-tag))))) 328 | 329 | (defmethod compile-element ::literal-tag-and-no-attributes 330 | [[tag & content]] 331 | (compile-element (apply vector tag {} content))) 332 | 333 | (defmethod compile-element ::literal-tag 334 | [[tag attrs-or-content & content]] 335 | (let [[tag tag-attrs _] (normalize-element-form [tag]) 336 | attrs-or-content-sym (gensym "attrs_or_content__") 337 | attrs?-sym (gensym "attrs?__") 338 | content?-sym (gensym "content?__")] 339 | `(let [~attrs-or-content-sym ~attrs-or-content 340 | ~attrs?-sym (map? ~attrs-or-content-sym) 341 | ~content?-sym (and (not ~attrs?-sym) 342 | (some? ~attrs-or-content-sym))] 343 | (build-string 344 | ;; start tag 345 | "<" ~tag 346 | (if ~attrs?-sym 347 | (render-attr-map (merge ~tag-attrs ~attrs-or-content-sym)) 348 | ~(render-attr-map tag-attrs)) 349 | ~(if (container-tag? tag content) 350 | ">" 351 | `(if ~content?-sym ">" ~(end-tag))) 352 | 353 | ;; contents 354 | (when ~content?-sym 355 | (render-html ~attrs-or-content-sym)) 356 | ~@(compile-seq content) 357 | 358 | ;; end tag 359 | ~(if (container-tag? tag content) 360 | (str "") 361 | `(when ~content?-sym 362 | ~(str ""))))))) 363 | 364 | (defmethod compile-element ::default 365 | [element] 366 | `(render-element 367 | [~(first element) 368 | ~@(for [x (rest element)] 369 | (if (vector? x) 370 | `(util/raw-string ~(compile-element x)) 371 | x))])) 372 | 373 | (defn- compile-seq 374 | "Compile a sequence of data-structures into HTML." 375 | [content] 376 | (doall (for [expr content] 377 | (cond 378 | (vector? expr) (compile-element expr) 379 | (string? expr) (escape-html expr) 380 | (keyword? expr) (escape-html (name expr)) 381 | (util/raw-string? expr) expr 382 | (literal? expr) (escape-html expr) 383 | (hint? expr String) `(escape-html ~expr) 384 | (hint? expr Number) expr 385 | (seq? expr) (compile-form expr) 386 | :else `(render-html ~expr))))) 387 | 388 | (defn- collapse-strs 389 | "Collapse nested str expressions into one, where possible." 390 | [expr] 391 | (if (seq? expr) 392 | (cons 393 | (first expr) 394 | (mapcat 395 | #(if (and (seq? %) 396 | (symbol? (first %)) 397 | (= (first %) (first expr) `build-string)) 398 | (rest (collapse-strs %)) 399 | (list (collapse-strs %))) 400 | (rest expr))) 401 | expr)) 402 | 403 | (defn compile-html 404 | "Pre-compile data structures into HTML where possible." 405 | [& content] 406 | (collapse-strs `(build-string ~@(compile-seq content)))) 407 | 408 | (defn- binding* [var val func] 409 | (push-thread-bindings {var val}) 410 | (try (func) 411 | (finally (pop-thread-bindings)))) 412 | 413 | (defn- compile-multi [var-sym vals step] 414 | (let [var (find-var var-sym) 415 | compiled-forms (->> vals 416 | (map (fn [v] [v (binding* var v step)])) 417 | (into {})) 418 | distinct-forms (->> compiled-forms 419 | (group-by second) 420 | (map (fn [[k v]] [(map first v) k])))] 421 | (cond 422 | (= (count distinct-forms) 1) 423 | (second (first distinct-forms)) 424 | (= (set vals) #{true false}) 425 | `(if ~var-sym ~(compiled-forms true) ~(compiled-forms false)) 426 | :else 427 | `(case ~var-sym ~@(apply concat distinct-forms))))) 428 | 429 | (defn compile-html-with-bindings 430 | "Pre-compile data structures into HTML where possible, while taking into 431 | account bindings that modify the result like *html-mode*." 432 | [& content] 433 | (let [step1 (fn [] (apply compile-html content)) 434 | step2 (fn [] (compile-multi `util/*escape-strings?* [true false] step1)) 435 | step3 (fn [] (compile-multi `util/*html-mode* [:html :xhtml :xml :sgml] step2))] 436 | (step3))) 437 | --------------------------------------------------------------------------------