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

Modified Files: protocol.lisp Log Message: adding

add-hook, remove-hook, get-hooks and apply-to-hook

Date: Mon Nov 3 15:55:05 2003 Author: eenge

Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.2 net-nittin-irc/protocol.lisp:1.3 --- net-nittin-irc/protocol.lisp:1.2 Mon Nov 3 12:25:48 2003 +++ net-nittin-irc/protocol.lisp Mon Nov 3 15:55:00 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.2 2003/11/03 17:25:48 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.3 2003/11/03 20:55:00 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $

;;;; See LICENSE for licensing information. @@ -48,6 +48,10 @@ :initform nil :documentation "A list of channels known to this server as recorded by the LIST command.") + (hooks + :initarg :hooks + :accessor hooks + :initform (make-hash-table :test #'equal)) (dangling-users :initarg :dangling-users :accessor dangling-users @@ -67,15 +71,19 @@ (client-stream t) (channels nil) (dangling-users nil) + (hooks nil) (channel-list nil)) - (make-instance 'connection - :user user - :server-name server-name - :server-stream server-stream - :client-stream client-stream - :channels channels - :dangling-users dangling-users - :channel-list channel-list)) + (let ((connection (make-instance 'connection + :user user + :server-name server-name + :server-stream server-stream + :client-stream client-stream + :channels channels + :dangling-users dangling-users + :channel-list channel-list))) + (dolist (hook hooks) + (add-hook connection (car hook) (cadr hook))) + connection))

(defmethod client-raw-log ((connection connection) message) (let ((stream (client-stream connection))) @@ -131,6 +139,22 @@ (dolist (channel (channels connection)) (push channel channel-list)) channel-list)) + +(defmethod get-hooks ((connection connection) (class symbol)) + (gethash class (hooks connection))) + +(defmethod add-hook ((connection connection) class hook) + (setf (gethash class (hooks connection)) + (pushnew hook (gethash class (hooks connection))))) + +(defmethod remove-hook ((connection connection) class hook) + (setf (gethash class (hooks connection)) + (delete hook (gethash class (hooks connection))))) + +(defmethod apply-to-hooks ((message irc-message)) + (let ((connection (connection message))) + (dolist (hook (get-hooks connection (class-name (class-of message)))) + (funcall hook message))))

;; ;; Channel