Added custom compojure tree

3 files changed, 396 insertions, 0 deletions

diff --git a/compojure-3.2/src/compojure/html/form_helpers.clj b/compojure-3.2/src/compojure/html/form_helpers.clj
new file mode 100755
index 0000000..9da2ef9
--- /dev/null
+++ b/compojure-3.2/src/compojure/html/form_helpers.clj
@@ -0,0 +1,169 @@
+;; Copyright (c) James Reeves. All rights reserved.
+;; The use and distribution terms for this software are covered by the Eclipse
+;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which
+;; can be found in the file epl-v10.html at the root of this distribution. By
+;; using this software in any fashion, you are agreeing to be bound by the
+;; terms of this license. You must not remove this notice, or any other, from
+;; this software.
+
+(ns compojure.html.form-helpers
+  "Functions for generating HTML forms and input fields."
+  (:use compojure.html.gen
+        compojure.control
+        compojure.str-utils
+        clojure.contrib.def
+        clojure.contrib.seq-utils))
+
+;; Global parameters for easy default values
+
+(defvar *params* {}
+  "Parameter map var that form input field functions use to populate their
+  default values.")
+
+(defmacro with-params
+  "Bind a map of params to *params*."
+  [params & body]
+  `(binding [*params* ~params]
+    ~@body))
+
+;; Form input fields
+
+(defn- input-field
+  "Creates a form input field."
+  [type name value]
+  (let [name  (str* name)
+        attrs {:type type, :name name, :id name}
+        attrs (if value
+                (assoc attrs :value value)
+                attrs)]
+    [:input attrs]))
+
+(defn hidden-field
+  "Creates a hidden input field."
+  ([name]       (hidden-field name (*params* name)))
+  ([name value] (input-field "hidden" name value)))
+
+(defn text-field
+  "Creates a text input field."
+  ([name]       (text-field name (*params* name)))
+  ([name value] (input-field "text" name value)))
+
+(defn password-field
+  "Creates a password input field."
+  [name]
+  (input-field "password" name ""))
+
+(defn check-box
+  "Creates a check box."
+  ([name]
+    (check-box name (*params* name)))
+  ([name checked?]
+    (check-box name checked? "true"))
+  ([name checked? value]
+    [:input {:type    "checkbox"
+             :name    (str* name)
+             :id      (str* name)
+             :value   value
+             :checked checked?}]))
+
+(defn radio-button
+ "Creates a radio button."
+ ([group]
+    (radio-button group (*params* group)))
+ ([group checked?]
+    (radio-button group checked? "true"))
+ ([group checked? value]
+    [:input {:type    "radio"
+             :name    (str* group)
+             :id      (str* group "_" value)
+             :value   value
+             :checked checked?}]))
+
+(defn select-options
+  "Turn a collection into a set of option tags."
+  ([options]
+    (select-options options nil))
+  ([options selected]
+    (let [select (fn [opt attrs]
+                   (if (and selected (= opt (str* selected)))
+                     (merge attrs {:selected "selected"})
+                     attrs))]
+      (domap [opt options]
+        (if (vector? opt)
+          (let [text  (opt 0)
+                value (str* (opt 1))]
+            [:option (select value {:value value}) text])
+          [:option (select opt {}) opt])))))
+
+(defn drop-down
+  "Creates a drop-down box using the 'select' tag."
+  ([name options]
+    (drop-down name options (*params* name)))
+  ([name options selected]
+    [:select {:name (str* name) :id (str* name)}
+      (select-options options selected)]))
+
+(defn text-area
+  "Creates a text area element."
+  ([name]
+    (text-area name (*params* name)))
+  ([name value]
+    [:textarea {:name (str* name) :id (str* name)} value]))
+
+(defn file-upload
+  "Creates a file upload input."
+  [name]
+  [:input {:type "file", :name (str* name), :id (str* name)}])
+
+(defn label
+  "Create a label for an input field with the supplied name."
+  [name text]
+  [:label {:for (str* name)} text])
+
+(defn submit-button
+  "Create a submit button."
+  [text]
+  [:input {:type "submit" :value text}])
+
+(defn reset-button
+  "Create a form reset button."
+  [text]
+  [:input {:type "reset" :value text}])
+
+(defn form-to
+  "Create a form that points to a particular method and route.
+  e.g. (form-to [:put \"/post\"]
+         ...)"
+  [[method action] & body]
+  (let [method-str (upcase-name method)]
+    (into []
+      (concat
+        (if (includes? [:get :post] method)
+          [:form {:method method-str :action action}]
+          [:form {:method "POST" :action action}
+           (hidden-field "_method" method-str)])
+        body))))
+
+(decorate-with optional-attrs
+  hidden-field
+  text-field
+  check-box
+  drop-down
+  text-area
+  file-upload
+  label
+  submit-button
+  reset-button
+  form-to)
+
+(defmacro decorate-fields
+  "Wrap all input field functions in a decorator."
+  [decorator & body]
+  `(decorate-bind ~decorator
+     [text-field
+      password-field
+      check-box
+      drop-down
+      text-area
+      file-upload]
+    (list ~@body)))
diff --git a/compojure-3.2/src/compojure/html/gen.clj b/compojure-3.2/src/compojure/html/gen.clj
new file mode 100755
index 0000000..617190d
--- /dev/null
+++ b/compojure-3.2/src/compojure/html/gen.clj
@@ -0,0 +1,124 @@
+;; Copyright (c) James Reeves. All rights reserved.
+;; The use and distribution terms for this software are covered by the Eclipse
+;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which
+;; can be found in the file epl-v10.html at the root of this distribution. By
+;; using this software in any fashion, you are agreeing to be bound by the
+;; terms of this license. You must not remove this notice, or any other, from
+;; this software.
+
+(ns compojure.html.gen
+  "A library for generating HTML output from a tree of vectors. The first item
+   of the vector is the tag name, the optional second item is a hash of
+   attributes, and the rest is the body of the tag."
+  (:use compojure.str-utils
+        clojure.contrib.def))
+
+(defn optional-attrs
+  "Adds an optional attribute map to the supplied function's arguments."
+  [func]
+  (fn [attrs & body]
+    (if (map? attrs)
+      (let [[tag func-attrs & body] (apply func body)]
+        (apply vector tag (merge func-attrs attrs) body))
+      (apply func attrs body))))
+
+(defn escape-html
+  "Change special characters into HTML character entities."
+  [string]
+  (.. (str string)
+    (replace "&"  "&")
+    (replace "<"  "&lt;")
+    (replace ">"  "&gt;")
+    (replace "\"" "&quot;")))
+
+(defvar h escape-html
+  "Shortcut for escape-html")
+
+(defn- map-to-attrs
+  "Turn a map into a string of HTML attributes, sorted by attribute name."
+  [attrs]
+  (map-str
+    (fn [[key val]]
+      (if key
+        (str " " key "=\"" (h val) "\"")))
+    (sort
+      (map (fn [[key val]]
+             (cond
+               (true? val) [(str* key) (str* key)]
+               (not val)   [nil nil]
+               :else       [(str* key) (str* val)]))
+           attrs))))
+
+(defn- create-tag
+  "Wrap some content in an HTML tag."
+  [tag attrs content]
+  (str* "<" tag (map-to-attrs attrs) ">"
+          content
+        "</" tag ">"))
+
+(defn- create-closed-tag
+  "Make a closed XML tag with no content."
+  [tag attrs]
+  (str* "<" tag (map-to-attrs attrs) " />"))
+
+(defn- expand-seqs
+  "Expand out all the sequences in a collection."
+  [coll]
+  (mapcat
+    #(if (or (seq? %) (nil? %))
+       %
+       (list %))
+    coll))
+
+(defn- ensure-attrs
+  "Ensure the tag has a map of attributes."
+  [[tag & body]]
+  (if (map? (first body))
+    (list* tag body)
+    (list* tag {} body)))
+
+(defvar- css-lexer #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?")
+
+(defn- parse-css-tag
+  "Pulls the id and class attributes from a tag name formatted in a CSS style.
+  e.g. :div#content -> [:div  {:id \"content\"}]
+       :span.error  -> [:span {:class \"error\"}]"
+  [tag attrs]
+  (let [[_ tag id classes] (re-matches css-lexer (str* tag))
+        attrs (merge attrs
+                (if id {:id id})
+                (if classes
+                  {:class (.replace classes "." " ")}))]
+    [tag attrs]))
+
+(declare html)
+
+(defvar- container-tags
+  #{:a :b :body :dd :div :dl :dt :em :fieldset :form :h1 :h2 :h3 :h4 :h5 :h6
+    :head :html :i :label :li :ol :pre :script :span :strong :style :textarea
+    :ul}
+  "A list of tags that need an explicit ending tag when rendered.")
+
+(defn explicit-ending-tag?
+  "Returns true if tag needs an explicit ending tag, even if the body of the
+  tag is empty."
+  [tag]
+  (container-tags (keyword (str* tag))))
+
+(defn html-tree
+  "Turns a tree of vectors into a string of HTML. Any sequences in the
+  tree are expanded out."
+  [tree]
+  (if (vector? tree)
+    (let [[tag attrs & body] (ensure-attrs tree)
+          [tag attrs]        (parse-css-tag tag attrs)
+          body               (expand-seqs body)]
+      (if (or (seq body) (explicit-ending-tag? tag))
+        (create-tag tag attrs (apply html body))
+        (create-closed-tag tag attrs)))
+    (str tree)))
+
+(defn html
+  "Format trees of vectors into a string of HTML."
+  [& trees]
+  (map-str html-tree (expand-seqs trees)))
diff --git a/compojure-3.2/src/compojure/html/page_helpers.clj b/compojure-3.2/src/compojure/html/page_helpers.clj
new file mode 100755
index 0000000..8c10e30
--- /dev/null
+++ b/compojure-3.2/src/compojure/html/page_helpers.clj
@@ -0,0 +1,103 @@
+;; Copyright (c) James Reeves. All rights reserved.
+;; The use and distribution terms for this software are covered by the Eclipse
+;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which
+;; can be found in the file epl-v10.html at the root of this distribution. By
+;; using this software in any fashion, you are agreeing to be bound by the
+;; terms of this license. You must not remove this notice, or any other, from
+;; this software.
+
+(ns compojure.html.page-helpers
+  "Functions for generating document and header boilerplate."
+  (:use compojure.control
+        compojure.html.gen
+        compojure.str-utils
+        clojure.contrib.str-utils)
+  (:import java.net.URLEncoder))
+
+(def doctype
+  {:html4
+   (str "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\" "
+        "\"http://www.w3.org/TR/html4/strict.dtd\">\n")
+
+   :html5
+   (str "<!DOCTYPE html>")
+
+   :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")})
+
+(defn xhtml-tag
+  "Create an XHTML tag for the specified locale.
+   e.g. (xhtml \"en\"
+          [:head ...]
+          [:body ...])"
+  [lang & contents]
+  [:html {:xmlns "http://www.w3.org/1999/xhtml"
+          "xml:lang" lang
+          :lang lang}
+    contents])
+
+(defn include-js
+  "Include a list of external javascript files."
+  [& scripts]
+  (domap [script scripts]
+    [:script {:type "text/javascript" :src script}]))
+
+(defn include-css
+  "Include a list of external stylesheet files."
+  [& styles]
+  (domap [style styles]
+    [:link {:type "text/css" :href 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//]]>")])
+
+(defn link-to
+  "Wraps some content in a HTML hyperlink with the supplied URL."
+  [url & content]
+  [:a {:href url} content])
+
+(defn url-encode
+  "Encodes a single string or sequence of key/value pairs."
+  [string-or-map]
+  (let [enc #(URLEncoder/encode (str* %))]
+    (if (string? string-or-map)
+      (enc string-or-map)
+      (str-join "&"
+        (map (fn [[key val]] (str (enc key) "=" (enc val)))
+             string-or-map)))))
+
+(defn url-params
+  "Encodes a map of parameters and adds them onto the end of an existing
+  address.
+  e.g. (url-params \"http://example.com\" {:lang \"en\", :offset 10})
+       => \"http://example.com?lang=en&offset=10\""
+  [address param-map]
+  (str address "?" (url-encode param-map)))
+
+(defn unordered-list
+  "Wrap a collection in an unordered list"
+  [coll]
+  [:ul {}
+    (domap [x coll]
+      [:li x])])
+
+(defn ordered-list
+  "Wrap a collection in an unordered list"
+  [coll]
+  [:ol {}
+    (domap [x coll]
+      [:li x])])
+
+(decorate-with optional-attrs
+  xhtml-tag
+  link-to
+  unordered-list
+  ordered-list)