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

Modified Files: protocol.lisp event.lisp Log Message: Extend mode tracking: set absolute mode values for ban, except and invite lists.

* event.lisp (generate-maskmode-hooks): New. Macro to define hooks for ban, except and invitelist messages and their endlist companions. (): Use generate-maskmode-hooks to generate hooks for ban, except and invite list messages. (default-hook [irc-rpl_namreply-message]): Register which users were sent in the namreply list. (default-hook [irc-rpl_endofnames-message]): Remove users which were not in the namreply-list. Before, only missing users were added, now spurious ones will be deleted too.

* protocol.lisp (add-default-hooks): Add hooks for new messages.

Date: Sun Mar 27 22:27:18 2005 Author: ehuelsmann

Index: cl-irc/protocol.lisp diff -u cl-irc/protocol.lisp:1.20 cl-irc/protocol.lisp:1.21 --- cl-irc/protocol.lisp:1.20 Mon Mar 21 23:32:35 2005 +++ cl-irc/protocol.lisp Sun Mar 27 22:27:18 2005 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.20 2005/03/21 22:32:35 ehuelsmann Exp $ +;;;; $Id: protocol.lisp,v 1.21 2005/03/27 20:27:18 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $

;;;; See LICENSE for licensing information. @@ -202,9 +202,16 @@ (defmethod add-default-hooks ((connection connection)) (dolist (message '(irc-rpl_isupport-message irc-rpl_whoisuser-message + irc-rpl_banlist-message + irc-rpl_endofbanlist-message + irc-rpl_exceptlist-message + irc-rpl_endofexceptlist-message + irc-rpl_invitelist-message + irc-rpl_endofinvitelist-message irc-rpl_list-message irc-rpl_topic-message irc-rpl_namreply-message + irc-rpl_endofnames-message irc-ping-message irc-join-message irc-topic-message

Index: cl-irc/event.lisp diff -u cl-irc/event.lisp:1.7 cl-irc/event.lisp:1.8 --- cl-irc/event.lisp:1.7 Sun Mar 20 17:55:36 2005 +++ cl-irc/event.lisp Sun Mar 27 22:27:18 2005 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.7 2005/03/20 16:55:36 ehuelsmann Exp $ +;;;; $Id: event.lisp,v 1.8 2005/03/27 20:27:18 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $

;;;; See LICENSE for licensing information. @@ -20,6 +20,47 @@ of the IRC message to keep the connection, channel and user objects in sync."))

+(defmacro generate-maskmode-hooks (listmsg-class endmsg-class + tmp-symbol mode-symbol) + `(progn + (defmethod default-hook ((message ,listmsg-class)) + (destructuring-bind + (target channel-name mask set-by time-set) + (arguments message) + (declare (ignore target set-by time-set)) + ;; note: the structure currently does not allow for logging + ;; set-by and time-set: the MODE message handling currently + ;; does not allow that. + (let ((channel (find-channel (connection message) channel-name))) + (when channel + (unless (has-mode-p channel ',tmp-symbol) + ;; start with a new list, replacing the old value later + (add-mode channel ',tmp-symbol + (make-instance 'list-value-mode + :value-type :non-user))) + ;; use package-local symbol to prevent conflicts + (set-mode channel ',tmp-symbol mask))))) + + (defmethod default-hook ((message ,endmsg-class)) + (let ((channel (find-channel (connection message) + (car (arguments message))))) + (when channel + (let ((mode (has-mode-p channel ',tmp-symbol))) + (when mode + ;; replace list + (add-mode channel ',mode-symbol mode) + (remove-mode channel ',tmp-symbol)))))))) + +(generate-maskmode-hooks irc-rpl_banlist-message + irc-rpl_endofbanlist-message + banlist-in-progress :ban) +(generate-maskmode-hooks irc-rpl_exceptlist-message + irc-rpl_endofexceptlist-message + exceptlist-in-progress :except) +(generate-maskmode-hooks irc-rpl_invitelist-message + irc-rpl_endofinvitelist-message + invitelist-in-progress :invite) + (defmethod default-hook ((message irc-rpl_isupport-message)) (let* ((capabilities (cdr (arguments message))) (connection (connection message)) @@ -72,13 +113,17 @@ (defmethod default-hook ((message irc-rpl_namreply-message)) (let* ((connection (connection message)) (channel (find-channel connection (car (last (arguments message)))))) + (unless (has-mode-p channel 'namreply-in-progress) + (add-mode channel 'namreply-in-progress + (make-instance 'list-value-mode :value-type :user))) (dolist (nickname (tokenize-string (trailing-argument message))) (let ((user (find-or-make-user connection (canonicalize-nickname connection nickname)))) (unless (equal user (user connection)) (add-user connection user) - (add-user channel user)) + (add-user channel user) + (set-mode channel 'namreply-in-progress user)) (let* ((mode-char (getf (nick-prefixes connection) (elt nickname 0))) (mode-name (when mode-char @@ -91,6 +136,19 @@ (make-mode connection channel mode-name)) user)))))))) + +(defmethod default-hook ((message irc-rpl_endofnames-message)) + (let* ((channel (find-channel (connection message) + (second (arguments message)))) + (mode (get-mode channel 'namreply-in-progress)) + (channel-users)) + (remove-mode channel 'namreply-in-progress) + (maphash #'(lambda (nick user-obj) + (declare (ignore nick)) + (pushnew user-obj channel-users)) (users channel)) + (dolist (user (remove-if #'(lambda (x) + (member x mode)) channel-users)) + (remove-user channel user))))

(defmethod default-hook ((message irc-ping-message)) (pong (connection message) (trailing-argument message)))