Update of /project/cxml/cvsroot/cxml/dom In directory common-lisp.net:/tmp/cvs-serv22921/dom

Modified Files: dom-builder.lisp dom-impl.lisp dom-sax.lisp package.lisp unparse.lisp Removed Files: simple-dom.lisp string-dom.lisp Log Message: DOM 2 Core. Ungetestet, aber die 1er tests laufen wieder, daher rein damit.

Date: Sun Dec 4 19:43:56 2005 Author: dlichteblau

Index: cxml/dom/dom-builder.lisp diff -u cxml/dom/dom-builder.lisp:1.3 cxml/dom/dom-builder.lisp:1.4 --- cxml/dom/dom-builder.lisp:1.3 Mon Nov 28 23:33:33 2005 +++ cxml/dom/dom-builder.lisp Sun Dec 4 19:43:54 2005 @@ -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)

Index: cxml/dom/dom-impl.lisp diff -u cxml/dom/dom-impl.lisp:1.4 cxml/dom/dom-impl.lisp:1.5 --- cxml/dom/dom-impl.lisp:1.4 Mon Nov 28 23:33:33 2005 +++ cxml/dom/dom-impl.lisp Sun Dec 4 19:43:56 2005 @@ -8,7 +8,8 @@ ;;;; Author: knowledgeTools Int. GmbH

(defpackage :dom-impl - (:use :cl :runes)) + (:use :cl :runes) + (:export #:create-document))

(in-package :dom-impl)

@@ -33,6 +34,15 @@ (read-only-p :initform nil :reader read-only-p) (map :initform nil)))

+(defmethod dom:prefix ((node node)) nil) +(defmethod dom:local-name ((node node)) nil) +(defmethod dom:namespace-uri ((node node)) nil) + +(defclass namespace-mixin () + ((prefix :initarg :prefix :reader dom:prefix) + (local-name :initarg :local-name :reader dom:local-name) + (namespace-uri :initarg :namespace-uri :reader dom:namespace-uri))) + (defclass document (node) ((doc-type :initarg :doc-type :reader dom:doctype) (dtd :initform nil :reader dtd) @@ -44,8 +54,9 @@ (defclass character-data (node) ((value :initarg :data :reader dom:data)))

-(defclass attribute (node) +(defclass attribute (namespace-mixin node) ((name :initarg :name :reader dom:name) + (owner-element :initarg :owner-element :reader dom:owner-element) (specified-p :initarg :specified-p :reader dom:specified)))

(defmethod print-object ((object attribute) stream) @@ -54,7 +65,7 @@ (rod-string (dom:name object)) (rod-string (dom:value object)))))

-(defclass element (node) +(defclass element (namespace-mixin node) ((tag-name :initarg :tag-name :reader dom:tag-name) (attributes :initarg :attributes :reader dom:attributes)))

@@ -73,8 +84,11 @@

(defclass document-type (node) ((name :initarg :name :reader dom:name) + (public-id :initarg :public-id :reader dom:public-id) + (system-id :initarg :system-id :reader dom:system-id) (entities :initarg :entities :reader dom:entities) - (notations :initarg :notations :reader dom:notations))) + (notations :initarg :notations :reader dom:notations) + (internal-subset :accessor internal-subset)))

(defclass notation (node) ((name :initarg :name :reader dom:name) @@ -176,6 +190,45 @@ (:NOT_SUPPORTED_ERR 9) (:INUSE_ATTRIBUTE_ERR 10)))

