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)))))