-
Notifications
You must be signed in to change notification settings - Fork 0
/
dom.lisp
94 lines (72 loc) · 2.09 KB
/
dom.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
(defpackage dom
(:use cl)
(:export *node* <a> <body> <head> <html> <new-node> <node> text write-html))
(in-package dom)
(defvar *node* nil)
(defstruct node
(tag (error "Missing tag") :type keyword)
(children nil :type list)
(attrs nil :type list))
(defun new-node (tag &rest attrs)
(labels ((parse-attrs (in out)
(if in
(let ((k (pop in)) (v (pop in)))
(parse-attrs in (cons (cons k v) out)))
(nreverse out))))
(make-node :tag tag :attrs (parse-attrs attrs nil))))
(defun indent-html (level out)
(dotimes (i level)
(write-string " " out)))
(defmethod write-html ((val node) &key (level 0) (out *standard-output*) (pretty? t))
(with-slots (tag children attrs) val
(when pretty?
(indent-html level out))
(format out "<~a" tag)
(unless (null attrs)
(dolist (a attrs)
(format out " ~a=\"~a\"" (string-downcase (symbol-name (first a))) (rest a))))
(if (null children)
(progn
(format out "/>")
(when pretty?
(terpri out)))
(progn
(format out ">")
(when pretty?
(terpri out))
(dolist (cn (reverse children))
(write-html cn :level (1+ level) :out out :pretty? pretty?))
(when pretty?
(indent-html level out))
(format out "</~a>" tag)
(when pretty?
(terpri out))))))
(defmethod write-html ((val string) &key (level 0) (out *standard-output*) (pretty? t))
(when pretty?
(indent-html level out))
(write-string val out)
(when pretty?
(terpri out)))
(defmethod print-object ((val node) out)
(write-html val :out out))
(defun text (child)
(push child (node-children *node*)))
(defmacro with-node ((&rest args) &body body)
`(let ((p *node*)
(*node* (new-node ,@args)))
(when p
(push *node* (node-children p)))
,@body
*node*))
(defmacro <html> (&body body)
`(macrolet ((<head> (&body body)
`(with-node (:head)
,@body))
(<body> (&body body)
`(with-node (:body)
(macrolet ((<a> ((&rest attrs &key href) &body body)
`(with-node (:a ,@attrs)
,@body)))
,@body))))
(with-node (:html)
,@body)))