Meikel  Brandmeyer avatar Meikel Brandmeyer committed fc6cde6

Add hiccup (dependency for codox)

Comments (0)

Files changed (2)

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 "&"  "&")
+    (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))
+
+(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)))))
+
+(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)))

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))))))
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.