Commits

Meikel Brandmeyer committed e615b9f

Move hiccup to v1.0.0

Comments (0)

Files changed (7)

runtime/src/main/resources/clojuresque/hiccup/compiler.clj

+(ns clojuresque.hiccup.compiler
+  "Internal functions for compilation."
+  (:use clojuresque.hiccup.util)
+  (:import [clojure.lang IPersistentVector ISeq]))
+
+(def ^:dynamic *html-mode* :xml)
+
+(defn- xml-mode? []
+  (= *html-mode* :xml))
+
+(defn- end-tag []
+  (if (xml-mode?) " />" ">"))
+
+(defn- xml-attribute [name value]
+  (str " " (as-str name) "=\"" (escape-html value) "\""))
+
+(defn- render-attribute [[name value]]
+  (cond
+    (true? value)
+      (if (xml-mode?)
+        (xml-attribute name name)
+        (str " " (as-str name)))
+    (not value)
+      ""
+    :else
+      (xml-attribute name value)))
+
+(defn- render-attr-map [attrs]
+  (apply str
+    (sort (map render-attribute attrs))))
+
+(def ^{:doc "Regular expression that parses a CSS-style id and class from an element name."
+       :private true}
+  re-tag #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?")
+
+(def ^{:doc "A list of elements that need an explicit ending tag when rendered."
+       :private true}
+  container-tags
+  #{"a" "b" "body" "canvas" "dd" "div" "dl" "dt" "em" "fieldset" "form" "h1" "h2" "h3"
+    "h4" "h5" "h6" "head" "html" "i" "iframe" "label" "li" "ol" "option" "pre" 
+    "script" "span" "strong" "style" "table" "textarea" "title" "ul"})
+
+(defn normalize-element
+  "Ensure an element vector is of the form [tag-name attrs content]."
+  [[tag & content]]
+  (when (not (or (keyword? tag) (symbol? tag) (string? tag)))
+    (throw (IllegalArgumentException. (str tag " is not a valid element name."))))
+  (let [[_ tag id class] (re-matches re-tag (as-str tag))
+        tag-attrs        {:id id
+                          :class (if class (.replace ^String class "." " "))}
+        map-attrs        (first content)]
+    (if (map? map-attrs)
+      [tag (merge tag-attrs map-attrs) (next content)]
+      [tag tag-attrs content])))
+
+(defmulti render-html
+  "Turn a Clojure data type into a string of HTML."
+  {:private true}
+  type)
+
+(defn- render-element
+  "Render an element vector as a HTML element."
+  [element]
+  (let [[tag attrs content] (normalize-element element)]
+    (if (or content (container-tags tag))
+      (str "<" tag (render-attr-map attrs) ">"
+           (render-html content)
+           "</" tag ">")
+      (str "<" tag (render-attr-map attrs) (end-tag)))))
+
+(defmethod render-html IPersistentVector
+  [element]
+  (render-element element))
+
+(defmethod render-html ISeq [coll]
+  (apply str (map render-html coll)))
+
+(defmethod render-html :default [x]
+  (as-str x))
+
+(defn- unevaluated?
+  "True if the expression has not been evaluated."
+  [expr]
+  (or (symbol? expr)
+      (and (seq? expr)
+           (not= (first expr) `quote))))
+
+(defn compile-attr-map
+  "Returns an unevaluated form that will render the supplied map as HTML
+  attributes."
+  [attrs]
+  (if (some unevaluated? (mapcat identity attrs))
+    `(#'render-attr-map ~attrs)
+    (render-attr-map attrs)))
+
+(defn- form-name
+  "Get the name of the supplied form."
+  [form]
+  (if (and (seq? form) (symbol? (first form)))
+    (name (first form))))
+
+(declare compile-html)
+
+(defmulti compile-form
+  "Pre-compile certain standard forms, where possible."
+  {:private true}
+  form-name)
+
+(defmethod compile-form "for"
+  [[_ bindings body]]
+  `(apply str (for ~bindings ~(compile-html body))))
+
+(defmethod compile-form "if"
+  [[_ condition & body]]
+  `(if ~condition ~@(for [x body] (compile-html x))))
+
+(defmethod compile-form :default
+  [expr]
+  `(#'render-html ~expr))
+
+(defn- not-hint?
+  "True if x is not hinted to be the supplied type."
+  [x type]
+  (if-let [hint (-> x meta :tag)]
+    (not (isa? (eval hint) type))))
+
+(defn- hint?
+  "True if x is hinted to be the supplied type."
+  [x type]
+  (if-let [hint (-> x meta :tag)]
+    (isa? (eval hint) type)))
+
+(defn- literal?
+  "True if x is a literal value that can be rendered as-is."
+  [x]
+  (and (not (unevaluated? x))
+       (or (not (or (vector? x) (map? x)))
+           (every? literal? x))))
+
+(defn- not-implicit-map?
+  "True if we can infer that x is not a map."
+  [x]
+  (or (= (form-name x) "for")
+      (not (unevaluated? x))
+      (not-hint? x java.util.Map)))
+
+(defn- element-compile-strategy
+  "Returns the compilation strategy to use for a given element."
+  [[tag attrs & content :as element]]
+  (cond
+    (every? literal? element)
+      ::all-literal                    ; e.g. [:span "foo"]
+    (and (literal? tag) (map? attrs))
+      ::literal-tag-and-attributes     ; e.g. [:span {} x]
+    (and (literal? tag) (not-implicit-map? attrs))
+      ::literal-tag-and-no-attributes  ; e.g. [:span ^String x]
+    (literal? tag)
+      ::literal-tag                    ; e.g. [:span x]
+    :else
+      ::default))                      ; e.g. [x]
+
+(declare compile-seq)
+
+(defmulti compile-element
+  "Returns an unevaluated form that will render the supplied vector as a HTML
+  element."
+  {:private true}
+  element-compile-strategy)
+
+(defmethod compile-element ::all-literal
+  [element]
+  (render-element (eval element)))
+
+(defmethod compile-element ::literal-tag-and-attributes
+  [[tag attrs & content]]
+  (let [[tag attrs _] (normalize-element [tag attrs])]
+    (if (or content (container-tags tag))
+      `(str ~(str "<" tag) ~(compile-attr-map attrs) ">"
+            ~@(compile-seq content)
+            ~(str "</" tag ">"))
+      `(str "<" ~tag ~(compile-attr-map attrs) ~(end-tag)))))
+
+(defmethod compile-element ::literal-tag-and-no-attributes
+  [[tag & content]]
+  (compile-element (apply vector tag {} content)))
+
+(defmethod compile-element ::literal-tag
+  [[tag attrs & content]]
+  (let [[tag tag-attrs _] (normalize-element [tag])
+        attrs-sym         (gensym "attrs")]
+    `(let [~attrs-sym ~attrs]
+       (if (map? ~attrs-sym)
+         ~(if (or content (container-tags tag))
+            `(str ~(str "<" tag)
+                  (#'render-attr-map (merge ~tag-attrs ~attrs-sym)) ">"
+                  ~@(compile-seq content)
+                  ~(str "</" tag ">"))
+            `(str ~(str "<" tag)
+                  (#'render-attr-map (merge ~tag-attrs ~attrs-sym))
+                  ~(end-tag)))
+         ~(if (or attrs (container-tags tag))
+            `(str ~(str "<" tag (render-attr-map tag-attrs) ">")
+                  ~@(compile-seq (cons attrs-sym content))
+                  ~(str "</" tag ">"))
+            (str "<" tag (render-attr-map tag-attrs) (end-tag)))))))
+
+(defmethod compile-element :default
+  [element]
+  `(#'render-element
+     [~(first element)
+      ~@(for [x (rest element)]
+          (if (vector? x)
+            (compile-element x)
+            x))]))
+
+(defn- compile-seq
+  "Compile a sequence of data-structures into HTML."
+  [content]
+  (doall (for [expr content]
+           (cond
+            (vector? expr) (compile-element expr)
+            (literal? expr) expr
+            (hint? expr String) expr
+            (hint? expr Number) expr
+            (seq? expr) (compile-form expr)
+            :else `(#'render-html ~expr)))))
+
+(defn- collapse-strs
+  "Collapse nested str expressions into one, where possible."
+  [expr]
+  (if (seq? expr)
+    (cons
+     (first expr)
+     (mapcat
+      #(if (and (seq? %) (symbol? (first %)) (= (first %) (first expr) `str))
+         (rest (collapse-strs %))
+         (list (collapse-strs %)))
+      (rest expr)))
+    expr))
+
+(defn compile-html
+  "Pre-compile data structures into HTML where possible."
+  [& content]
+  (collapse-strs `(str ~@(compile-seq content))))

runtime/src/main/resources/clojuresque/hiccup/core.clj

 (ns clojuresque.hiccup.core
   "Library for rendering a tree of vectors into a string of HTML.
   Pre-compiles where possible for performance."
-  (:import [clojure.lang IPersistentVector ISeq]
-           java.net.URI))
-
-;; Pulled from old-contrib to avoid dependency
-(defn as-str
-  ([] "")
-  ([x] (if (instance? clojure.lang.Named x)
-         (name x)
-         (str x)))
-  ([x & ys]
-     ((fn [^StringBuilder sb more]
-        (if more
-          (recur (. sb  (append (as-str (first more)))) (next more))
-          (str sb)))
-      (new StringBuilder ^String (as-str x)) ys)))
-
-(def ^:dynamic *html-mode* :xml)
-
-(defn escape-html
-  "Change special characters into HTML character entities."
-  [text]
-  (.. ^String (as-str text)
-    (replace "&"  "&amp;")
-    (replace "<"  "&lt;")
-    (replace ">"  "&gt;")
-    (replace "\"" "&quot;")))
-
-(def h escape-html)  ; alias for escape-html
-
-(defn- xml-mode? []
-  (= *html-mode* :xml))
-
-(defn- end-tag []
-  (if (xml-mode?) " />" ">"))
-
-(defn- xml-attribute [name value]
-  (str " " (as-str name) "=\"" (escape-html value) "\""))
-
-(defn- render-attribute [[name value]]
-  (cond
-    (true? value)
-      (if (xml-mode?)
-        (xml-attribute name name)
-        (str " " (as-str name)))
-    (not value)
-      ""
-    :else
-      (xml-attribute name value)))
-
-(defn- render-attr-map [attrs]
-  (apply str
-    (sort (map render-attribute attrs))))
-
-(def ^{:doc "Regular expression that parses a CSS-style id and class from a tag name." :private true}
-  re-tag #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?")
-
-(def ^{:doc "A list of tags that need an explicit ending tag when rendered." :private true}
-  container-tags
-  #{"a" "b" "body" "canvas" "dd" "div" "dl" "dt" "em" "fieldset" "form" "h1" "h2" "h3"
-    "h4" "h5" "h6" "head" "html" "i" "iframe" "label" "li" "ol" "option" "pre" 
-    "script" "span" "strong" "style" "table" "textarea" "ul"})
-
-(defn- normalize-element
-  "Ensure a tag vector is of the form [tag-name attrs content]."
-  [[tag & content]]
-  (when (not (or (keyword? tag) (symbol? tag) (string? tag)))
-    (throw (IllegalArgumentException. (str tag " is not a valid tag name."))))
-  (let [[_ tag id class] (re-matches re-tag (as-str tag))
-        tag-attrs        {:id id
-                          :class (if class (.replace ^String class "." " "))}
-        map-attrs        (first content)]
-    (if (map? map-attrs)
-      [tag (merge tag-attrs map-attrs) (next content)]
-      [tag tag-attrs content])))
-
-(defmulti render-html
-  "Turn a Clojure data type into a string of HTML."
-  {:private true}
-  type)
-
-(defn- render-element
-  "Render an tag vector as a HTML element."
-  [element]
-  (let [[tag attrs content] (normalize-element element)]
-    (if (or content (container-tags tag))
-      (str "<" tag (render-attr-map attrs) ">"
-           (render-html content)
-           "</" tag ">")
-      (str "<" tag (render-attr-map attrs) (end-tag)))))
-
-(defmethod render-html IPersistentVector
-  [element]
-  (render-element element))
-
-(defmethod render-html ISeq [coll]
-  (apply str (map render-html coll)))
-
-(defmethod render-html :default [x]
-  (as-str x))
-
-(defn- unevaluated?
-  "True if the expression has not been evaluated."
-  [expr]
-  (or (symbol? expr)
-      (and (seq? expr)
-           (not= (first expr) `quote))))
-
-(defn compile-attr-map
-  "Returns an unevaluated form that will render the supplied map as HTML
-  attributes."
-  [attrs]
-  (if (some unevaluated? (mapcat identity attrs))
-    `(#'render-attr-map ~attrs)
-    (render-attr-map attrs)))
-
-(defn- form-name
-  "Get the name of the supplied form."
-  [form]
-  (if (and (seq? form) (symbol? (first form)))
-    (name (first form))))
-
-(defmulti compile-form
-  "Pre-compile certain standard forms, where possible."
-  {:private true}
-  form-name)
-
-(defmethod compile-form "for"
-  [[_ bindings body]]
-  `(apply str (for ~bindings (html ~body))))
-
-(defmethod compile-form "if"
-  [[_ condition & body]]
-  `(if ~condition ~@(for [x body] `(html ~x))))
-
-(defmethod compile-form :default
-  [expr]
-  `(#'render-html ~expr))
-
-(defn- not-hint?
-  "True if x is not hinted to be the supplied type."
-  [x type]
-  (if-let [hint (-> x meta :tag)]
-    (not (isa? (eval hint) type))))
-
-(defn- hint?
-  "True if x is hinted to be the supplied type."
-  [x type]
-  (if-let [hint (-> x meta :tag)]
-    (isa? (eval hint) type)))
-
-(defn- literal?
-  "True if x is a literal value that can be rendered as-is."
-  [x]
-  (and (not (unevaluated? x))
-       (or (not (or (vector? x) (map? x)))
-           (every? literal? x))))
-
-(defn- not-implicit-map?
-  "True if we can infer that x is not a map."
-  [x]
-  (or (= (form-name x) "for")
-      (not (unevaluated? x))
-      (not-hint? x java.util.Map)))
-
-(defn- element-compile-strategy
-  "Returns the compilation strategy to use for a given element."
-  [[tag attrs & content :as element]]
-  (cond
-    (every? literal? element)
-      ::all-literal                    ; e.g. [:span "foo"]
-    (and (literal? tag) (map? attrs))
-      ::literal-tag-and-attributes     ; e.g. [:span {} x]
-    (and (literal? tag) (not-implicit-map? attrs))
-      ::literal-tag-and-no-attributes  ; e.g. [:span ^String x]
-    (literal? tag)
-      ::literal-tag                    ; e.g. [:span x]
-    :else
-      ::default))                      ; e.g. [x]
-
-(declare compile-html)
-
-(defmulti compile-element
-  "Returns an unevaluated form that will render the supplied vector as a HTML
-  element."
-  {:private true}
-  element-compile-strategy)
-
-(defmethod compile-element ::all-literal
-  [element]
-  (render-element (eval element)))
-
-(defmethod compile-element ::literal-tag-and-attributes
-  [[tag attrs & content]]
-  (let [[tag attrs _] (normalize-element [tag attrs])]
-    (if (or content (container-tags tag))
-      `(str ~(str "<" tag) ~(compile-attr-map attrs) ">"
-            ~@(compile-html content)
-            ~(str "</" tag ">"))
-      `(str "<" ~tag ~(compile-attr-map attrs) ~(end-tag)))))
-
-(defmethod compile-element ::literal-tag-and-no-attributes
-  [[tag & content]]
-  (compile-element (apply vector tag {} content)))
-
-(defmethod compile-element ::literal-tag
-  [[tag attrs & content]]
-  (let [[tag tag-attrs _] (normalize-element [tag])
-        attrs-sym         (gensym "attrs")]
-    `(let [~attrs-sym ~attrs]
-       (if (map? ~attrs-sym)
-         ~(if (or content (container-tags tag))
-            `(str ~(str "<" tag)
-                  (#'render-attr-map (merge ~tag-attrs ~attrs-sym)) ">"
-                  ~@(compile-html content)
-                  ~(str "</" tag ">"))
-            `(str ~(str "<" tag)
-                  (#'render-attr-map (merge ~tag-attrs ~attrs-sym))
-                  ~(end-tag)))
-         ~(if (or attrs (container-tags tag))
-            `(str ~(str "<" tag (render-attr-map tag-attrs) ">")
-                  ~@(compile-html (cons attrs-sym content))
-                  ~(str "</" tag ">"))
-            (str "<" tag (render-attr-map tag-attrs) (end-tag)))))))
-
-(defmethod compile-element :default
-  [element]
-  `(#'render-element
-     [~(first element)
-      ~@(for [x (rest element)]
-          (if (vector? x)
-            (compile-element x)
-            x))]))
-
-(defn- compile-html
-  "Pre-compile data structures into HTML where possible."
-  [content]
-  (doall (for [expr content]
-           (cond
-            (vector? expr) (compile-element expr)
-            (literal? expr) expr
-            (hint? expr String) expr
-            (hint? expr Number) expr
-            (seq? expr) (compile-form expr)
-            :else `(#'render-html ~expr)))))
-
-(defn- collapse-strs
-  "Collapse nested str expressions into one, where possible."
-  [expr]
-  (if (seq? expr)
-    (cons
-     (first expr)
-     (mapcat
-      #(if (and (seq? %) (symbol? (first %)) (= (first %) (first expr) `str))
-         (rest (collapse-strs %))
-         (list (collapse-strs %)))
-      (rest expr)))
-    expr))
+  (:use clojuresque.hiccup.compiler
+        clojuresque.hiccup.util))
 
 (defmacro html
   "Render Clojure data structures to a string of HTML."
   [options & content]
-  (letfn [(make-html [content]
-           (collapse-strs `(str ~@(compile-html content))))]
-    (if-let [mode (and (map? options) (:mode options))]
-      (binding [*html-mode* mode]
-        `(binding [*html-mode* ~mode]
-           ~(make-html content)))
-      (make-html (cons options content)))))
+  (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)))
 
