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)
(:local-nicknames (:util :scopes/util)
(:alx :alexandria))
(:export #:elem #:element #:void-element #:render
(:export #:xml-element
#:elem #:element #:void-element #:render
#:dlist
#:div #:label))
#:a #:dd #:div #:dl #:dt #:label
#:br #:input))
(in-package :scopes/web/dom)
@ -17,21 +19,18 @@
(:method ((s symbol)) (put (string-downcase s)))
(:method ((s cons)) (dolist (e s) (put e))))
(defclass element ()
(defclass xml-element ()
((tag :reader tag :initarg :tag)
(attrs :reader attrs :initarg :attrs :initform nil)
(body :reader body :initarg :body :initform nil)))
(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))
(defmethod print-object ((el element) stream)
(defmethod print-object ((el xml-element) stream)
(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)))
(body (body el)))
(start tag (attrs el) :close (not body))
@ -40,9 +39,24 @@
(put c))
(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)
(make-instance 'void-element :tag tag :attrs attrs))