web/dom: xml-element as top-level class; no self-closing for standard (HTML) elements

This commit is contained in:
Helmut Merz 2024-07-21 12:01:38 +02:00
parent 464bbfde65
commit f9011dd9c6

View file

@ -4,9 +4,11 @@
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:util :scopes/util) (:local-nicknames (:util :scopes/util)
(:alx :alexandria)) (:alx :alexandria))
(:export #:elem #:element #:void-element #:render (:export #:xml-element
#:elem #:element #:void-element #:render
#:dlist #:dlist
#:div #:label)) #:a #:dd #:div #:dl #:dt #:label
#:br #:input))
(in-package :scopes/web/dom) (in-package :scopes/web/dom)
@ -17,21 +19,18 @@
(:method ((s symbol)) (put (string-downcase s))) (:method ((s symbol)) (put (string-downcase s)))
(:method ((s cons)) (dolist (e s) (put e)))) (:method ((s cons)) (dolist (e s) (put e))))
(defclass element () (defclass xml-element ()
((tag :reader tag :initarg :tag) ((tag :reader tag :initarg :tag)
(attrs :reader attrs :initarg :attrs :initform nil) (attrs :reader attrs :initarg :attrs :initform nil)
(body :reader body :initarg :body :initform nil))) (body :reader body :initarg :body :initform nil)))
(defun elem (tag &optional attrs body) (defmethod print-object ((el xml-element) stream)
(make-instance 'element :tag tag :attrs attrs :body body))
(defun element (tag attrs &rest body)
(elem tag attrs body))
(defmethod print-object ((el element) stream)
(format stream "<~a ~s>~s" (tag el) (attrs el) (body el))) (format stream "<~a ~s>~s" (tag el) (attrs el) (body el)))
(defmethod put ((el element)) (defun xml-element (tag attrs &rest body)
(make-instance 'xml-element :tag tag :attrs attrs :body body))
(defmethod put ((el xml-element))
(let ((tag (string-downcase (tag el))) (let ((tag (string-downcase (tag el)))
(body (body el))) (body (body el)))
(start tag (attrs el) :close (not body)) (start tag (attrs el) :close (not body))
@ -40,9 +39,24 @@
(put c)) (put c))
(end tag)))) (end tag))))
;;;; void element (e.g. <input ...>): no body, no explicit closing of tag ;;;; element = HTML element - no self-closing (<... />) of empty elements
(defclass void-element (element) ()) (defclass element (xml-element) ())
(defmethod put ((el element))
(let ((tag (string-downcase (tag el))))
(start tag (attrs el))
(dolist (c (body el))
(put c))
(end tag)))
(defun elem (tag &optional attrs body)
(make-instance 'element :tag tag :attrs attrs :body body))
(defun element (tag attrs &rest body)
(elem tag attrs body))
;;;; void element (e.g. <input ...>): no body, no explicit closing of tag
(defun void-element (tag attrs) (defun void-element (tag attrs)
(make-instance 'void-element :tag tag :attrs attrs)) (make-instance 'void-element :tag tag :attrs attrs))