? destructuring-irc-message.lisp
Index: event.lisp
===================================================================
RCS file: /project/cl-irc/cvsroot/cl-irc/event.lisp,v
retrieving revision 1.22
diff -u -r1.22 event.lisp
--- event.lisp	20 Feb 2006 17:27:57 -0000	1.22
+++ event.lisp	22 Feb 2006 10:54:58 -0000
@@ -287,52 +287,52 @@
             (remove-channel user channel)
           (remove-user channel 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)
-     :notice (source message)
-     (make-ctcp-message
-      (format nil "TIME ~A"
-              (make-time-message second minute hour date month year day))))))
-
-(defmethod default-hook ((message ctcp-source-message))
-  (send-irc-message
-   (connection message)
-   :notice
-   (source message)
-   (make-ctcp-message
-    (format nil "SOURCE ~A:~A:~A"
-            *download-host*
-            *download-directory*
-            *download-file*))))
-
-(defmethod default-hook ((message ctcp-finger-message))
-  (let* ((user (user (connection message)))
-         (finger-info (if (not (zerop (length (realname user))))
-                          (realname user)
-                          (nickname user))))
-    (send-irc-message
-     (connection message)
-     :notice (source message)
-     (make-ctcp-message
-      (format nil "FINGER ~A" finger-info)))))
-
-(defmethod default-hook ((message ctcp-version-message))
-  (send-irc-message
-   (connection message)
-   :notice (source message)
-   (make-ctcp-message
-    (format nil "VERSION ~A" *ctcp-version*))))
-
-(defmethod default-hook ((message ctcp-ping-message))
-  (send-irc-message
-   (connection message)
-   :notice (source message)
-   (make-ctcp-message
-    (format nil "PING ~A" (car (last (arguments message)))))))
+(macrolet ((define-ctcp-reply-hook ((message-var message-type) &body body)
+               `(defmethod default-hook ((,message-var ,message-type))
+                  (when (ctcp-request-p ,message-var)
+                    ,@body))))
+  (define-ctcp-reply-hook (message ctcp-time-message)
+      (multiple-value-bind
+          (second minute hour date month year day)
+          (get-decoded-time)
+        (send-irc-message
+         (connection message)
+         :notice (source message)
+         (make-ctcp-message
+          (format nil "TIME ~A"
+                  (make-time-message second minute hour date month year day))))))
+  (define-ctcp-reply-hook (message ctcp-source-message)
+      (send-irc-message
+       (connection message)
+       :notice
+       (source message)
+       (make-ctcp-message
+        (format nil "SOURCE ~A:~A:~A"
+                *download-host*
+                *download-directory*
+                *download-file*))))
+  (define-ctcp-reply-hook (message ctcp-finger-message)
+      (let* ((user (user (connection message)))
+             (finger-info (if (not (zerop (length (realname user))))
+                              (realname user)
+                              (nickname user))))
+        (send-irc-message
+         (connection message)
+         :notice (source message)
+         (make-ctcp-message
+          (format nil "FINGER ~A" finger-info)))))
+  (define-ctcp-reply-hook (message ctcp-version-message)
+      (send-irc-message
+       (connection message)
+       :notice (source message)
+       (make-ctcp-message
+        (format nil "VERSION ~A" *ctcp-version*))))
+  (define-ctcp-reply-hook (message ctcp-ping-message)
+      (send-irc-message
+       (connection message)
+       :notice (source message)
+       (make-ctcp-message
+        (format nil "PING ~A" (car (last (arguments message))))))))
 
 (defmethod irc-message-event (connection (message ctcp-dcc-chat-request-message))
   (declare (ignore connection))
Index: protocol.lisp
===================================================================
RCS file: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v
retrieving revision 1.37
diff -u -r1.37 protocol.lisp
--- protocol.lisp	20 Feb 2006 06:53:25 -0000	1.37
+++ protocol.lisp	22 Feb 2006 10:54:59 -0000
@@ -742,6 +742,10 @@
 may be already be on."
   (remhash (normalized-nickname user) (users connection)))
 
+(defmethod remove-user (connection user)
+  "Don't do anything."
+  (warn "Don't know how to handle args (~A ~A)" connection user))
+
 (defmethod remove-user-everywhere ((connection connection) (user user))
   "Remove `user' anywhere present in the `connection'."
   (dolist (channel (channels user))
@@ -932,6 +936,12 @@
   (declare (ignore type))
   (find-class 'standard-ctcp-message))
 
+(defmethod ctcp-request-p ((message ctcp-mixin))
+  (string= (command message) :privmsg))
+
+(defmethod ctcp-reply-p ((message ctcp-mixin))
+  (string= (command message) :notice))
+
 (defmethod client-log ((connection connection) (message ctcp-mixin) &optional (prefix ""))
   (let ((stream (client-stream connection)))
     (format stream "~A~A: ~A (~A): ~A~{ ~A~} \"~A\"~%"
