[cxml-cvs] CVS update: cxml/dom/dom-impl.lisp
David Lichteblau
dlichteblau at common-lisp.net
Sun Dec 4 21:41:14 UTC 2005
Update of /project/cxml/cvsroot/cxml/dom
In directory common-lisp.net:/tmp/cvs-serv4855/dom
Modified Files:
dom-impl.lisp
Log Message:
uh oh. (rod nil) => "NIL"
Date: Sun Dec 4 22:41:13 2005
Author: dlichteblau
Index: cxml/dom/dom-impl.lisp
diff -u cxml/dom/dom-impl.lisp:1.9 cxml/dom/dom-impl.lisp:1.10
--- cxml/dom/dom-impl.lisp:1.9 Sun Dec 4 22:22:47 2005
+++ cxml/dom/dom-impl.lisp Sun Dec 4 22:41:13 2005
@@ -128,6 +128,12 @@
;;; Implementation
+(defun %rod (x)
+ (etypecase x
+ (null x)
+ (rod x)
+ (string (string-rod x))))
+
(defun assert-writeable (node)
(when (read-only-p node)
(dom-error :NO_MODIFICATION_ALLOWED_ERR "~S is marked read-only." node)))
@@ -251,7 +257,7 @@
(return k)))))
(defmethod dom:create-element ((document document) tag-name)
- (setf tag-name (rod tag-name))
+ (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
@@ -286,7 +292,7 @@
(values prefix local-name)))
(defmethod dom:create-element-ns ((document document) uri qname)
- (setf qname (rod qname))
+ (setf qname (%rod qname))
(multiple-value-bind (prefix local-name)
(safe-split-qname qname uri)
(let ((result (make-instance 'element
@@ -308,26 +314,26 @@
:owner document))
(defmethod dom:create-text-node ((document document) data)
- (setf data (rod data))
+ (setf data (%rod data))
(make-instance 'text
:data data
:owner document))
(defmethod dom:create-comment ((document document) data)
- (setf data (rod data))
+ (setf data (%rod data))
(make-instance 'comment
:data data
:owner document))
(defmethod dom:create-cdata-section ((document document) data)
- (setf data (rod data))
+ (setf data (%rod data))
(make-instance 'cdata-section
:data data
:owner document))
(defmethod dom:create-processing-instruction ((document document) target data)
- (setf target (rod target))
- (setf data (rod data))
+ (setf target (%rod target))
+ (setf data (%rod data))
(unless (cxml::valid-name-p target)
(dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string target)))
(make-instance 'processing-instruction
@@ -336,7 +342,7 @@
:data data))
(defmethod dom:create-attribute ((document document) name)
- (setf name (rod name))
+ (setf name (%rod name))
(unless (cxml::valid-name-p name)
(dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string name)))
(make-instance 'attribute
@@ -349,8 +355,8 @@
:owner document))
(defmethod dom:create-attribute-ns ((document document) uri qname)
- (setf uri (rod uri))
- (setf qname (rod qname))
+ (setf uri (%rod uri))
+ (setf qname (%rod qname))
(multiple-value-bind (prefix local-name)
(safe-split-qname qname uri)
(make-instance 'attribute
@@ -363,7 +369,7 @@
:owner document)))
(defmethod dom:create-entity-reference ((document document) name)
- (setf name (rod name))
+ (setf name (%rod name))
(unless (cxml::valid-name-p name)
(dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string name)))
(make-instance 'entity-reference
@@ -371,7 +377,7 @@
:owner document))
(defmethod get-elements-by-tag-name-internal (node tag-name)
- (setf tag-name (rod tag-name))
+ (setf tag-name (%rod tag-name))
(let ((result (make-node-list))
(wild-p (rod= tag-name #"*")))
(labels ((walk (n)
@@ -384,8 +390,8 @@
result))
(defmethod get-elements-by-tag-name-internal-ns (node uri lname)
- (setf uri (rod uri))
- (setf lname (rod lname))
+ (setf uri (%rod uri))
+ (setf lname (%rod lname))
(let ((result (make-node-list))
(wild-uri-p (rod= uri #"*"))
(wild-lname-p (rod= lname #"*")))
@@ -409,7 +415,7 @@
(block nil
(unless (dtd document)
(return nil))
- (setf id (rod id))
+ (setf id (%rod id))
(labels ((walk (n)
(dovector (c (dom:child-nodes n))
(when (dom:element-p c)
@@ -703,19 +709,19 @@
;;; NAMED-NODE-MAP
(defmethod dom:get-named-item ((self named-node-map) name)
- (setf name (rod name))
+ (setf name (%rod name))
(with-slots (items) self
(dolist (k items nil)
(when (rod= name (dom:node-name k))
(return k)))))
(defmethod dom:get-named-item-ns ((self named-node-map) uri lname)
- (setf uri (rod uri))
- (setf lname (rod 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)))
+ (when (and (rod= uri (dom:namespace-uri k))
+ (rod= lname (dom:local-name k)))
(return k)))))
(defun %set-named-item (map arg test)
@@ -753,7 +759,7 @@
(defmethod dom:remove-named-item ((self named-node-map) name)
(assert-writeable self)
- (setf name (rod name))
+ (setf name (%rod name))
(with-slots (items) self
(dolist (k items (dom-error :NOT_FOUND_ERR "~A not found in ~A" name self))
(cond ((rod= name (dom:node-name k))
@@ -762,8 +768,8 @@
(defmethod dom:remove-named-item-ns ((self named-node-map) uri lname)
(assert-writeable self)
- (setf uri (rod uri))
- (setf lname (rod lname))
+ (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))
@@ -786,7 +792,7 @@
(defmethod (setf dom:data) (newval (self character-data))
(assert-writeable self)
- (setf newval (rod newval))
+ (setf newval (%rod newval))
(setf (slot-value self 'value) newval))
(defmethod dom:length ((node character-data))
@@ -801,7 +807,7 @@
(defmethod dom:append-data ((node character-data) arg)
(assert-writeable node)
- (setq arg (rod arg))
+ (setq arg (%rod arg))
(with-slots (value) node
(setf value (concatenate 'rod value arg)))
(values))
@@ -829,7 +835,7 @@
;; Although we could implement this by calling DELETE-DATA, then INSERT-DATA,
;; we implement this function directly to avoid creating temporary garbage.
(assert-writeable node)
- (setf arg (rod arg))
+ (setf arg (%rod arg))
(with-slots (value) node
(unless (<= 0 offset (length value))
(dom-error :INDEX_SIZE_ERR "offset is invalid"))
@@ -852,7 +858,7 @@
(defmethod dom:insert-data ((node character-data) offset arg)
(assert-writeable node)
- (setf arg (rod arg))
+ (setf arg (%rod arg))
(with-slots (value) node
(unless (<= 0 offset (length value))
(dom-error :INDEX_SIZE_ERR "offset is invalid"))
@@ -889,7 +895,7 @@
(defmethod (setf dom:value) (new-value (node attribute))
(assert-writeable node)
- (let ((rod (rod new-value)))
+ (let ((rod (%rod new-value)))
(with-slots (children owner) node
;; remove children, add new TEXT-NODE child
;; (alas, we must not reuse an old TEXT-NODE)
@@ -1147,7 +1153,7 @@
(defmethod (setf dom:data) (newval (self processing-instruction))
(assert-writeable self)
- (setf newval (rod newval))
+ (setf newval (%rod newval))
(setf (slot-value self 'data) newval))
;; das koennte man auch mit einer GF machen
More information about the Cxml-cvs
mailing list