[cl-irc-cvs] r179 - trunk

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Wed Apr 18 14:57:32 2007
New Revision: 179

Modified:
   trunk/event.lisp
   trunk/package.lisp
   trunk/protocol.lisp
Log:
KICK messages generally don't originate at the user being kicked. Fixed.

Modified: trunk/event.lisp
==============================================================================
--- trunk/event.lisp	(original)
+++ trunk/event.lisp	Wed Apr 18 14:57:32 2007
@@ -315,7 +315,7 @@
       (let* ((channel (find-channel connection channel))
              (user (find-user connection nick)))
         (when (and user channel)
-          (if (self-message-p message)
+          (if (user-eq-me-p connection user)
               (remove-channel user channel)
             (remove-user channel user)))))))
 

Modified: trunk/package.lisp
==============================================================================
--- trunk/package.lisp	(original)
+++ trunk/package.lisp	Wed Apr 18 14:57:32 2007
@@ -85,6 +85,7 @@
              :remove-all-users
              :remove-user
              :self-message-p
+             :user-eq-me-p
              :pass
              :nick
              :user-

Modified: trunk/protocol.lisp
==============================================================================
--- trunk/protocol.lisp	(original)
+++ trunk/protocol.lisp	Wed Apr 18 14:57:32 2007
@@ -914,6 +914,7 @@
   (car (last (arguments message))))
 
 (defgeneric self-message-p (message))
+(defgeneric user-eq-me-p (connection user))
 (defgeneric find-irc-message-class (type))
 (defgeneric client-log (connection message &optional prefix))
 (defgeneric apply-to-hooks (message))
@@ -923,6 +924,13 @@
   (string-equal (source message)
                 (nickname (user (connection message)))))
 
+(defmethod user-eq-me-p (connection (user user))
+  (eq user (user connection)))
+
+(defmethod user-eq-me-p (connection (user string))
+  (let ((user (find-user connection user)))
+    (user-eq-me-p connection user)))
+
 (defclass irc-error-reply (irc-message) ())
 
 (eval-when (:compile-toplevel :load-toplevel :execute)