-(defmacro defhtml
-  "Define a function, but wrap its output in an implicit html macro."
-  [name & fdecl]
-  (let [[fhead fbody] (split-with #(not (or (list? %) (vector? %))) fdecl)
-        wrap-html (fn [[args & body]] `(~args (html ~@body)))]
-    `(defn ~name
-       ~@fhead
-       ~@(if (vector? (first fbody))
-           (wrap-html fbody)
-           (map wrap-html fbody)))))
-
-(defn add-optional-attrs
-  "Add an optional attribute argument to a function that returns a vector tag."
-  [func]
-  (fn [& args]
-    (if (map? (first args))
-      (let [[tag & body] (apply func (rest args))]
-        (if (map? (first body))
-          (apply vector tag (merge (first body) (first args)) (rest body))
-          (apply vector tag (first args) body)))
-      (apply func args))))
-
-(defmacro defelem
-  "Defines a function that will return a tag vector. If the first argument
-  passed to the resulting function is a map, it merges it with the attribute
-  map of the returned tag value."
-  [name & fdecl]
-  `(do (defn ~name ~@fdecl)
-       (alter-var-root (var ~name) add-optional-attrs)))
-
-(def ^:dynamic *base-url* nil)
-
-(defmacro with-base-url
-  "Add a base-url that will be added to the output of the resolve-uri function."
-  [base-url & body]
-  `(binding [*base-url* ~base-url]
-     ~@body))
-
-(defn resolve-uri
-  "Prepends the base-url to the supplied URI."
-  [uri]
-  (if (.isAbsolute (URI. uri))
-    uri
-    (str *base-url* uri)))
+(def ^{:doc "Alias for hiccup.util/escape-html"}
+  h escape-html)

runtime/src/main/resources/clojuresque/hiccup/def.clj

+(ns clojuresque.hiccup.def
+  "Macros for defining functions that generate HTML"
+  (:use clojuresque.hiccup.core))
+
+(defmacro defhtml
+  "Define a function, but wrap its output in an implicit html macro."
+  [name & fdecl]
+  (let [[fhead fbody] (split-with #(not (or (list? %) (vector? %))) fdecl)
+        wrap-html     (fn [[args & body]] `(~args (html ~@body)))]
+    `(defn ~name
+       ~@fhead
+       ~@(if (vector? (first fbody))
+           (wrap-html fbody)
+           (map wrap-html fbody)))))
+
+(defn wrap-attrs
+  "Add an optional attribute argument to a function that returns a element vector."
+  [func]
+  (fn [& args]
+    (if (map? (first args))
+      (let [[tag & body] (apply func (rest args))]
+        (if (map? (first body))
+          (apply vector tag (merge (first body) (first args)) (rest body))
+          (apply vector tag (first args) body)))
+      (apply func args))))
+
+(defn- update-arglists [arglists]
+  (for [args arglists]
+    (vec (cons 'attr-map? args))))
+
+(defmacro defelem
+  "Defines a function that will return a element vector. If the first argument
+  passed to the resulting function is a map, it merges it with the attribute
+  map of the returned element value."
+  [name & fdecl]
+  `(do (defn ~name ~@fdecl)
+       (alter-meta! (var ~name) update-in [:arglists] #'update-arglists)
+       (alter-var-root (var ~name) wrap-attrs)))

runtime/src/main/resources/clojuresque/hiccup/element.clj

+(ns clojuresque.hiccup.element
+  "Functions for creating HTML elements."
+  (:use clojuresque.hiccup.def
+        clojuresque.hiccup.util))
+
+(defn javascript-tag
+  "Wrap the supplied javascript up in script tags and a CDATA section."
+  [script]
+  [:script {:type "text/javascript"}
+    (str "//<![CDATA[\n" script "\n//]]>")])
+
+(defelem link-to
+  "Wraps some content in a HTML hyperlink with the supplied URL."
+  [url & content]
+  [:a {:href (to-uri url)} content])
+
+(defelem mail-to
+  "Wraps some content in a HTML hyperlink with the supplied e-mail
+  address. If no content provided use the e-mail address as content."
+  [e-mail & [content]]
+  [:a {:href (str "mailto:" e-mail)}
+   (or content e-mail)])
+
+(defelem unordered-list
+  "Wrap a collection in an unordered list."
+  [coll]
+  [:ul (for [x coll] [:li x])])
+
+(defelem ordered-list
+  "Wrap a collection in an ordered list."
+  [coll]
+  [:ol (for [x coll] [:li x])])
+
+(defelem image
+  "Create an image element."
+  ([src]     [:img {:src (to-uri src)}])
+  ([src alt] [:img {:src (to-uri src), :alt alt}]))
+

runtime/src/main/resources/clojuresque/hiccup/page.clj

+(ns clojuresque.hiccup.page
+  "Functions for setting up HTML pages."
+  (:use clojuresque.hiccup.core 
+        clojuresque.hiccup.util))
+
+(def doctype
+  {:html4
+   (str "<!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")
+   :xhtml-transitional
+   (str "<!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"})
+
+(defn xhtml-tag
+  "Create an XHTML element for the specified language."
+  [lang & contents]
+  [:html {:xmlns "http://www.w3.org/1999/xhtml"
+          "xml:lang" lang
+          :lang lang}
+    contents])
+
+(defn xml-declaration
+  "Create a standard XML declaration for the following encoding."
+  [encoding]
+  (str "<?xml version=\"1.0\" encoding=\"" encoding "\"?>\n"))
+
+(defmacro html4
+  "Create a HTML 4 document with the supplied contents. The first argument
+  may be an optional attribute map."
+  [& contents]
+  `(html {:mode :sgml}
+     (doctype :html4)
+     [:html ~@contents]))
+
+(defmacro xhtml
+  "Create a XHTML 1.0 strict document with the supplied contents. The first
+  argument may be an optional attribute may. The following attributes are
+  treated specially:
+    :lang     - The language of the document
+    :encoding - The character encoding of the document, defaults to UTF-8."
+  [options & contents]
+  (if-not (map? options)
+    `(xhtml {} ~options ~@contents)
+    `(let [options# ~options]
+       (html {:mode :xml}
+         (xml-declaration (options# :encoding "UTF-8"))
+         (doctype :xhtml-strict)
+         (xhtml-tag (options# :lang) ~@contents)))))
+
+(defmacro html5
+  "Create a HTML5 document with the supplied contents."
+  [options & contents]
+  (if-not (map? options)
+    `(html5 {} ~options ~@contents)
+    (if (options :xml?)
+      `(let [options# ~options]
+         (html {:mode :xml}
+           (xml-declaration (options# :encoding "UTF-8"))
+           (doctype :html5)
+           (xhtml-tag (options# :lang) ~@contents)))
+      `(let [options# ~options]
+         (html {:mode :html}
+           (doctype :html5)
+           [:html {:lang (options# :lang)} ~@contents])))))
+
+(defn include-js
+  "Include a list of external javascript files."
+  [& scripts]
+  (for [script scripts]
+    [:script {:type "text/javascript", :src (to-uri script)}]))
+
+(defn include-css
+  "Include a list of external stylesheet files."
+  [& styles]
+  (for [style styles]
+    [:link {:type "text/css", :href (to-uri style), :rel "stylesheet"}]))

runtime/src/main/resources/clojuresque/hiccup/page_helpers.clj

-(ns clojuresque.hiccup.page-helpers
-  "Functions for generating various common elements."
-  (:import java.net.URLEncoder)
-  (:use [clojuresque.hiccup.core :only (defelem html resolve-uri as-str)])
-  (:require [clojure.string :as str]))
-
-(def doctype
-  {:html4
-   (str "<!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")
-   :xhtml-transitional
-   (str "<!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"})
-
-(defn xhtml-tag
-  "Create an XHTML tag for the specified language."
-  [lang & contents]
-  [:html {:xmlns "http://www.w3.org/1999/xhtml"
-          "xml:lang" lang
-          :lang lang}
-    contents])
-
-(defn xml-declaration
-  "Create a standard XML declaration for the following encoding."
-  [encoding]
-  (str "<?xml version=\"1.0\" encoding=\"" encoding "\"?>\n"))
-
-(defmacro html4
-  "Create a HTML 4 document with the supplied contents. The first argument
-  may be an optional attribute map."
-  [& contents]
-  `(html {:mode :sgml}
-     (doctype :html4)
-     [:html ~@contents]))
-
-(defmacro xhtml
-  "Create a XHTML 1.0 strict document with the supplied contents. The first
-  argument may be an optional attribute may. The following attributes are
-  treated specially:
-    :lang     - The language of the document
-    :encoding - The character encoding of the document, defaults to UTF-8."
-  [options & contents]
-  (if-not (map? options)
-    `(xhtml {} ~options ~@contents)
-    `(let [options# ~options]
-       (html {:mode :xml}
-         (xml-declaration (options# :encoding "UTF-8"))
-         (doctype :xhtml-strict)
-         (xhtml-tag (options# :lang) ~@contents)))))
-
-(defmacro html5
-  "Create a HTML5 document with the supplied contents."
-  [options & contents]
-  (if-not (map? options)
-    `(html5 {} ~options ~@contents)
-    (if (options :xml?)
-      `(let [options# ~options]
-         (html {:mode :xml}
-           (xml-declaration (options# :encoding "UTF-8"))
-           (doctype :html5)
-           (xhtml-tag (options# :lang) ~@contents)))
-      `(let [options# ~options]
-         (html {:mode :html}
-           (doctype :html5)
-           [:html {:lang (options# :lang)} ~@contents])))))
-
-(defn include-js
-  "Include a list of external javascript files."
-  [& scripts]
-  (for [script scripts]
-    [:script {:type "text/javascript", :src (resolve-uri script)}]))
-
-(defn include-css
-  "Include a list of external stylesheet files."
-  [& styles]
-  (for [style styles]
-    [:link {:type "text/css", :href (resolve-uri style), :rel "stylesheet"}]))
-
-(defn javascript-tag
-  "Wrap the supplied javascript up in script tags and a CDATA section."
-  [script]
-  [:script {:type "text/javascript"}
-    (str "//<![CDATA[\n" script "\n//]]>")])
-
-(defelem link-to
-  "Wraps some content in a HTML hyperlink with the supplied URL."
-  [url & content]
-  [:a {:href (resolve-uri url)} content])
-
-(defelem mail-to
-  "Wraps some content in a HTML hyperlink with the supplied e-mail
-  address. If no content provided use the e-mail address as content."
-  [e-mail & [content]]
-  [:a {:href (str "mailto:" e-mail)}
-   (or content e-mail)])
-
-(defelem unordered-list
-  "Wrap a collection in an unordered list"
-  [coll]
-  [:ul (for [x coll] [:li x])])
-
-(defelem ordered-list
-  "Wrap a collection in an ordered list"
-  [coll]
-  [:ol (for [x coll] [:li x])])
-
-(defelem image
-  "Create an image tag"
-  ([src]     [:img {:src (resolve-uri src)}])
-  ([src alt] [:img {:src (resolve-uri src), :alt alt}]))
-
-(def
- #^{:doc "Name of the default encoding to use .
-  Default is UTF-8."
-    :tag "java.lang.String"
-    :dynamic true}
- *default-encoding* "UTF-8")
-
-(defmacro with-encoding
-  "Evaluates expr with encoding."
-  [encoding & body]
-  `(binding [*default-encoding* ~encoding]
-     ~@body))
-
-(defn encode [s]
-  "urlencode"
-  (URLEncoder/encode (as-str s) *default-encoding*))
-
-(defn encode-params
-  "Turn a map of parameters into a urlencoded string."
-  [params]
-  (str/join "&"
-    (for [[k v] params]
-      (str (encode k) "=" (encode v)))))
-
-(defn url
-  "Creates a URL string from a variable list of arguments and an optional
-  parameter map as the last argument. For example:
-    (url \"/group/\" 4 \"/products\" {:page 9})
-    => \"/group/4/products?page=9\""
-  [& args]
-  (let [params (last args)
-        args   (butlast args)]
-    (str
-      (resolve-uri
-        (str (apply str args)
-             (if (map? params)
-               (str "?" (encode-params params))
-               params))))))

runtime/src/main/resources/clojuresque/hiccup/util.clj

+(ns clojuresque.hiccup.util
+  "Utility functions for Hiccup."
+  (:require [clojure.string :as str])
+  (:import java.net.URI
+           java.net.URLEncoder))
+
+(def ^:dynamic *base-url* nil)
+
+(defmacro with-base-url
+  "Sets a base URL that will be prepended onto relative URIs. Note that for this
+  to work correctly, it needs to be placed outside the html macro."
+  [base-url & body]
+  `(binding [*base-url* ~base-url]
+     ~@body))
+
+(defprotocol ToString
+  (^String to-str [x] "Convert a value into a string."))
+
+(extend-protocol ToString
+  clojure.lang.Keyword
+  (to-str [k] (name k))
+  clojure.lang.Ratio
+  (to-str [r] (str (float r)))
+  java.net.URI
+  (to-str [u]
+    (if (or (.isAbsolute u)
+            (not (-> (.getPath u) (.startsWith "/"))))
+      (str u)
+      (str *base-url* u)))
+  Object
+  (to-str [x] (str x))
+  nil
+  (to-str [_] ""))
+
+(defn ^String as-str
+  "Converts its arguments into a string using to-str."
+  [& xs]
+  (apply str (map to-str xs)))
+
+(defprotocol ToURI
+  (^URI to-uri [x] "Convert a value into a URI."))
+
+(extend-protocol ToURI
+  java.net.URI
+  (to-uri [u] u)
+  String
+  (to-uri [s] (URI. s)))
+
+(defn escape-html
+  "Change special characters into HTML character entities."
+  [text]
+  (.. ^String (as-str text)
+    (replace "&"  "&amp;")
+    (replace "<"  "&lt;")
+    (replace ">"  "&gt;")
+    (replace "\"" "&quot;")))
+
+(def ^:dynamic *encoding* "UTF-8")
+
+(defmacro with-encoding
+  "Sets a default encoding for URL encoding strings. Defaults to UTF-8."
+  [encoding & body]
+  `(binding [*encoding* ~encoding]
+     ~@body))
+
+(defprotocol URLEncode
+  (url-encode [x] "Turn a value into a URL-encoded string."))
+
+(extend-protocol URLEncode
+  String
+  (url-encode [s] (URLEncoder/encode s *encoding*))
+  java.util.Map
+  (url-encode [m]
+    (str/join "&"
+      (for [[k v] m]
+        (str (url-encode k) "=" (url-encode v)))))
+  Object
+  (url-encode [x] (url-encode (to-str x))))
+
+(defn url
+  "Creates a URL string from a variable list of arguments and an optional
+  parameter map as the last argument. For example:
+    (url \"/group/\" 4 \"/products\" {:page 9})
+    => \"/group/4/products?page=9\""
+  [& args]
+  (let [params (last args), args (butlast args)]
+    (to-uri
+     (str (apply str args)
+          (if (map? params)
+            (str "?" (url-encode params))
+            params)))))
+
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.