-
Notifications
You must be signed in to change notification settings - Fork 0
/
jhtml.lisp
133 lines (109 loc) · 4.04 KB
/
jhtml.lisp
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
125
126
127
128
129
130
131
132
133
;;;; jhtml.lisp
(in-package #:jhtml)
;;; Variables
(defparameter *special-rules* ())
(defparameter *output-stream* () "The stream to output to. By default returns string.")
;;; Special rules
(defun special-rule-p (symbol)
(find symbol *special-rules*))
(defmacro define-special-rule (name arglist &body body)
"Define a rule for a specific type of lists. The rest of the list are used
as arguments to the function. The defined rule should return a string.
Example:
(define-special-rule doctype (&optional (type \"html\"))
(format nil \"<!DOCTYPE ~A>\" type))
(jhtml '(doctype)) ;=> \"<!DOCTYPE html>\"
(jhtml '(doctype \"something else\")) ;=> \"<!DOCTYPE something else>\"
"
`(progn
(unless (special-rule-p ',name)
(push ',name *special-rules*))
(defun ,name ,arglist
,@body)))
;;; Void elements (self-enclosing tags)
(defun void-element-definition (name)
`(define-special-rule ,name (&rest args)
(format nil "<~A~{ ~A=\"~A\"~}>" (string-downcase ',name) (strip-attributes args))))
(defmacro define-void-elements (&rest elements)
"Define self-closing tags.
Example:
(define-void-elements img link meta)
Now <img> <link> and <meta> elements won't have the respective </img>, </link>
and </meta> tags."
`(progn
,@ (mapcar #'void-element-definition elements)))
;;; Escapes
(defvar *html-escapes*
'(#\> ">"
#\< "<"
#\& "&"
#\" """))
(defun escape (str)
(declare (string str))
(with-output-to-string (stream)
(loop for ch across str
for escaped = (getf *html-escapes* ch)
do (if escaped
(write-string escaped stream)
(write-char ch stream)))))
;;; List to html
(defun string-value (element)
(etypecase element
(null "")
(number (write-to-string element))
(string (escape element))
(cons (transform-tree-element element))))
(defun jhtml-helper (sexp)
(declare (type cons sexp))
(multiple-value-bind (attrs sexp) (strip-attributes sexp)
(when (consp (car sexp))
(return-from jhtml-helper (format nil "~{~A~}" (mapcar #'string-value sexp))))
(let ((element (string-downcase (car sexp)))
(contents (mapcar #'string-value (cdr sexp))))
(format nil "<~A~{ ~A=\"~A\"~}>~{~A~}</~3:*~A>" element attrs contents))))
(defun strip-attributes (list)
(do (attrs clean-sexp
(list list (cdr list)))
((null list)
(values (nreverse attrs) (nreverse clean-sexp)))
(let ((first (first list)) (second (second list)))
(if (keywordp first)
(setf attrs (list* second first attrs)
list (cdr list))
(push first clean-sexp)))))
(defun transform-tree-element (list)
(when (null (car list)) (return-from transform-tree-element ""))
(let ((special-rule (special-rule-p (car list))))
(if special-rule
(apply special-rule (cdr list))
(jhtml-helper (or list (cdr list))))))
(defun jhtml (&rest lists)
"Converts `lists' to an HTML string.
The first element of every list has to be a symbol, of any package.
The rest can be any combination of keyword-string pairs, strings or
new lists.
If the first element isn't part of a special rule, it gets treated
like some ordinary html tag name. If it is, the function associated
with the special rule is called and the string it returns is inserted.
See `define-special-rule'.
Example usage:
(jhtml:jhtml
'(doctype)
`(html
(head
(link :rel \"stylesheet\" :type \"text/css\" :href \"/path/to/styles.css\")
(title \"My Webpage\"))
(body
(h1 \"Heading\")
(hr)
(p :class \"article body\"
,(server:get-latest-article)))))
Other usage ideas would be to create template functions that return lists,
which then one would pass to jhtml."
(format *output-stream* "~{~A~}" (mapcar #'transform-tree-element lists)))
(defun to-string (&rest lists)
"Output html to string. Useful to avoid unnecessary binding of
`*output-stream*' to nil in contexts where it's bound to a different
value, but the user needs a string, for any reason."
(let ((*output-stream* nil))
(apply #'jhtml lists)))