[cl-xmpp-cvs] CVS update: cl-xmpp/TODO cl-xmpp/cl-xmpp.lisp cl-xmpp/result.lisp cl-xmpp/utility.lisp

[Erik Enge]

Update of /project/cl-xmpp/cvsroot/cl-xmpp
In directory common-lisp.net:/tmp/cvs-serv15793

Modified Files:
	TODO cl-xmpp.lisp result.lisp utility.lisp 
Log Message:
all names on attributes and elements are now keywords (works better
in lisps without wide characters due to cxml representing things as
vectors)

Date: Mon Nov 14 21:07:36 2005
Author: eenge

Index: cl-xmpp/TODO
diff -u cl-xmpp/TODO:1.8 cl-xmpp/TODO:1.9
--- cl-xmpp/TODO:1.8	Sat Nov 12 21:53:17 2005
+++ cl-xmpp/TODO	Mon Nov 14 21:07:36 2005
@@ -1,8 +1,5 @@
 - respect stringprep/nodeprep  -  jid validator
 
-- also, i'm interning things which may screw up lisps with up/down
-  case different.
-
 - i hate that xmlns's are as strings and never validated
 
 - create a connect-test which makes a "fake" connection but


Index: cl-xmpp/cl-xmpp.lisp
diff -u cl-xmpp/cl-xmpp.lisp:1.15 cl-xmpp/cl-xmpp.lisp:1.16
--- cl-xmpp/cl-xmpp.lisp:1.15	Mon Nov 14 20:21:06 2005
+++ cl-xmpp/cl-xmpp.lisp	Mon Nov 14 21:07:36 2005
@@ -1,4 +1,4 @@
-;;;; $Id: cl-xmpp.lisp,v 1.15 2005/11/14 19:21:06 eenge Exp $
+;;;; $Id: cl-xmpp.lisp,v 1.16 2005/11/14 20:07:36 eenge Exp $
 ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -163,7 +163,7 @@
     objects))
 
 (defmethod parse-result ((connection connection) (attribute dom-impl::attribute))
-  (let* ((name (dom:node-name attribute))
+  (let* ((name (ensure-keyword (dom:node-name attribute)))
 	 (value (dom:value attribute))
 	 (xml-attribute
 	  (make-instance 'xml-attribute
@@ -171,14 +171,14 @@
     xml-attribute))
 
 (defmethod parse-result ((connection connection) (node dom-impl::character-data))
-  (let* ((name (dom:node-name node))
+  (let* ((name (ensure-keyword (dom:node-name node)))
 	 (data (dom:data node))
 	 (xml-element (make-instance 'xml-element
 				     :name name :data data :node node)))
     xml-element))
 
 (defmethod parse-result ((connection connection) (node dom-impl::node))
-  (let* ((name (intern (string-upcase (dom:node-name node)) :keyword))
+  (let* ((name (ensure-keyword (dom:node-name node)))
 	 (xml-element (make-instance 'xml-element :name name :node node)))
     (dom:do-node-list (attribute (dom:attributes node))
       (push (parse-result connection attribute) (attributes xml-element)))
@@ -188,8 +188,8 @@
 
 
 (defmethod xml-element-to-event ((connection connection) (object xml-element) (name (eql :iq)))
-  (let ((id (intern (string-upcase (value (get-attribute object :id))) :keyword)))
-    (if (not (string-equal (value (get-attribute object :type)) "result"))
+  (let ((id (ensure-keyword (value (get-attribute object :id)))))
+    (if (not (eq (ensure-keyword (value (get-attribute object :type))) :result))
 	(make-error (get-element object :error))
       (case id
 	(:error (make-error (get-element object :error)))
@@ -233,8 +233,7 @@
   (map 'list #'(lambda (x) (dom-to-event connection x)) objects))
 
 (defmethod dom-to-event ((connection connection) (object xml-element))
-  (xml-element-to-event
-   connection object (intern (string-upcase (name object)) :keyword)))
+  (xml-element-to-event connection object (name object)))
 
 ;;; XXX: Is the ask attribute of the <presence/> element part of the RFC/JEP?
 (defmethod xml-element-to-event ((connection connection)


Index: cl-xmpp/result.lisp
diff -u cl-xmpp/result.lisp:1.8 cl-xmpp/result.lisp:1.9
--- cl-xmpp/result.lisp:1.8	Sun Nov 13 03:55:46 2005
+++ cl-xmpp/result.lisp	Mon Nov 14 21:07:36 2005
@@ -1,4 +1,4 @@
-;;;; $Id: result.lisp,v 1.8 2005/11/13 02:55:46 eenge Exp $
+;;;; $Id: result.lisp,v 1.9 2005/11/14 20:07:36 eenge Exp $
 ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/result.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -72,12 +72,12 @@
 	    (length (elements object))
 	    (length (data object)))))
 
-(defmethod get-attribute ((element xml-element) name &key (test 'string-equal))
+(defmethod get-attribute ((element xml-element) name &key (test 'eq))
   (dolist (attribute (attributes element))
     (when (funcall test name (name attribute))
       (return-from get-attribute attribute))))
 
-(defmethod get-element ((element xml-element) name &key (test 'string-equal))
+(defmethod get-element ((element xml-element) name &key (test 'eq))
   (dolist (subelement (elements element))
     (when (funcall test name (name subelement))
       (return-from get-element subelement))))


Index: cl-xmpp/utility.lisp
diff -u cl-xmpp/utility.lisp:1.9 cl-xmpp/utility.lisp:1.10
--- cl-xmpp/utility.lisp:1.9	Mon Nov 14 20:42:29 2005
+++ cl-xmpp/utility.lisp	Mon Nov 14 21:07:36 2005
@@ -1,4 +1,4 @@
-;;;; $Id: utility.lisp,v 1.9 2005/11/14 19:42:29 eenge Exp $
+;;;; $Id: utility.lisp,v 1.10 2005/11/14 20:07:36 eenge Exp $
 ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/utility.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -43,7 +43,13 @@
   (push (list name operator) *auth-methods*))
 
 (defun ensure-keyword (thing)
+  "Makes a keyword except when it gets nil it just returns nil."
   (cond
-   ((typep thing 'string) (intern thing :keyword))
+   ((typep thing 'string)
+    (let ((correct-case-thing (if (eq *print-case* :upcase)
+				  (string-upcase thing)
+				(string-downcase thing))))
+      (intern correct-case-thing :keyword)))
    ((typep thing 'array) (ensure-keyword (map 'string #'code-char thing)))
+   ((eq thing nil) nil)
    (t (error "Don't know how to make keyword out of: ~a (type: ~a)" thing (type-of thing)))))