+;; dom-implementation protocol + +(defmethod dom:has-feature ((factory (eql 'implementation)) feature version) + (and (or (string-equal (rod-string feature) "xml") + (string-equal (rod-string feature) "core")) + (or (string-equal (rod-string version) "1.0") + (string-equal (rod-string version) "2.0")))) + +(defmethod dom:create-document-type + ((factory (eql 'implementation)) name publicid systemid) + (make-instance 'dom-impl::document-type + :name name + :notations (make-instance 'dom-impl::named-node-map + :element-type :notation + :owner nil) + :entities (make-instance 'dom-impl::named-node-map + :element-type :entity + :owner nil) + :public-id publicid + :system-id systemid)) + +(defmethod dom:create-document + ((factory (eql 'implementation)) uri qname doctype) + (let ((document (make-instance 'dom-impl::document))) + (setf (slot-value document 'owner) nil + (slot-value document 'doc-type) doctype + (slot-value document 'namespace-uri) uri) + (setf (values (slot-value document 'prefix) + (slot-value document 'local-name)) + (safe-split-qname qname uri)) + (when doctype + (unless (typep doctype 'document-type) + (dom-error :WRONG_DOCUMENT_ERR + "doctype was created by a different dom implementation")) + (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)) + document)) + ;; document-fragment protocol ;; document protocol

@@ -191,8 +244,11 @@ (setf tag-name (rod tag-name)) (unless (cxml::valid-name-p tag-name) (dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string tag-name))) - (let ((result (make-instance 'element + (let ((result (make-instance 'element :tag-name tag-name + :namespace-uri nil + :local-name nil + :prefix nil :owner document))) (setf (slot-value result 'attributes) (make-instance 'attribute-node-map @@ -202,6 +258,41 @@ (add-default-attributes result) result))

+(defun safe-split-qname (qname uri) + (unless (cxml::valid-name-p qname) + (dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string qname))) + (multiple-value-bind (prefix local-name) + (handler-case + (cxml::split-qname qname) + (cxml:well-formedness-violation (c) + (dom-error :NAMESPACE_ERR "~A" c))) + (when prefix + (when (and (rod= prefix "xml") + (not (rod= uri "http://www.w3.org/XML/1998/namespace"))) + (dom-error :NAMESPACE_ERR "invalid uri for prefix `xml'")) + (when (and (rod= prefix "xmlns") + (not (rod= uri "http://www.w3.org/2000/xmlns/"))) + (dom-error :NAMESPACE_ERR "invalid uri for prefix `xmlns'"))) + (values prefix local-name))) + +(defmethod dom:create-element-ns ((document document) uri qname) + (setf qname (rod qname)) + (multiple-value-bind (prefix local-name) + (safe-split-qname qname uri) + (let ((result (make-instance 'element + :tag-name qname + :namespace-uri uri + :local-name local-name + :prefix prefix + :owner document))) + (setf (slot-value result 'attributes) + (make-instance 'attribute-node-map + :element-type :attribute + :owner document + :element result)) + (add-default-attributes result) + result))) + (defmethod dom:create-document-fragment ((document document)) (make-instance 'document-fragment :owner document)) @@ -240,9 +331,25 @@ (dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string name))) (make-instance 'attribute :name name + :local-name nil + :prefix nil + :namespace-uri nil :specified-p t :owner document))

+(defmethod dom:create-attribute-ns ((document document) uri qname) + (setf uri (rod uri)) + (setf qname (rod qname)) + (multiple-value-bind (prefix local-name) + (safe-split-qname qname uri) + (make-instance 'attribute + :name qname + :namespace-uri uri + :local-name local-name + :prefix prefix + :specified-p t + :owner document))) + (defmethod dom:create-entity-reference ((document document) name) (setf name (rod name)) (unless (cxml::valid-name-p name) @@ -253,23 +360,66 @@

(defmethod get-elements-by-tag-name-internal (node tag-name) (setf tag-name (rod tag-name)) - (let ((result (make-node-list))) - (setf tag-name (rod tag-name)) - (let ((wild-p (rod= tag-name '#.(string-rod "*")))) - (labels ((walk (n) - (dovector (c (dom:child-nodes n)) - (when (dom:element-p c) - (when (or wild-p (rod= tag-name (dom:node-name c))) - (vector-push-extend c result (extension result))) - (walk c))))) - (walk node))) + (let ((result (make-node-list)) + (wild-p (rod= tag-name '#.(string-rod "*")))) + (labels ((walk (n) + (dovector (c (dom:child-nodes n)) + (when (dom:element-p c) + (when (or wild-p (rod= tag-name (dom:node-name c))) + (vector-push-extend c result (extension result))) + (walk c))))) + (walk node)) + result)) + +(defmethod get-elements-by-tag-name-internal-ns (node uri lname) + (setf uri (rod uri)) + (setf lname (rod lname)) + (let ((result (make-node-list)) + (wild-uri-p (rod= uri '#.(string-rod "*"))) + (wild-lname-p (rod= lname '#.(string-rod "*")))) + (labels ((walk (n) + (dovector (c (dom:child-nodes n)) + (when (dom:element-p c) + (when (and (or wild-lname-p (rod= lname (dom:local-name c))) + (or wild-uri-p (rod= uri (dom:namespace-uri c)))) + (vector-push-extend c result (extension result))) + (walk c))))) + (walk node)) result))

(defmethod dom:get-elements-by-tag-name ((document document) tag-name) (get-elements-by-tag-name-internal document tag-name))

+(defmethod dom:get-elements-by-tag-name-ns ((document document) uri lname) + (get-elements-by-tag-name-internal-ns document uri lname)) + +(defmethod dom:get-element-by-id ((document document) id) + (block nil + (unless (dtd document) + (return nil)) + (setf id (rod id)) + (labels ((walk (n) + (dovector (c (dom:child-nodes n)) + (when (dom:element-p c) + (let ((e (cxml::find-element + (cxml::rod (dom:tag-name c)) + (dtd document)))) + (when e + (dolist (a (cxml::elmdef-attributes e)) + (when (eq :ID (cxml::attdef-type a)) + (let* ((name (rod (cxml::attdef-name a))) + (value (dom:get-attribute c name))) + (when (and value (rod= value id)) + (return c))))))) + (walk c))))) + (walk document)))) + + ;;; Node

+(defmethod dom:is-supported ((node node) feature version) + (dom:has-feature 'implementation feature version)) + (defmethod dom:parent-node ((node node)) (slot-value node 'parent))

@@ -544,29 +694,50 @@ (setf name (rod name)) (with-slots (items) self (dolist (k items nil) - (cond ((rod= name (dom:node-name k)) - (return k)))))) + (when (rod= name (dom:node-name k)) + (return k)))))

-(defmethod dom:set-named-item ((self named-node-map) arg) - (assert-writeable self) - (unless (eq (dom:node-type arg) (slot-value self 'element-type)) +(defmethod dom:get-named-item-ns ((self named-node-map) uri lname) + (setf uri (rod uri)) + (setf lname (rod lname)) + (with-slots (items) self + (dolist (k items nil) + (when (and (equal uri (dom:namespace-uri k)) + (equal lname (dom:local-name k))) + (return k))))) + +(defun %set-named-item (map arg test) + (assert-writeable map) + (unless (eq (dom:node-type arg) (slot-value map 'element-type)) (dom-error :HIERARCHY_REQUEST_ERR "~S cannot adopt ~S, since it is not of type ~S." - self arg (slot-value self 'element-type))) - (unless (eq (dom:owner-document self) (dom:owner-document arg)) + map arg (slot-value map 'element-type))) + (unless (eq (dom:owner-document map) (dom:owner-document arg)) (dom-error :WRONG_DOCUMENT_ERR "~S cannot adopt ~S, since it was created by a different document." - self arg)) + map arg)) (let ((old-map (slot-value arg 'map))) - (when (and old-map (not (eq old-map self))) + (when (and old-map (not (eq old-map map))) (dom-error :INUSE_ATTRIBUTE_ERR "Attribute node already mapped" arg))) - (setf (slot-value arg 'map) self) + (setf (slot-value arg 'map) map) + (with-slots (items) map + (dolist (k items (progn (setf items (cons arg items)) nil)) + (when (funcall test k) + (setf items (cons arg (delete k items))) + (return k))))) + +(defmethod dom:set-named-item ((self named-node-map) arg) (let ((name (dom:node-name arg))) - (with-slots (items) self - (dolist (k items (progn (setf items (cons arg items))nil)) - (cond ((rod= name (dom:node-name k)) - (setf items (cons arg (delete k items))) - (return k))))))) + (%set-named-item self arg (lambda (k) (rod= name (dom:node-name k)))))) + +(defmethod dom:set-named-item-ns ((self named-node-map) arg) + (let ((uri (dom:namespace-uri arg)) + (lname (dom:local-name arg))) + (%set-named-item self + arg + (lambda (k) + (and (rod= lname (dom:local-name k)) + (rod= uri (dom:namespace-uri k)))))))

(defmethod dom:remove-named-item ((self named-node-map) name) (assert-writeable self) @@ -577,6 +748,18 @@ (setf items (delete k items)) (return k))))))

+(defmethod dom:remove-named-item-ns ((self named-node-map) uri lname) + (assert-writeable self) + (setf uri (rod uri)) + (setf lname (rod lname)) + (with-slots (items) self + (dolist (k items + (dom-error :NOT_FOUND_ERR "~A not found in ~A" lname self)) + (when (and (rod= lname (dom:local-name k)) + (rod= uri (dom:namespace-uri k))) + (setf items (delete k items)) + (return k))))) + (defmethod dom:length ((self named-node-map)) (with-slots (items) self (length items))) @@ -743,6 +926,15 @@

;;; ELEMENT

+(defmethod dom:has-attributes ((element element)) + (plusp (length (dom:items (dom:attributes element))))) + +(defmethod dom:has-attribute ((element element) name) + (and (dom:get-named-item (dom:attributes element) name) t)) + +(defmethod dom:has-attribute-ns ((element element) uri lname) + (and (dom:get-named-item-ns (dom:attributes element) uri lname) t)) + (defmethod dom:get-attribute-node ((element element) name) (dom:get-named-item (dom:attributes element) name))

@@ -750,24 +942,51 @@ (assert-writeable element) (dom:set-named-item (dom:attributes element) new-attr))

+(defmethod dom:get-attribute-node-ns ((element element) uri lname) + (dom:get-named-item-ns (dom:attributes element) uri lname)) + +(defmethod dom:set-attribute-node-ns ((element element) (new-attr attribute)) + (assert-writeable element) + (dom:set-named-item-ns (dom:attributes element) new-attr)) + (defmethod dom:get-attribute ((element element) name) (let ((a (dom:get-attribute-node element name))) (if a (dom:value a) #.(string-rod ""))))

+(defmethod dom:get-attribute-ns ((element element) uri lname) + (let ((a (dom:get-attribute-node-ns element uri lname))) + (if a + (dom:value a) + #.(string-rod "")))) + (defmethod dom:set-attribute ((element element) name value) (assert-writeable element) (with-slots (owner) element (let ((attr (dom:create-attribute owner name))) + (setf (slot-value attr 'owner-element) element) (setf (dom:value attr) value) (dom:set-attribute-node element attr)) (values)))

+(defmethod dom:set-attribute-ns ((element element) uri lname value) + (assert-writeable element) + (with-slots (owner) element + (let ((attr (dom:create-attribute-ns owner uri lname))) + (setf (slot-value attr 'owner-element) element) + (setf (dom:value attr) value) + (dom:set-attribute-node-ns element attr)) + (values))) + (defmethod dom:remove-attribute ((element element) name) (assert-writeable element) (dom:remove-attribute-node element (dom:get-attribute-node element name)))

+(defmethod dom:remove-attribute-ns ((elt element) uri lname) + (assert-writeable elt) + (dom:remove-attribute-node elt (dom:get-attribute-node-ns elt uri lname))) + (defmethod dom:remove-attribute-node ((element element) (old-attr attribute)) (assert-writeable element) (with-slots (items) (dom:attributes element) @@ -781,14 +1000,18 @@

(defun maybe-add-default-attribute (element name) (let* ((dtd (dtd (slot-value element 'owner))) - (e (when dtd (cxml::find-element (dom:tag-name element) dtd))) + (e (when dtd (cxml::find-element + (cxml::rod (dom:tag-name element)) + dtd))) (a (when e (cxml::find-attribute e name)))) (when (and a (listp (cxml::attdef-default a))) (add-default-attribute element a))))

(defun add-default-attributes (element) (let* ((dtd (dtd (slot-value element 'owner))) - (e (when dtd (cxml::find-element (dom:tag-name element) dtd)))) + (e (when dtd (cxml::find-element + (cxml::rod (dom:tag-name element)) + dtd)))) (when e (dolist (a (cxml::elmdef-attributes e)) (when (and a (listp (cxml::attdef-default a))) @@ -799,7 +1022,8 @@ (owner (slot-value element 'owner)) (anode (dom:create-attribute owner (cxml::attdef-name adef))) (text (dom:create-text-node owner value))) - (setf (slot-value anode 'dom-impl::specified-p) nil) + (setf (slot-value anode 'specified-p) nil) + (setf (slot-value anode 'owner-element) element) (dom:append-child anode text) (push anode (slot-value (dom:attributes element) 'items))))

@@ -810,8 +1034,16 @@ (assert-writeable element) (get-elements-by-tag-name-internal element name))

-(defmethod dom:normalize ((element element)) +(defmethod dom:get-elements-by-tag-name-ns ((element element) uri lname) (assert-writeable element) + (get-elements-by-tag-name-internal-ns element uri lname)) + +(defmethod dom:set-named-item :after ((self attribute-node-map) arg) + (setf (slot-value arg 'owner-element) + (slot-value self 'element))) + +(defmethod dom:normalize ((node node)) + (assert-writeable node) (labels ((walk (n) (when (eq (dom:node-type n) :element) (map nil #'walk (dom:items (dom:attributes n)))) @@ -837,7 +1069,7 @@ (setf previous child) (incf i)))))) (map nil #'walk (dom:child-nodes n)))) - (walk element)) + (walk node)) (values))

;;; TEXT @@ -856,7 +1088,17 @@ ;;; COMMENT -- nix ;;; CDATA-SECTION -- nix

-;;; DOCUMENT-TYPE -- missing +;;; DOCUMENT-TYPE + +(defmethod dom:internal-subset ((node document-type)) + ;; FIXME: encoding ist falsch, anderen sink nehmen! + (if (slot-boundp node 'internal-subset) + (with-output-to-string (stream) + (let ((sink (cxml:make-character-stream-sink stream))) + (dolist (def (internal-subset node)) + (apply (car def) sink (cdr def))))) + nil)) + ;;; NOTATION -- nix ;;; ENTITY -- nix

@@ -978,6 +1220,9 @@ :owner document)) (result (import-node-internal 'element document node deep :attributes attributes + :namespace-uri (dom:namespace-uri node) + :local-name (dom:local-name node) + :prefix (dom:prefix node) :tag-name (dom:tag-name node)))) (setf (slot-value attributes 'element) result) (dolist (attribute (dom:items (dom:attributes node))) @@ -1034,7 +1279,7 @@

;;; Erweiterung

-(defun dom:create-document (&optional document-element) +(defun dom-impl:create-document (&optional document-element) ;; Um ein neues Dokumentenobject zu erzeugen, parsen wir einfach ein ;; Dummydokument. (let* ((handler (dom:make-dom-builder))

Index: cxml/dom/dom-sax.lisp diff -u cxml/dom/dom-sax.lisp:1.2 cxml/dom/dom-sax.lisp:1.3 --- cxml/dom/dom-sax.lisp:1.2 Mon Nov 28 23:33:33 2005 +++ cxml/dom/dom-sax.lisp Sun Dec 4 19:43:56 2005 @@ -11,26 +11,41 @@ (defun dom:map-document (handler document &key (include-xmlns-attributes sax:*include-xmlns-attributes*) + include-doctype include-default-values) (sax:start-document handler) - (let ((doctype (dom:doctype document))) - (when doctype - (sax:start-dtd handler (dom:name doctype) nil nil) - ;; need notations for canonical mode 2 - (let* ((ns (dom:notations doctype)) - (a (make-array (dom:length ns)))) - ;; get them - (dotimes (k (dom:length ns)) - (setf (elt a k) (dom:item ns k))) - ;; sort them - (setf a (sort a #'rod< :key #'dom:name)) - (loop for n across a do - (sax:notation-declaration handler - (dom:name n) - (dom:public-id n) - (dom:system-id n))) - ;; fixme: entities! - (sax:end-dtd handler)))) + (when include-doctype + (let ((doctype (dom:doctype document))) + (when doctype + (sax:start-dtd handler + (dom:name doctype) + (dom:public-id doctype) + (dom:system-id doctype)) + (ecase include-doctype + (:full-internal-subset + (when (slot-boundp doctype 'internal-subset) + (sax:start-internal-subset handler) + (dolist (def (internal-subset doctype)) + (apply (car def) handler (cdr def))) + (sax:end-internal-subset handler))) + (:canonical-notations + ;; need notations for canonical mode 2 + (let* ((ns (dom:notations doctype)) + (a (make-array (dom:length ns)))) + (when (plusp (dom:length ns)) + (sax:start-internal-subset handler) + ;; get them + (dotimes (k (dom:length ns)) + (setf (elt a k) (dom:item ns k))) + ;; sort them + (setf a (sort a #'rod< :key #'dom:name)) + (loop for n across a do + (sax:notation-declaration handler + (dom:name n) + (dom:public-id n) + (dom:system-id n))) + (sax:end-internal-subset handler))))) + (sax:end-dtd handler)))) (labels ((walk (node) (dom:do-node-list (child (dom:child-nodes node)) (ecase (dom:node-type child)

Index: cxml/dom/package.lisp diff -u cxml/dom/package.lisp:1.2 cxml/dom/package.lisp:1.3 --- cxml/dom/package.lisp:1.2 Mon Nov 28 23:33:33 2005 +++ cxml/dom/package.lisp Sun Dec 4 19:43:56 2005 @@ -12,7 +12,33 @@ ;; lisp-specific extensions #:make-dom-builder

- ;; methods + ;; DOM 2 functions + #:owner-element + #:import-node + #:create-element-ns + #:create-attribute-ns + #:get-elements-by-tag-name-ns + #:get-element-by-id + #:get-named-item-ns + #:set-named-item-ns + #:remove-named-item-ns + #:is-supported + #:has-attributes + #:namespace-uri + #:prefix + #:local-name + #:internal-subset + #:create-document-type + #:create-document + #:get-attribute-ns + #:set-attribute-ns + #:remove-attribute-ns + #:get-attribute-node-ns + #:set-attribute-node-ns + #:has-attribute + #:has-attribute-ns + + ;; DOM 1 functions #:has-feature #:doctype #:implementation @@ -72,7 +98,6 @@ #:system-id #:notation-name #:target - #:import-node #:code

;; protocol classes

Index: cxml/dom/unparse.lisp diff -u cxml/dom/unparse.lisp:1.1.1.1 cxml/dom/unparse.lisp:1.2 --- cxml/dom/unparse.lisp:1.1.1.1 Sun Mar 13 19:02:47 2005 +++ cxml/dom/unparse.lisp Sun Dec 4 19:43:56 2005 @@ -1,9 +1,20 @@ (in-package :cxml)

-(defun unparse-document-to-octets (doc &rest initargs) - (let ((sink (apply #'make-octet-vector-sink initargs))) - (dom:map-document sink doc :include-default-values t))) +(defun %unparse-document (sink doc canonical) + (dom:map-document sink + doc + :include-doctype (if (and canonical (>= canonical 2)) + :canonical-notations + nil) + :include-default-values t))

-(defun unparse-document (doc character-stream &rest initargs) - (let ((sink (apply #'make-character-stream-sink character-stream initargs))) - (dom:map-document sink doc :include-default-values t))) +(defun unparse-document-to-octets (doc &rest initargs &key canonical) + (%unparse-document (apply #'make-octet-vector-sink initargs) + doc + canonical)) + +(defun unparse-document (doc character-stream &rest initargs &key canonical) + (%unparse-document + (apply #'make-character-stream-sink character-stream initargs) + doc + canonical))