web/dom: more pre-defined elemnts; simplify dlist accordingly

This commit is contained in:
Helmut Merz 2024-07-21 11:49:40 +02:00
parent 64dea8453d
commit 464bbfde65

View file

@ -40,6 +40,8 @@
(put c)) (put c))
(end tag)))) (end tag))))
;;;; void element (e.g. <input ...>): no body, no explicit closing of tag
(defclass void-element (element) ()) (defclass void-element (element) ())
(defun void-element (tag attrs) (defun void-element (tag attrs)
@ -48,27 +50,32 @@
(defmethod put ((el void-element)) (defmethod put ((el void-element))
(start (tag el) (attrs el))) (start (tag el) (attrs el)))
;;;; automatically define standard HTML elements
(defmacro make-elements (tags &optional (elem-fn 'elem)) (defmacro make-elements (tags &optional (elem-fn 'elem))
`(progn `(progn
,@(mapcar (lambda (tag) ;`(make-element ,tag)) tags))) ,@(mapcar (lambda (tag) ;`(make-element ,tag)) tags)))
`(defun ,tag (attrs &rest body) `(defun ,tag (attrs &rest body)
(funcall #',elem-fn ',tag attrs body))) (funcall (function ,elem-fn) ',tag attrs body)))
tags))) tags)))
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(make-elements (div label))) (make-elements (a dd div dl dt label)))
(eval-when (:compile-toplevel :load-toplevel :execute)
(make-elements (br input) :void-element))
;;;; elements with specific functionality ;;;; elements with specific functionality
(defun dlist (attrs plist) (defun dlist (attrs plist)
(elem :dl attrs (dl attrs
(util:loop-plist plist key val append (util:loop-plist plist key val append
(cons (element :dt nil (string-downcase key)) (dds nil val))))) (cons (dt nil (string-downcase key)) (dds nil val)))))
(defun dds (attrs cont) (defun dds (attrs cont)
(if (atom cont) (if (atom cont)
(list (element :dd attrs cont)) (list (dd attrs cont))
(mapcar #'(lambda (x) (element :dd nil x)) cont))) (mapcar #'(lambda (x) (dd nil x)) cont)))
;;;; rendering ;;;; rendering
@ -84,8 +91,8 @@
(put-string tag) (put-string tag)
(put-attrs attrs) (put-attrs attrs)
(if close (if close
(put-char #\/)) (put-string " />")
(put-char #\>)) (put-char #\>)))
(defun end (tag) (defun end (tag)
(put-string "</") (put-string "</")