[net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp

[Erik Enge]

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