From f9011dd9c6472617ebfc09ecd0e9aea3a659620f Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Sun, 21 Jul 2024 12:01:38 +0200
Subject: [PATCH] web/dom: xml-element as top-level class; no self-closing for
 standard (HTML) elements

---
 web/dom.lisp | 40 +++++++++++++++++++++++++++-------------
 1 file changed, 27 insertions(+), 13 deletions(-)

diff --git a/web/dom.lisp b/web/dom.lisp
index 24ed61c..4579a15 100644
--- a/web/dom.lisp
+++ b/web/dom.lisp
@@ -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))