blob: 617190d598750abe637106779294b8c27569b7c5 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
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 "<" "<")
(replace ">" ">")
(replace "\"" """)))
(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)))
|
