web/dom: xml-element as top-level class; no self-closing for standard (HTML) elements
This commit is contained in:
parent
464bbfde65
commit
f9011dd9c6
1 changed files with 27 additions and 13 deletions
40
web/dom.lisp
40
web/dom.lisp
|
@ -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))
|
||||||
|
|
Loading…
Add table
Reference in a new issue