Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

absorbing hiccup as a temp fix

  • Loading branch information...
commit 220db0a23ac235bdea1217c626c9467d2e22a827 1 parent 817be16
@fogus fogus authored
Showing with 321 additions and 7 deletions.
  1. +3 −4 project.clj
  2. +316 −0 src/marginalia/hiccup.clj
  3. +2 −3 src/marginalia/html.clj
View
7 project.clj
@@ -1,18 +1,17 @@
-(defproject marginalia "0.7.1"
+(defproject marginalia "0.8.0-SNAPSHOT"
:description "lightweight literate programming for clojure -- inspired by [docco](http://jashkenas.github.com/docco/)"
;; :main marginalia.main
:dependencies
- [[org.clojure/clojure "1.3.0"]
+ [[org.clojure/clojure "1.4.0"]
[org.clojure/tools.namespace "0.1.1"]
[org.clojure/tools.cli "0.2.1"]
- [hiccup "0.3.7"]
[org.markdownj/markdownj "0.3.0-1.0.2b4"]]
:dev-dependencies
[[lein-clojars "0.6.0"]
[jline "0.9.94"]
;; lein vimclojure& #starts the nailgun server
[org.clojars.autre/lein-vimclojure "1.0.0"]
- [lein-marginalia "0.7.1"]]
+ [lein-marginalia "0.8.0-SNAPSHOT"]]
:resources-path "vendor"
;;Needed for testing Latex equation formatting. You must download
;;and install MathJax in you doc directory.
View
316 src/marginalia/hiccup.clj
@@ -0,0 +1,316 @@
+(ns marginalia.hiccup
+ "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)))
View
5 src/marginalia/html.clj
@@ -1,7 +1,6 @@
(ns marginalia.html
"Utilities for converting parse results into html."
- (:use [hiccup.core :only (html escape-html)]
- [hiccup.page-helpers :only (doctype)])
+ (:use [marginalia.hiccup :only (html escape-html)])
(:require [clojure.string :as str])
(:import [com.petebevin.markdown MarkdownProcessor]))
@@ -347,7 +346,7 @@
saying that all this is WIP and will prabably change in the future."
[project-metadata opt-resources header toc content]
(html
- (doctype :html5)
+ "<!DOCTYPE html>\n"
[:html
[:head
[:meta {:http-equiv "Content-Type" :content "text/html" :charset "utf-8"}]
Please sign in to comment.
Something went wrong with that request. Please try again.