DOM 2 Core. Ungetestet, aber die 1er tests laufen wieder, daher rein damit.

This commit is contained in:
dlichteblau
2005-12-04 18:43:49 +00:00
parent 0e994ba607
commit 74cb5b7f8c
15 changed files with 1299 additions and 811 deletions

View File

@ -12,7 +12,8 @@
(defclass dom-builder ()
((document :initform nil :accessor document)
(element-stack :initform '() :accessor element-stack)))
(element-stack :initform '() :accessor element-stack)
(internal-subset :accessor internal-subset)))
(defun dom:make-dom-builder ()
(make-instance 'dom-builder))
@ -39,26 +40,48 @@
(setf (slot-value (document handler) 'entity-resolver) resolver))
(defmethod sax:start-dtd ((handler dom-builder) name publicid systemid)
(declare (ignore publicid systemid))
(let* ((document (document handler))
(doctype (make-instance 'dom-impl::document-type
:name name
:notations (make-instance 'dom-impl::named-node-map
:element-type :notation
:owner document)
:entities (make-instance 'dom-impl::named-node-map
:element-type :entity
:owner document))))
(doctype
(dom:create-document-type 'implementation name publicid systemid)))
(setf (slot-value doctype 'dom-impl::owner) document
(slot-value (dom:notations doctype) 'dom-impl::owner) document
(slot-value (dom:entities doctype) 'dom-impl::owner) document
(slot-value document 'dom-impl::doc-type) doctype)))
(defmethod sax:start-internal-subset ((handler dom-builder))
(setf (internal-subset handler) nil))
(defmethod sax:end-internal-subset ((handler dom-builder))
(setf (internal-subset (slot-value (document handler) 'dom-impl::doc-type))
(nreverse (internal-subset handler)))
(slot-makunbound handler 'internal-subset))
(macrolet ((defhandler (name &rest args)
`(defmethod ,name ((handler dom-builder) ,@args)
(when (slot-boundp handler 'internal-subset)
(push (list ',name ,@args) (internal-subset handler))))))
(defhandler sax:unparsed-entity-declaration
name public-id system-id notation-name)
(defhandler sax:external-entity-declaration
kind name public-id system-id)
(defhandler sax:internal-entity-declaration
kind name value)
(defhandler sax:notation-declaration
name public-id system-id)
(defhandler sax:element-declaration
name model)
(defhandler sax:attribute-declaration
element-name attribute-name type default))
(defmethod sax:start-element
((handler dom-builder) namespace-uri local-name qname attributes)
(declare (ignore namespace-uri local-name))
(with-slots (document element-stack) handler
(let ((element (make-instance 'element
:tag-name qname
:owner document))
:owner document
:namespace-uri namespace-uri
:local-name local-name
:prefix (cxml::split-qname (cxml::rod qname))))
(parent (car element-stack))
(anodes '()))
(dolist (attr attributes)
@ -68,6 +91,7 @@
(dom:create-text-node document (sax:attribute-value attr))))
(setf (slot-value anode 'dom-impl::specified-p)
(sax:attribute-specified-p attr))
(setf (slot-value anode 'dom-impl::owner-element) element)
(dom:append-child anode text)
(push anode anodes)))
(setf (slot-value element 'dom-impl::parent) parent)