While trying to implement the irc-mode-message hook (and thus modes) in the
library, I found some instances defunct users are not cleaned.
The patch below resolves that for the most part, but there is one instance
which I can't clear up with a minimal patch. To clear up the workaround in
the event.lisp handlers, I'd need to add a connection slot to the channel
class.
What is the general sentiment about this patch?
bye,
Erik.
Index: event.lisp
===================================================================
RCS file: /project/cl-irc/cvsroot/cl-irc/event.lisp,v
retrieving revision 1.4
diff -u -5 -r1.4 event.lisp
--- event.lisp 21 May 2004 19:12:06 -0000 1.4
+++ event.lisp 23 Jun 2004 19:10:26 -0000
@@ -85,11 +85,15 @@
(let* ((connection (connection message))
(channel (find-channel connection (first (arguments message))))
(user (find-user connection (source message))))
(if (self-message-p message)
(remove-channel user channel)
- (remove-user channel user))))
+ (unless (remove-user channel user)
+ ;; workaround for remove-user on channel objects:
+ ;; if the user parts but does not stay in any other channels:
+ ;; remove the object from the connection
+ (remove-user connection user)))))
(defmethod default-hook ((message irc-quit-message))
(let ((connection (connection message)))
(remove-user-everywhere connection (find-user connection (source
message)))))
@@ -102,11 +106,15 @@
(let* ((connection (connection message))
(channel (find-channel connection (first (arguments message))))
(user (find-user connection (second (arguments message)))))
(if (self-message-p message)
(remove-channel user channel)
- (remove-user channel user))))
+ (unless (remove-user channel user)
+ ;; workaround for remove-user on channel objects:
+ ;; if the user parts but does not stay in any other channels:
+ ;; remove the object from the connection
+ (remove-user connection user)))))
(defmethod default-hook ((message ctcp-time-message))
(multiple-value-bind (second minute hour date month year day)
(get-decoded-time)
(send-irc-message
(connection message)
Index: protocol.lisp
===================================================================
RCS file: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v
retrieving revision 1.9
diff -u -5 -r1.9 protocol.lisp
--- protocol.lisp 22 Jun 2004 18:47:08 -0000 1.9
+++ protocol.lisp 23 Jun 2004 19:10:28 -0000
@@ -357,25 +357,35 @@
be found, return nil."
(let ((channel-name (normalize-channel-name channel)))
(gethash channel-name (channels connection))))
(defmethod remove-all-channels ((connection connection))
- "Remove all channels known to `connection'."
+ "Remove all channels known to `connection' keeping `user(s)' in sync."
+ (setf (channels (user connection)) nil)
+ (clrhash (users connection))
(clrhash (channels connection)))
(defmethod add-channel ((connection connection) (channel channel))
"Add `channel' to `connection'."
(setf (gethash (normalized-name channel) (channels connection)) channel))
(defmethod remove-channel ((connection connection) (channel channel))
- "Remove `channel' from `connection'."
+ "Remove `channel' from `connection' keeping `users' in sync."
+ (remove-users channel)
(remhash (normalized-name channel) (channels connection)))
(defmethod remove-users ((channel channel))
"Remove all users on `channel'."
+ (maphash #'(lambda (nick user) (remove-channel user channel))
+ (users channel))
(clrhash (users channel)))
+(defmethod real-user-count ((channel channel))
+ (if (zerop (hash-table-count (users channel)))
+ (user-count channel)
+ (hash-table-count (users channel))))
+
;;
;; User
;;
(defclass user ()
@@ -463,15 +473,19 @@
(defmethod add-user ((channel channel) (user user))
(setf (gethash (normalized-nickname user) (users channel)) user)
(pushnew channel (channels user)))
(defmethod remove-all-users ((connection connection))
- "Remove all users known to `connection'."
+ "Remove all users known to `connection' keeping `channels' in sync."
+ (maphash #'(lambda (key channel) (remove-users channel))
+ (channels connection))
(clrhash (users connection)))
(defmethod remove-user ((channel channel) (user user))
"Remove `user' from `channel' and `channel' from `user'."
+ ;;FIXME: remove this user from the connection when he has no channels!
+ ;; problem: there is no connection instance to remove from....
(remhash (normalized-nickname user) (users channel))
(setf (channels user) (remove channel (channels user))))
(defmethod remove-channel ((channel channel) (user user))
"Remove `channel' from `user'."
@@ -480,12 +494,12 @@
"use of depricated API (remove-channel channel user): "
"(remove-channel user channel) is now preferred"))
(remove-channel user channel))
(defmethod remove-channel ((user user) (channel channel))
- "Remove `channel' from `user'."
- (setf (channels user) (remove channel (channels user))))
+ "Remove `channel' from `user' vice versa."
+ (remove-user channel user))
(defmethod remove-user ((connection connection) (user user))
"Remove `user' from `connection' but leave user in any channels he
may be already be on."
(remhash (normalized-nickname user) (users connection)))
--
"Sie haben neue Mails!" - Die GMX Toolbar informiert Sie beim Surfen!
Jetzt aktivieren unter http://www.gmx.net/info
