Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv30304

Modified Files: TODO protocol.lisp Log Message: fixing find-user problem

Date: Mon Nov 24 16:56:49 2003 Author: eenge

Index: net-nittin-irc/TODO diff -u net-nittin-irc/TODO:1.9 net-nittin-irc/TODO:1.10 --- net-nittin-irc/TODO:1.9 Mon Nov 24 16:30:11 2003 +++ net-nittin-irc/TODO Mon Nov 24 16:56:49 2003 @@ -12,6 +12,3 @@ - should send-irc-message automatically do this for you?

- Add ignore - - - During find-user optimization, I broke with irc-nick-equal for - nicknames in find-user.

Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.18 net-nittin-irc/protocol.lisp:1.19 --- net-nittin-irc/protocol.lisp:1.18 Mon Nov 24 16:30:11 2003 +++ net-nittin-irc/protocol.lisp Mon Nov 24 16:56:49 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.18 2003/11/24 21:30:11 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.19 2003/11/24 21:56:49 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $

;;;; See LICENSE for licensing information. @@ -323,6 +323,10 @@ :initarg :nickname :accessor nickname :initform "") + (normalized-nickname + :initarg :normalized-nickname + :accessor normalized-nickname + :initform "") (username :initarg :username :accessor username @@ -355,6 +359,7 @@ (realname "")) (make-instance 'user :nickname nickname + :normalized-nickname (normalize-nickname nickname) :username username :hostname hostname :realname realname)) @@ -365,33 +370,28 @@ nickname))

;; oh, what a terrible operator name -(defun irc-nick-mangle (string) +(defun normalize-nickname (string) (let* ((new-string (substitute #[ #{ string)) (new-string (substitute #] #} new-string)) (new-string (substitute #\ #| new-string)) (new-string (substitute #~ #^ new-string))) - new-string)) - -;; ditto -(defun irc-nick-equal (string1 string2) - "Return t if `string1' and `string2' are equal as far as nickname -rules in IRC goes." - (string-equal (irc-nick-mangle string1) (irc-nick-mangle string2))) + (string-downcase string)))

;; this is broken. we should use #'irc-nick-equal somehow. (defmethod find-user ((connection connection) (nickname string)) "Return user as designated by `nickname' or nil if no such user is known." - (or (gethash nickname (users connection)) - (when (string= nickname (nickname (user connection))) - (user connection)))) + (let ((nickname (normalize-nickname nickname))) + (or (gethash nickname (users connection)) + (when (string= nickname (nickname (user connection))) + (user connection)))))

; what if the user is not on any channels? (defmethod add-user ((connection connection) (channel channel) (user user)) "Add `user' to `channel' and `channel' to `user'." - (setf (gethash (nickname user) (users channel)) user) + (setf (gethash (normalized-nickname user) (users channel)) user) (pushnew channel (channels user)) - (setf (gethash (nickname user) (users connection)) user)) + (setf (gethash (normalized-nickname user) (users connection)) user))

(defmethod remove-all-users ((connection connection)) "Remove all users known to `connection'." @@ -400,7 +400,7 @@

(defmethod remove-user ((channel channel) (user user)) "Remove `user' from `channel' and `channel' from `user'." - (remhash (nickname user) (users channel)) + (remhash (normalized-nickname user) (users channel)) (setf (channels user) (remove channel (channels user))))

(defmethod remove-channel ((channel channel) (user user)) @@ -411,7 +411,7 @@ "Remove `user' anywhere present in the `connection'." (dolist (channel (channels user)) (remove-user channel user)) - (remhash (nickname user) (users connection))) + (remhash (normalized-nickname user) (users connection)))

(defmethod find-or-make-user ((connection connection) nickname &key (username "") (hostname "") (realname "")) @@ -422,14 +422,7 @@ :realname realname)))

(defmethod change-nickname ((connection connection) (user user) new-nickname) - (dolist (channel (channels connection)) - (let ((old-user (gethash (nickname user) (users channel)))) - (when old-user - (remove-user channel user) - (setf (nickname user) new-nickname) - (add-user connection channel user)))) - (when (equal user (user connection)) - (setf (nickname user) new-nickname))) + (setf (nickname user) new-nickname))

;; IRC Message ;;