|
9 | 9 | (:export #:element |
10 | 10 | #:tag |
11 | 11 | #:html-tag |
| 12 | + #:self-closing-tag |
| 13 | + #:non-escaping-tag |
12 | 14 | #:fragment |
13 | 15 | #:component |
14 | 16 | #:create-element |
|
36 | 38 |
|
37 | 39 | (defclass html-tag (tag) ()) |
38 | 40 |
|
| 41 | +(defclass self-closing-tag (tag) ()) |
| 42 | + |
| 43 | +(defclass non-escaping-tag (tag) ()) |
| 44 | + |
39 | 45 | (defclass fragment (tag) ()) |
40 | 46 |
|
41 | 47 | (defclass component (element) ()) |
|
47 | 53 | (cond ((functionp type) 'component) |
48 | 54 | ((eq type :<>) 'fragment) |
49 | 55 | ((eq type :html) 'html-tag) |
| 56 | + ((self-closing-tag-p type) 'self-closing-tag) |
| 57 | + ((non-escaping-tag-p type) 'non-escaping-tag) |
50 | 58 | ((keywordp type) 'tag) |
51 | 59 | (t (error "element-type must be a keyword or a function."))) |
52 | 60 | :type type |
|
69 | 77 | (write element :stream stream :pretty pretty))) |
70 | 78 |
|
71 | 79 | (defmethod print-object ((element tag) stream) |
72 | | - (with-accessors ((type element-type) |
73 | | - (props element-props) |
74 | | - (children element-children)) element |
| 80 | + (with-slots (type props children) element |
75 | 81 | (let ((type-str (string-downcase type)) |
76 | 82 | (props-str (render-props props))) |
77 | 83 | (if children |
|
82 | 88 | "~@<<~a~a>~2I~:_~<~a~^~:@_~:>~0I~_</~a>~:>") |
83 | 89 | type-str |
84 | 90 | props-str |
85 | | - (escape-children type children) |
| 91 | + (render-children element) |
86 | 92 | type-str) |
87 | | - (format stream |
88 | | - (if (self-closing-tag-p type) |
89 | | - "<~a~a>" |
90 | | - "<~a~a></~a>") |
91 | | - type-str |
92 | | - props-str |
93 | | - type-str))))) |
| 93 | + (format stream "<~a~a></~a>" type-str props-str type-str))))) |
| 94 | + |
| 95 | +(defmethod print-object ((element self-closing-tag) stream) |
| 96 | + (with-slots (type props) element |
| 97 | + (format stream "<~a~a>" (string-downcase type) (render-props props)))) |
94 | 98 |
|
95 | 99 | (defun render-props (props) |
96 | 100 | (with-output-to-string (stream) |
|
106 | 110 | key-str |
107 | 111 | (escape-html-attribute value))))))) |
108 | 112 |
|
109 | | -(defun escape-children (type children) |
| 113 | +(defmethod render-children ((element tag)) |
110 | 114 | (mapcar (lambda (child) |
111 | | - (if (and (not (non-escaping-tag-p type)) |
112 | | - (stringp child)) |
| 115 | + (if (stringp child) |
113 | 116 | (escape-html-text-content child) |
114 | 117 | child)) |
115 | | - children)) |
| 118 | + (element-children element))) |
| 119 | + |
| 120 | +(defmethod render-children ((element non-escaping-tag)) |
| 121 | + (element-children element)) |
116 | 122 |
|
117 | 123 | (defmethod print-object ((element html-tag) stream) |
118 | 124 | (format stream "<!DOCTYPE html>~%") |
119 | 125 | (call-next-method)) |
120 | 126 |
|
121 | 127 | (defmethod print-object ((element fragment) stream) |
122 | | - (with-accessors ((children element-children)) element |
| 128 | + (with-slots (children) element |
123 | 129 | (if children |
124 | 130 | (format stream |
125 | 131 | (if (rest children) |
|
131 | 137 | (print-object (expand-component element) stream)) |
132 | 138 |
|
133 | 139 | (defmethod expand-component ((element component)) |
134 | | - (with-accessors ((type element-type) |
135 | | - (props element-props) |
136 | | - (children element-children)) element |
| 140 | + (with-slots (type props children) element |
137 | 141 | (apply type (merge-children-into-props props children)))) |
138 | 142 |
|
139 | 143 | (defun merge-children-into-props (props children) |
|
0 commit comments