Merge pull request #11 from whamtet/master

added new features from hiccup
teropa · Sep 15, 2015 · feabd15 · feabd15
2 parents 3b15fe5 + 3d229e9
commit feabd15
Showing 1 changed file with 92 additions and 2 deletions.
diff --git a/src/clj/hiccups/core.clj b/src/clj/hiccups/core.clj
@@ -5,6 +5,96 @@
   (:require [hiccups.runtime :as rt])
   (:import [clojure.lang IPersistentVector ISeq]))
 
+(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 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)))
+
+(defelem 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# (dissoc ~options :xml?)]
+         (html {:mode :xml}
+           (xml-declaration (options# :encoding "UTF-8"))
+           ~(doctype :html5)
+           (xhtml-tag options# (options# :lang) ~@contents)))
+      `(let [options# (dissoc ~options :xml?)]
+         (html {:mode :html}
+           ~(doctype :html5)
+           [:html options# ~@contents])))))
+
+
 (defn- unevaluated?
   "True if the expression has not been evaluated."
   [expr]
@@ -38,7 +128,7 @@
 (defmethod compile-form "if"
   [[_ condition & body]]
  `(if ~condition ~@(for [x body] `(html ~x))))
-      
+
 (defmethod compile-form :default
   [expr]
   `(hiccups.runtime/render-html ~expr))
@@ -56,7 +146,7 @@
   (or (= (form-name x) "for")
       (not (unevaluated? x))))
 
-(defn- element-compile-strategy 
+(defn- element-compile-strategy
   "Returns the compilation strategy to use for a given element."
   [[tag attrs & content :as element]]
   (cond