From ehuelsmann at common-lisp.net  Sun Feb 12 08:08:07 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Sun, 12 Feb 2006 02:08:07 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060212080807.A1C036A010@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv26640

Modified Files:
	protocol.lisp 
Log Message:
Fix syntax error.

--- /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2006/01/30 19:51:12	1.32
+++ /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2006/02/12 08:08:07	1.33
@@ -1,4 +1,4 @@
-;;;; $Id: protocol.lisp,v 1.32 2006/01/30 19:51:12 ehuelsmann Exp $
+;;;; $Id: protocol.lisp,v 1.33 2006/02/12 08:08:07 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -299,7 +299,7 @@
                     (read-line (network-stream connection) t))))
       (setf (connection message) connection)
       message)
-    (end-of-file)))
+    (end-of-file ())))
        ;; satisfy read-message-loop assumption of nil when no more messages
 
 (defmethod send-irc-message ((connection connection) command



From ehuelsmann at common-lisp.net  Tue Feb 14 21:51:21 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Tue, 14 Feb 2006 15:51:21 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060214215121.0025B4801C@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv19293

Modified Files:
	command.lisp 
Log Message:
Add support for joining password-protected channels. Patch by Andreas Fuchs.

--- /project/cl-irc/cvsroot/cl-irc/command.lisp	2006/01/25 20:03:27	1.14
+++ /project/cl-irc/cvsroot/cl-irc/command.lisp	2006/02/14 21:51:21	1.15
@@ -1,4 +1,4 @@
-;;;; $Id: command.lisp,v 1.14 2006/01/25 20:03:27 ehuelsmann Exp $
+;;;; $Id: command.lisp,v 1.15 2006/02/14 21:51:21 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/command.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -19,7 +19,7 @@
 (defgeneric service (connection nickname distribution info))
 (defgeneric quit (connection &optional message))
 (defgeneric squit (connection server comment))
-(defgeneric join (connection channel))
+(defgeneric join (connection channel &key password))
 (defgeneric multi-join (connection channels))
 (defgeneric part (connection channel))
 (defgeneric part-all (connection))
@@ -147,11 +147,11 @@
 (defmethod squit ((connection connection) (server string) (comment string))
   (send-irc-message connection :squit comment server))
 
-(defmethod join ((connection connection) (channel string))
-  (send-irc-message connection :join nil channel))
+(defmethod join ((connection connection) (channel string) &key password)
+  (apply #'send-irc-message connection :join nil channel (when password (list password))))
 
-(defmethod join ((connection connection) (channel channel))
-  (join connection (name channel)))
+(defmethod join ((connection connection) (channel channel) &key password)
+  (join connection (name channel) :password password))
 
 ;; utility function not part of the RFC
 (defmethod multi-join ((connection connection) (channels list))



From ehuelsmann at common-lisp.net  Tue Feb 14 22:56:17 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Tue, 14 Feb 2006 16:56:17 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc/test
Message-ID: <20060214225617.75E057600E@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc/test
In directory common-lisp:/tmp/cvs-serv27481/test

Modified Files:
	test-protocol.lisp 
Log Message:
Comment out non-applicable tests.

--- /project/cl-irc/cvsroot/cl-irc/test/test-protocol.lisp	2004/01/05 14:18:07	1.2
+++ /project/cl-irc/cvsroot/cl-irc/test/test-protocol.lisp	2006/02/14 22:56:17	1.3
@@ -1,4 +1,4 @@
-;;;; $Id: test-protocol.lisp,v 1.2 2004/01/05 14:18:07 eenge Exp $
+;;;; $Id: test-protocol.lisp,v 1.3 2006/02/14 22:56:17 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/test/test-protocol.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -10,8 +10,9 @@
 (defvar *nick3* "k^{]re")
 (defvar *chan1* "#liSP")
 
-(deftest normalize-nickname.1 (irc:normalize-nickname *nick1*) "kire")
-(deftest normalize-nickname.2 (irc:normalize-nickname *nick2*) "k\\[]re")
-(deftest normalize-nickname.3 (irc:normalize-nickname *nick3*) "k~[]re")
+;;normalize tests are broken because they need a connection these days
+;;(deftest normalize-nickname.1 (irc:normalize-nickname *nick1*) "kire")
+;;(deftest normalize-nickname.2 (irc:normalize-nickname *nick2*) "k\\[]re")
+;;(deftest normalize-nickname.3 (irc:normalize-nickname *nick3*) "k~[]re")
 
-(deftest normalize-channel-name.1 (irc:normalize-channel-name *chan1*) "#lisp")
+;;(deftest normalize-channel-name.1 (irc:normalize-channel-name *chan1*) "#lisp")



From ehuelsmann at common-lisp.net  Wed Feb 15 19:03:53 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Wed, 15 Feb 2006 13:03:53 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060215190353.6F0312A2F0@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv16147

Modified Files:
	event.lisp protocol.lisp parse-message.lisp 
Log Message:
Start eliminating trailing-argument to be RFC compliant.

Step 2 should follow in about half a year,
removing trailing-argument all together.

* event.lisp:
  - Use destructuring-bind to decompose protocol messages (more often).
  - Fix relative arguments-use (i.e. (last arugments)) which isn't applicable
    anymore. [Only the case for irc-rpl_namreply-message.]
  - Fix PONG message - previously using trailing-argument - to pass all
    arguments to PING back into PONG (as per the RFC).


--- /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/01/27 21:10:02	1.13
+++ /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/15 19:03:53	1.14
@@ -1,4 +1,4 @@
-;;;; $Id: event.lisp,v 1.13 2006/01/27 21:10:02 ehuelsmann Exp $
+;;;; $Id: event.lisp,v 1.14 2006/02/15 19:03:53 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -85,26 +85,27 @@
       (re-apply-case-mapping connection))))
 
 (defmethod default-hook ((message irc-rpl_whoisuser-message))
-  (let ((user (find-user (connection message)
-                         (second (arguments message))))
-        (realname (trailing-argument message))
-        (username (third (arguments message)))
-        (hostname (fourth (arguments message))))
-    (when user
-      (setf (realname user) realname)
-      (setf (username user) username)
-      (setf (hostname user) hostname))))
+  (destructuring-bind
+      (target nick username hostname star realname)
+      (arguments message)
+    (declare (ignore target star))
+    (let ((user (find-user (connection message) nick)))
+      (when user
+        (setf (realname user) realname
+              (username user) username
+              (hostname user) hostname)))))
 
 (defmethod default-hook ((message irc-rpl_list-message))
-  (let ((connection (connection message))
-        (channel (second (arguments message)))
-        (user-count (parse-integer (or (third (arguments message)) "0")))
-        (topic (trailing-argument message)))
-    (add-channel connection (or (find-channel connection channel)
-                                (make-channel connection
-                                              :name channel
-                                              :topic topic
-                                              :user-count user-count)))))
+  (destructuring-bind
+      (channel count topic)
+      (arguments message)
+    (let ((connection (connection message))
+          (user-count (parse-integer count)))
+      (add-channel connection (or (find-channel connection channel)
+                                  (make-channel connection
+                                                :name channel
+                                                :topic topic
+                                                :user-count user-count))))))
 
 (defmethod default-hook ((message irc-rpl_topic-message))
   (setf (topic (find-channel (connection message)
@@ -112,31 +113,34 @@
         (trailing-argument message)))
 
 (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)
-          (set-mode channel 'namreply-in-progress user))
-        (let* ((mode-char (getf (nick-prefixes connection)
-                                (elt nickname 0)))
-               (mode-name (when mode-char
-                            (mode-name-from-char connection
-                                                 channel mode-char))))
-          (when mode-name
-            (if (has-mode-p channel mode-name)
-                (set-mode channel mode-name user)
-              (set-mode-value (add-mode channel mode-name
-                                        (make-mode connection
-                                                   channel mode-name))
-                              user))))))))
+  (let* ((connection (connection message)))
+    (destructuring-bind
+        (nick chan-mode channel names)
+        (arguments message)
+      (let ((channel (find-channel connection channel)))
+        (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 names))
+          (let ((user (find-or-make-user connection
+                                         (canonicalize-nickname connection
+                                                                nickname))))
+            (unless (equal user (user connection))
+              (add-user connection 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
+                                (mode-name-from-char connection
+                                                     channel mode-char))))
+              (when mode-name
+                (if (has-mode-p channel mode-name)
+                    (set-mode channel mode-name user)
+                  (set-mode-value (add-mode channel mode-name
+                                            (make-mode connection
+                                                       channel mode-name))
+                                  user))))))))))
 
 (defmethod default-hook ((message irc-rpl_endofnames-message))
   (let* ((channel (find-channel (connection message)
@@ -152,7 +156,7 @@
       (remove-user channel user))))
 
 (defmethod default-hook ((message irc-ping-message))
-  (pong (connection message) (trailing-argument message)))
+  (apply #'pong (connection message) (arguments message)))
 
 (defmethod default-hook ((message irc-join-message))
   (let* ((connection (connection message))
--- /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2006/02/12 08:08:07	1.33
+++ /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2006/02/15 19:03:53	1.34
@@ -1,4 +1,4 @@
-;;;; $Id: protocol.lisp,v 1.33 2006/02/12 08:08:07 ehuelsmann Exp $
+;;;; $Id: protocol.lisp,v 1.34 2006/02/15 19:03:53 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -817,10 +817,6 @@
     :accessor arguments
     :initarg :arguments
     :type list)
-   (trailing-argument
-    :accessor trailing-argument
-    :initarg :trailing-argument
-    :type string)
    (connection
     :accessor connection
     :initarg :connection)
@@ -837,6 +833,13 @@
   (print-unreadable-object (object stream :type t :identity t)
     (format stream "~A ~A" (source object) (command object))))
 
+;;Compat code; remove after 2006-08-01
+
+(defgeneric trailing-argument (message))
+(defmethod trailing-argument ((message irc-message))
+  (warn "Use of deprecated function irc:trailing-argument")
+  (car (last (arguments message))))
+
 (defgeneric self-message-p (message))
 (defgeneric find-irc-message-class (type))
 (defgeneric client-log (connection message &optional prefix))
--- /project/cl-irc/cvsroot/cl-irc/parse-message.lisp	2005/03/21 18:15:52	1.6
+++ /project/cl-irc/cvsroot/cl-irc/parse-message.lisp	2006/02/15 19:03:53	1.7
@@ -1,4 +1,4 @@
-;;;; $Id: parse-message.lisp,v 1.6 2005/03/21 18:15:52 ehuelsmann Exp $
+;;;; $Id: parse-message.lisp,v 1.7 2006/02/15 19:03:53 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/parse-message.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -60,6 +60,19 @@
 trailing-argument part is not present."
   (cut-between string #\: '(#\Return) :start start))
 
+(defun combine-arguments-and-trailing (string &key (start 0))
+  (multiple-value-bind
+      (start return-string)
+      (return-arguments string :start start)
+    (print return-string)
+    (multiple-value-bind
+        (return-index trailing)
+        (return-trailing-argument string :start start)
+      (print trailing)
+      (values return-index
+              (append return-string (when (and trailing (string/= "" trailing))
+                                      (list trailing)))))))
+
 (defun parse-raw-message (string &key (start 0))
   "Assuming `string' is a valid IRC message, parse the message and
 return the values in the following order:
@@ -78,8 +91,7 @@
                         return-user
                         return-host
                         return-command
-                        return-arguments
-                        return-trailing-argument))
+                        combine-arguments-and-trailing))
       (multiple-value-bind (return-index return-string)
           (funcall function string :start index)
         (setf index return-index)
@@ -145,10 +157,11 @@
   "If `string' is a valid IRC message parse it and return an object of
 the correct type with its slots prefilled according to the information
 in the message."
-  (multiple-value-bind (source user host command arguments trailing-argument)
+  (multiple-value-bind (source user host command arguments)
       (parse-raw-message string)
-    (let ((class 'irc-message)
-          (ctcp (ctcp-message-type trailing-argument)))
+    (let* ((class 'irc-message)
+           (trailing-argument (car (last arguments)))
+           (ctcp (ctcp-message-type trailing-argument)))
       (when command
         (cond
           (nil ;(irc-error-reply-p command)
@@ -177,7 +190,6 @@
                                                   "")
                                      :arguments arguments
                                      :connection nil
-                                     :trailing-argument (or trailing-argument "")
                                      :received-time (get-universal-time)
                                      :raw-message-string (or string ""))))
         (when ctcp



From ehuelsmann at common-lisp.net  Wed Feb 15 19:03:53 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Wed, 15 Feb 2006 13:03:53 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc/test
Message-ID: <20060215190353.B06142A2F0@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc/test
In directory common-lisp:/tmp/cvs-serv16147/test

Modified Files:
	test-parse-message.lisp 
Log Message:
Start eliminating trailing-argument to be RFC compliant.

Step 2 should follow in about half a year,
removing trailing-argument all together.

* event.lisp:
  - Use destructuring-bind to decompose protocol messages (more often).
  - Fix relative arguments-use (i.e. (last arugments)) which isn't applicable
    anymore. [Only the case for irc-rpl_namreply-message.]
  - Fix PONG message - previously using trailing-argument - to pass all
    arguments to PING back into PONG (as per the RFC).


--- /project/cl-irc/cvsroot/cl-irc/test/test-parse-message.lisp	2004/01/05 14:18:07	1.2
+++ /project/cl-irc/cvsroot/cl-irc/test/test-parse-message.lisp	2006/02/15 19:03:53	1.3
@@ -1,4 +1,4 @@
-;;;; $Id: test-parse-message.lisp,v 1.2 2004/01/05 14:18:07 eenge Exp $
+;;;; $Id: test-parse-message.lisp,v 1.3 2006/02/15 19:03:53 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/test/test-parse-message.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -10,6 +10,8 @@
 (defvar *msg3* (format nil "NOTICE AUTH :*** Your forward and reverse DNS don't match~A" #\Return))
 (defvar *msg4* (format nil ":kire_!~~eenge at adsl-156-35-240.asm.bellsouth.net MODE #lisppaste +k key~A" #\Return))
 (defvar *msg5* (format nil ":kire_!~~eenge at adsl-156-35-240.asm.bellsouth.net MODE #lisppaste +bbb *!*@somewhere.com *!*@somewhereles.com *!*@youdontwannaknow.org~A" #\Return))
+(defvar *msg6* (format nil ":kire!~~eenge at 216.248.178.227 PRIVMSG cl-irc heyhey!~A" #\Return))
+
 
 (deftest find-reply-name.1 (irc:find-reply-name 1) :rpl_welcome)
 (deftest find-reply-name.2
@@ -59,4 +61,8 @@
 
 (deftest parse-raw-message.1
     (irc::parse-raw-message cl-irc-test::*msg1*)
-  "kire" "~eenge" "216.248.178.227" "PRIVMSG" ("cl-irc") "heyhey!")
+  "kire" "~eenge" "216.248.178.227" "PRIVMSG" ("cl-irc" "heyhey!"))
+
+(deftest no-trailing.1
+  (irc::parse-raw-message *msg6*)
+  "kire" "~eenge" "216.248.178.227" "PRIVMSG" ("cl-irc" "heyhey!"))



From ehuelsmann at common-lisp.net  Wed Feb 15 19:14:33 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Wed, 15 Feb 2006 13:14:33 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060215191433.4D1434B01F@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv17343

Modified Files:
	parse-message.lisp protocol.lisp 
Log Message:
Silence SBCL compile warnings (one of which being a real bug).

--- /project/cl-irc/cvsroot/cl-irc/parse-message.lisp	2006/02/15 19:03:53	1.7
+++ /project/cl-irc/cvsroot/cl-irc/parse-message.lisp	2006/02/15 19:14:33	1.8
@@ -1,4 +1,4 @@
-;;;; $Id: parse-message.lisp,v 1.7 2006/02/15 19:03:53 ehuelsmann Exp $
+;;;; $Id: parse-message.lisp,v 1.8 2006/02/15 19:14:33 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/parse-message.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -164,12 +164,12 @@
            (ctcp (ctcp-message-type trailing-argument)))
       (when command
         (cond
-          (nil ;(irc-error-reply-p command)
+          ;;((irc-error-reply-p command)
            ;; Disable for now, as it prevents adding hooks for some useful
            ;; error types
-           (progn
-             (setf command (find-reply-name (parse-integer command)))
-             (setf class 'irc-error-reply)))
+           ;;(progn
+           ;;  (setf command (find-reply-name (parse-integer command)))
+           ;;  (setf class 'irc-error-reply)))
           ((numeric-reply-p command)
            (progn
              (setf command (find-reply-name (parse-integer command)))
--- /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2006/02/15 19:03:53	1.34
+++ /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2006/02/15 19:14:33	1.35
@@ -1,4 +1,4 @@
-;;;; $Id: protocol.lisp,v 1.34 2006/02/15 19:03:53 ehuelsmann Exp $
+;;;; $Id: protocol.lisp,v 1.35 2006/02/15 19:14:33 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -261,7 +261,8 @@
 (defun start-background-message-handler (connection)
   "Read messages from the `connection', parse them and dispatch
 irc-message-event on them. Returns background process ID if available."
-  (flet ((do-loop () (read-message-loop connection)))
+  (flet (#-(and sbcl (not sb-thread))
+           (do-loop () (read-message-loop connection)))
     (let ((name (format nil "irc-hander-~D" (incf *process-count*))))
       #+(or allegro cmu lispworks sb-thread openmcl armedbear)
       (start-process #'do-loop name)
@@ -426,7 +427,8 @@
 ;; generic functions.  need to resolve.
 (defmethod dcc-close ((connection dcc-connection))
   #+(and sbcl (not sb-thread))
-  (sb-sys:invalidate-descriptor (sb-sys:fd-stream-fd (stream connection)))
+  (sb-sys:invalidate-descriptor
+   (sb-sys:fd-stream-fd (network-stream connection)))
   (close (network-stream connection))
   (setf (user connection) nil)
   (setf *dcc-connections* (remove connection *dcc-connections*))



From ehuelsmann at common-lisp.net  Wed Feb 15 19:15:21 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Wed, 15 Feb 2006 13:15:21 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060215191521.8D45F4E010@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv18563

Modified Files:
	variable.lisp 
Log Message:
Make variable.lisp report the real version number we're actually working toward.

--- /project/cl-irc/cvsroot/cl-irc/variable.lisp	2005/03/27 19:21:28	1.6
+++ /project/cl-irc/cvsroot/cl-irc/variable.lisp	2006/02/15 19:15:21	1.7
@@ -1,4 +1,4 @@
-;;;; $Id: variable.lisp,v 1.6 2005/03/27 19:21:28 ehuelsmann Exp $
+;;;; $Id: variable.lisp,v 1.7 2006/02/15 19:15:21 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/variable.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -10,7 +10,7 @@
 
 (defconstant +soh+ #.(code-char 1))
 
-(defparameter *version* "0.1.0")
+(defparameter *version* "0.8.0-dev")
 (defparameter *ctcp-version*
   (format nil "CL IRC library, cl-irc:~A:~A ~A"
           *version* (machine-type) (machine-version)))



From ehuelsmann at common-lisp.net  Wed Feb 15 20:14:21 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Wed, 15 Feb 2006 14:14:21 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060215201421.DB30F76014@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv24527

Modified Files:
	command.lisp event.lisp protocol.lisp utility.lisp 
Log Message:
Remove the 'trailing argument' notion from send-irc-message:
the last argument will now always be 'trailing'.

--- /project/cl-irc/cvsroot/cl-irc/command.lisp	2006/02/14 21:51:21	1.15
+++ /project/cl-irc/cvsroot/cl-irc/command.lisp	2006/02/15 20:14:21	1.16
@@ -1,4 +1,4 @@
-;;;; $Id: command.lisp,v 1.15 2006/02/14 21:51:21 ehuelsmann Exp $
+;;;; $Id: command.lisp,v 1.16 2006/02/15 20:14:21 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/command.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -77,62 +77,62 @@
 is now registered and known the to the entire IRC network.  The reply
 message MUST contain the full client identifier upon which it was
 registered."
-  (send-irc-message connection :pass nil password))
+  (send-irc-message connection :pass password))
 
 (defmethod nick ((connection connection) (new-nickname string))
-  (send-irc-message connection :nick nil new-nickname))
+  (send-irc-message connection :nick new-nickname))
 
 (defmethod user- ((connection connection) (username string)
                   (mode integer) &optional (realname ""))
-  (send-irc-message connection :user realname username mode "*"))
+  (send-irc-message connection :user username mode "*" realname))
 
 (defmethod oper ((connection connection) (name string) (password string))
-  (send-irc-message connection :oper nil name password))
+  (send-irc-message connection :oper name password))
 
 (defmethod mode ((connection connection) (nickname string) (mode string))
-  (send-irc-message connection :mode nil nickname mode))
+  (send-irc-message connection :mode nickname mode))
 
 ;; utility functions not part of the RFCs
 (defmethod op ((connection connection) (channel string) (nickname string))
-  (send-irc-message connection :mode nil channel "+o" nickname))
+  (send-irc-message connection :mode channel "+o" nickname))
 
 (defmethod op ((connection connection) (channel channel) (user user))
   (op connection (name channel) (nickname user)))
 
 (defmethod deop ((connection connection) (channel string) (nickname string))
-  (send-irc-message connection :mode nil channel "-o" nickname))
+  (send-irc-message connection :mode channel "-o" nickname))
 
 (defmethod deop ((connection connection) (channel channel) (user user))
   (deop connection (name channel) (nickname user)))
 
 (defmethod voice ((connection connection) (channel string) (nickname string))
-  (send-irc-message connection :mode nil channel "+v" nickname))
+  (send-irc-message connection :mode channel "+v" nickname))
 
 (defmethod voice ((connection connection) (channel channel) (user user))
   (voice connection (name channel) (nickname user)))
 
 (defmethod devoice ((connection connection) (channel string) (nickname string))
-  (send-irc-message connection :mode nil channel "-v" nickname))
+  (send-irc-message connection :mode channel "-v" nickname))
 
 (defmethod devoice ((connection connection) (channel channel) (user user))
   (devoice connection (name channel) (nickname user)))
 
 (defmethod ban ((connection connection) (channel string) (mask string))
-  (send-irc-message connection :mode nil channel "+b" mask))
+  (send-irc-message connection :mode channel "+b" mask))
 
 (defmethod ban ((connection connection) (channel channel) (mask string))
   (ban connection (name channel) mask))
 
 ;; unban or deban?
 (defmethod unban ((connection connection) (channel string) (mask string))
-  (send-irc-message connection :mode nil channel "-b" mask))
+  (send-irc-message connection :mode channel "-b" mask))
 
 (defmethod unban ((connection connection) (channel channel) (mask string))
   (unban connection (name channel) mask))
 
 (defmethod service ((connection connection) (nickname string)
                     (distribution string) (info string))
-  (send-irc-message connection :service info nickname "*" distribution 0 0 info))
+  (send-irc-message connection :service nickname "*" distribution 0 0 info))
 
 (defmethod quit ((connection connection) &optional (message *default-quit-message*))
   (remove-all-channels connection)
@@ -145,10 +145,11 @@
     (close (network-stream connection))))
 
 (defmethod squit ((connection connection) (server string) (comment string))
-  (send-irc-message connection :squit comment server))
+  (send-irc-message connection :squit server comment))
 
 (defmethod join ((connection connection) (channel string) &key password)
-  (apply #'send-irc-message connection :join nil channel (when password (list password))))
+  (apply #'send-irc-message
+         connection :join channel (when password (list password))))
 
 (defmethod join ((connection connection) (channel channel) &key password)
   (join connection (name channel) :password password))
@@ -159,7 +160,7 @@
     (join connection channel)))
 
 (defmethod part ((connection connection) (channel string))
-  (send-irc-message connection :part nil channel))
+  (send-irc-message connection :part channel))
 
 (defmethod part ((connection connection) (channel channel))
   (part connection (name channel)))
@@ -170,14 +171,14 @@
     (part connection (name channel))))
 
 (defmethod topic- ((connection connection) (channel string) (topic string))
-  (send-irc-message connection :topic topic channel))
+  (send-irc-message connection :topic channel topic))
 
 (defmethod topic- ((connection connection) (channel channel) (topic string))
   (topic- connection (name channel) topic))
 
 (defmethod names ((connection connection) (channel string)
                   &optional (target ""))
-  (send-irc-message connection :names nil channel target))
+  (send-irc-message connection :names channel target))
 
 (defmethod names ((connection connection) (channel channel)
                   &optional (target ""))
@@ -185,24 +186,24 @@
 
 (defmethod list- ((connection connection) &optional
                   (channel "") (target ""))
-  (send-irc-message connection :list nil channel target))
+  (send-irc-message connection :list channel target))
 
 (defmethod invite ((connection connection) (nickname string) (channel string))
-  (send-irc-message connection :invite nil nickname channel))
+  (send-irc-message connection :invite nickname channel))
 
 (defmethod invite ((connection connection) (user user) (channel channel))
   (invite connection (nickname user) (name channel)))
 
 (defmethod kick ((connection connection) (channel string)
                  (user string) &optional (comment ""))
-  (send-irc-message connection :kick comment channel user))
+  (send-irc-message connection :kick channel user comment))
 
 (defmethod kick ((connection connection) (channel channel)
                  (user user) &optional (comment ""))
   (kick connection (name channel) (nickname user) comment))
 
 (defmethod privmsg ((connection connection) (target string) (message string))
-  (send-irc-message connection :privmsg message target))
+  (send-irc-message connection :privmsg target message))
 
 (defmethod privmsg ((connection connection) (user user) (message string))
   (privmsg connection (nickname user) message))
@@ -211,7 +212,7 @@
   (privmsg connection (name channel) message))
 
 (defmethod notice ((connection connection) (target string) (message string))
-  (send-irc-message connection :notice message target))
+  (send-irc-message connection :notice target message))
 
 (defmethod notice ((connection connection) (user user) (message string))
   (notice connection (nickname user) message))
@@ -220,23 +221,23 @@
   (notice connection (name channel) message))
 
 (defmethod motd- ((connection connection) &optional (target ""))
-  (send-irc-message connection :motd nil target))
+  (send-irc-message connection :motd target))
 
 (defmethod lusers ((connection connection) &optional (mask "") (target ""))
-  (send-irc-message connection :lusers nil mask target))
+  (send-irc-message connection :lusers mask target))
 
 (defmethod version ((connection connection) &optional (target ""))
-  (send-irc-message connection :version nil target))
+  (send-irc-message connection :version target))
 
 (defmethod stats ((connection connection) &optional (query "") (target ""))
-  (send-irc-message connection :stats nil query target))
+  (send-irc-message connection :stats query target))
 
 (defmethod links ((connection connection) &optional (remote-server "")
                   (server-mask ""))
-  (send-irc-message connection :links nil remote-server server-mask))
+  (send-irc-message connection :links remote-server server-mask))
 
 (defmethod time- ((connection connection) &optional (target ""))
-  (send-irc-message connection :time nil target))
+  (send-irc-message connection :time target))
 
 (defun connect (&key (nickname *default-nickname*)
                      (username nil)
@@ -266,29 +267,29 @@
     connection))
 
 (defmethod trace- ((connection connection) &optional (target ""))
-  (send-irc-message connection :trace nil target))
+  (send-irc-message connection :trace target))
 
 (defmethod admin ((connection connection) &optional (target ""))
-  (send-irc-message connection :admin nil target))
+  (send-irc-message connection :admin target))
 
 (defmethod info ((connection connection) &optional (target ""))
-  (send-irc-message connection :info nil target))
+  (send-irc-message connection :info target))
 
 (defmethod servlist ((connection connection) &optional (mask "") (type ""))
-  (send-irc-message connection :servlist nil mask type))
+  (send-irc-message connection :servlist mask type))
 
 (defmethod squery ((connection connection) (service-name string) (text string))
   (send-irc-message connection :squery text service-name))
 
 (defmethod who ((connection connection) &optional (mask "") (o ""))
-  (send-irc-message connection :who nil mask o))
+  (send-irc-message connection :who mask o))
 
 (defmethod whois ((connection connection) (mask string) &optional (target ""))
-  (send-irc-message connection :whois nil target mask))
+  (send-irc-message connection :whois target mask))
 
 (defmethod whowas ((connection connection) (nickname string)
                    &optional (count "") (target ""))
-  (send-irc-message connection :whowas nil nickname count target))
+  (send-irc-message connection :whowas nickname count target))
 
 (defmethod kill ((connection connection) (nickname string) &optional (comment ""))
   (send-irc-message connection :kill comment nickname))
@@ -297,10 +298,10 @@
   (kill connection (nickname user) comment))
 
 (defmethod ping ((connection connection) (server string))
-  (send-irc-message connection :ping nil server))
+  (send-irc-message connection :ping server))
 
 (defmethod pong ((connection connection) (server string) &optional (server2 ""))
-  (send-irc-message connection :pong nil server server2))
+  (send-irc-message connection :pong server server2))
 
 (defmethod error- ((connection connection) (message string))
   (send-irc-message connection :error message))
@@ -319,29 +320,29 @@
 
 (defmethod summon ((connection connection) (nickname string)
                    &optional (target "") (channel ""))
-  (send-irc-message connection :summon nil nickname target channel))
+  (send-irc-message connection :summon nickname target channel))
 
 (defmethod users- ((connection connection) &optional (target ""))
-  (send-irc-message connection :users nil target))
+  (send-irc-message connection :users target))
 
 (defmethod wallops ((connection connection) (message string))
   (send-irc-message connection :wallops message))
 
 (defmethod userhost ((connection connection) (nickname string))
-  (send-irc-message connection :userhost nil nickname))
+  (send-irc-message connection :userhost nickname))
 
 (defmethod userhost ((connection connection) (user user))
   (userhost connection (nickname user)))
 
 (defmethod ison ((connection connection) (nickname string))
-  (send-irc-message connection :ison nil nickname))
+  (send-irc-message connection :ison nickname))
 
 (defmethod ison ((connection connection) (user user))
   (ison connection (nickname user)))
 
 ;; utility functions not part of the RFC
 (defmethod ctcp ((connection connection) target message)
-  (send-irc-message connection :privmsg (make-ctcp-message message) target))
+  (send-irc-message connection :privmsg target (make-ctcp-message message)))
 
 #|
 There's too much wrong with this method to fix it now.
--- /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/15 19:03:53	1.14
+++ /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/15 20:14:21	1.15
@@ -1,4 +1,4 @@
-;;;; $Id: event.lisp,v 1.14 2006/02/15 19:03:53 ehuelsmann Exp $
+;;;; $Id: event.lisp,v 1.15 2006/02/15 20:14:21 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -251,20 +251,21 @@
   (multiple-value-bind (second minute hour date month year day) (get-decoded-time)
     (send-irc-message
      (connection message)
-     :notice (make-ctcp-message
-              (format nil "TIME ~A"
-                      (make-time-message second minute hour date month year day)))
-     (source 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 (make-ctcp-message
-            (format nil "SOURCE ~A:~A:~A"
-                    *download-host*
-                    *download-directory*
-                    *download-file*))
-   (source 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)))
@@ -273,23 +274,23 @@
                           (nickname user))))
     (send-irc-message
      (connection message)
-     :notice (make-ctcp-message
-              (format nil "FINGER ~A" finger-info))
-     (source 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 (make-ctcp-message
-            (format nil "VERSION ~A" *ctcp-version*))
-   (source 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 (make-ctcp-message
-            (format nil "PING ~A" (trailing-argument message)))
-   (source message)))
+   :notice (source message)
+   (make-ctcp-message
+    (format nil "PING ~A" (trailing-argument message)))))
 
 (defmethod irc-message-event (connection (message ctcp-dcc-chat-request-message))
   (declare (ignore connection))
--- /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2006/02/15 19:14:33	1.35
+++ /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2006/02/15 20:14:21	1.36
@@ -1,4 +1,4 @@
-;;;; $Id: protocol.lisp,v 1.35 2006/02/15 19:14:33 ehuelsmann Exp $
+;;;; $Id: protocol.lisp,v 1.36 2006/02/15 20:14:21 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -172,8 +172,7 @@
 (defgeneric read-message (connection))
 (defgeneric start-process (function name))
 (defgeneric read-irc-message (connection))
-(defgeneric send-irc-message (connection command
-                             &optional trailing-argument &rest arguments))
+(defgeneric send-irc-message (connection command &rest arguments))
 (defgeneric get-hooks (connection class))
 (defgeneric add-hook (connection class hook))
 (defgeneric remove-hook (connection class hook))
@@ -304,12 +303,10 @@
        ;; satisfy read-message-loop assumption of nil when no more messages
 
 (defmethod send-irc-message ((connection connection) command
-                             &optional trailing-argument &rest arguments)
+                             &rest arguments)
   "Turn the arguments into a valid IRC message and send it to the
 server, via the `connection'."
-  (let ((raw-message (make-irc-message command
-                                       :arguments arguments
-                                       :trailing-argument trailing-argument)))
+  (let ((raw-message (apply #'make-irc-message command arguments)))
     (write-sequence raw-message (network-stream connection))
     (force-output (network-stream connection))
     raw-message))
--- /project/cl-irc/cvsroot/cl-irc/utility.lisp	2006/01/24 22:10:58	1.9
+++ /project/cl-irc/cvsroot/cl-irc/utility.lisp	2006/02/15 20:14:21	1.10
@@ -1,4 +1,4 @@
-;;;; $Id: utility.lisp,v 1.9 2006/01/24 22:10:58 ehuelsmann Exp $
+;;;; $Id: utility.lisp,v 1.10 2006/02/15 20:14:21 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/utility.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -49,18 +49,14 @@
           second
           year))
 
-(defun make-irc-message (command &key (arguments nil)
-                                 (trailing-argument nil))
+(defun make-irc-message (command &rest arguments)
   "Return a valid IRC message, as a string, composed of the input
 parameters."
   (let ((*print-circle* nil))
-    (format nil "~A~{ ~A~}~A~A~A~A" command arguments
-	    (if trailing-argument
-		" :"
-              "")
-	    (or trailing-argument "")
-	    #\Return
-	    #\Linefeed)))
+    (format nil
+            "~A~{ ~A~}~@[ :~A~]~A~A"
+            command (butlast arguments) (car (last arguments))
+            #\Return #\Linefeed)))
 
 (defun make-ctcp-message (string)
   "Return a valid IRC CTCP message, as a string, composed by



From ehuelsmann at common-lisp.net  Wed Feb 15 20:22:50 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Wed, 15 Feb 2006 14:22:50 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060215202250.5F6022A1D6@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv26079

Modified Files:
	event.lisp 
Log Message:
Support IRCNet irc-rpl_*list-message replies. Patch by Andreas Fuchs.

--- /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/15 20:14:21	1.15
+++ /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/15 20:22:50	1.16
@@ -1,4 +1,4 @@
-;;;; $Id: event.lisp,v 1.15 2006/02/15 20:14:21 ehuelsmann Exp $
+;;;; $Id: event.lisp,v 1.16 2006/02/15 20:22:50 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -26,7 +26,7 @@
   `(progn
      (defmethod default-hook ((message ,listmsg-class))
        (destructuring-bind
-           (target channel-name mask set-by time-set)
+           (target channel-name mask &optional set-by time-set)
            (arguments message)
          (declare (ignore target set-by time-set))
          ;; note: the structure currently does not allow for logging



From ehuelsmann at common-lisp.net  Wed Feb 15 20:42:48 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Wed, 15 Feb 2006 14:42:48 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060215204248.9F07E6F00C@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv27877

Modified Files:
	event.lisp 
Log Message:
Fix breakage where a quit message is sent before join or namreply (typically with bouncens).
Suggested by Andreas Fuchs.

--- /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/15 20:22:50	1.16
+++ /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/15 20:42:48	1.17
@@ -1,4 +1,4 @@
-;;;; $Id: event.lisp,v 1.16 2006/02/15 20:22:50 ehuelsmann Exp $
+;;;; $Id: event.lisp,v 1.17 2006/02/15 20:42:48 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -187,8 +187,10 @@
         (remove-user channel user))))
 
 (defmethod default-hook ((message irc-quit-message))
-  (let ((connection (connection message)))
-    (remove-user-everywhere connection (find-user connection (source message)))))
+  (let* ((connection (connection message))
+         (user (find-user connection (source message))))
+    (unless (null user)
+      (remove-user-everywhere connection user))))
 
 (defmethod default-hook ((message irc-rpl_channelmodeis-message))
   (destructuring-bind



From ehuelsmann at common-lisp.net  Wed Feb 15 23:24:35 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Wed, 15 Feb 2006 17:24:35 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060215232435.113206D005@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv16585

Modified Files:
	event.lisp utility.lisp 
Log Message:
Fix crash on unknown modes.tility.lisp

--- /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/15 20:42:48	1.17
+++ /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/15 23:24:34	1.18
@@ -1,4 +1,4 @@
-;;;; $Id: event.lisp,v 1.17 2006/02/15 20:42:48 ehuelsmann Exp $
+;;;; $Id: event.lisp,v 1.18 2006/02/15 23:24:34 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -108,9 +108,11 @@
                                                 :user-count user-count))))))
 
 (defmethod default-hook ((message irc-rpl_topic-message))
-  (setf (topic (find-channel (connection message)
-                             (second (arguments message))))
-        (trailing-argument message)))
+  (destructuring-bind
+      (target channel topic)
+      (arguments message)
+    (declare (ignore target))
+    (setf (topic (find-channel (connection message) channel)) topic)))
 
 (defmethod default-hook ((message irc-rpl_namreply-message))
   (let* ((connection (connection message)))
@@ -159,32 +161,43 @@
   (apply #'pong (connection message) (arguments message)))
 
 (defmethod default-hook ((message irc-join-message))
-  (let* ((connection (connection message))
-         (user (find-or-make-user
-                (connection message)
-                (source message)
-                :hostname (host message)
-                :username (user message)))
-         (channel (or (find-channel connection (trailing-argument message))
-                      (make-channel connection
-                                    :name (trailing-argument message)))))
-    (when (self-message-p message)
-      (add-channel connection channel))
-    (add-user connection user)
-    (add-user channel user)))
+  (with-slots
+       (connection source host user arguments)
+       message
+    (destructuring-bind
+        (channel)
+        arguments
+      (let ((user (find-or-make-user connection source
+                                     :hostname host
+                                     :username user))
+            (channel (or (find-channel connection channel)
+                         (make-channel connection :name channel))))
+        (when (self-message-p message)
+          (add-channel connection channel))
+        (add-user connection user)
+        (add-user channel user)))))
 
 (defmethod default-hook ((message irc-topic-message))
-  (setf (topic (find-channel (connection message)
-                             (first (arguments message))))
-        (trailing-argument message)))
+  (with-slots
+       (connection arguments)
+       message
+    (destructuring-bind
+        (channel &optional topic)
+        arguments
+      (setf (topic (find-channel connection channel)) topic))))
 
 (defmethod default-hook ((message irc-part-message))
-  (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))))
+  (with-slots
+      (connection arguments source)
+      message
+    (destructuring-bind
+        (channel &optional text)
+        arguments
+      (let ((channel (find-channel connection channel))
+            (user (find-user connection source)))
+        (if (self-message-p message)
+            (remove-channel user channel)
+          (remove-user channel user))))))
 
 (defmethod default-hook ((message irc-quit-message))
   (let* ((connection (connection message))
@@ -193,30 +206,34 @@
       (remove-user-everywhere connection user))))
 
 (defmethod default-hook ((message irc-rpl_channelmodeis-message))
-  (destructuring-bind
-      (target &rest arguments)
-      ;; ignore the my own nick which is the first message argument
-      (rest (arguments message))
-    (let* ((connection (connection message))
-           (target (find-channel connection target))
+  (with-slots
+      (connection arguments)
+      message
+    (destructuring-bind
+        (target channel &rest mode-arguments)
+        arguments
+    (declare (ignore target))
+    (let* ((channel (find-channel connection channel))
            (mode-changes
-            (when target
-              (parse-mode-arguments connection target arguments
+            (when channel
+              (parse-mode-arguments connection channel arguments
                                     :server-p (user connection)))))
       (dolist (change mode-changes)
         (destructuring-bind
             (op mode-name value)
             change
-          (unless (has-mode-p target mode-name)
+          (unless (has-mode-p channel mode-name)
             (add-mode target mode-name
-                      (make-mode connection target mode-name)))
+                      (make-mode connection channel mode-name)))
           (funcall (if (char= #\+ op) #'set-mode #'unset-mode)
-                   target mode-name value))))))
+                   channel mode-name value)))))))
 
 (defmethod default-hook ((message irc-mode-message))
   (destructuring-bind
       (target &rest arguments)
       (arguments message)
+    (print (arguments message))
+    (print arguments)
     (let* ((connection (connection message))
            (target (or (find-channel connection target)
                        (find-user connection target)))
@@ -235,22 +252,35 @@
                    target mode-name value))))))
 
 (defmethod default-hook ((message irc-nick-message))
-  (let* ((con (connection message))
-         (user (find-or-make-user con (source message)
-                                  :hostname (host message)
-                                  :username (user message))))
-    (change-nickname con user (trailing-argument message))))
+  (with-slots
+      (connection source host user arguments)
+      message
+    (destructuring-bind
+        (new-nick)
+        arguments
+      (let* ((user (find-or-make-user connection source
+                                      :hostname host
+                                      :username user)))
+        (change-nickname connection user new-nick)))))
 
 (defmethod default-hook ((message irc-kick-message))
-  (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))))
+  (with-slots
+      (connection arguments)
+      message
+    (destructuring-bind
+        (channel nick &optional reason)
+        arguments
+      (declare (ignore arguments))
+      (let* ((channel (find-channel connection channel))
+             (user (find-user connection nick)))
+        (if (self-message-p message)
+            (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)
+  (multiple-value-bind
+      (second minute hour date month year day)
+      (get-decoded-time)
     (send-irc-message
      (connection message)
      :notice (source message)
--- /project/cl-irc/cvsroot/cl-irc/utility.lisp	2006/02/15 20:14:21	1.10
+++ /project/cl-irc/cvsroot/cl-irc/utility.lisp	2006/02/15 23:24:34	1.11
@@ -1,4 +1,4 @@
-;;;; $Id: utility.lisp,v 1.10 2006/02/15 20:14:21 ehuelsmann Exp $
+;;;; $Id: utility.lisp,v 1.11 2006/02/15 23:24:34 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/utility.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -292,9 +292,11 @@
                          (mode-description connection target
                                            (mode-name-from-char connection target
                                                                 (char modes i))))
-                        (param-p (funcall param-req mode-rec)))
-                   (when (and param-p
-                              (= 0 (length arguments)))
+                        (param-p (when mode-rec
+                                   (funcall param-req mode-rec))))
+                   (when (or (null mode-rec)
+                             (and param-p
+                                  (= 0 (length arguments))))
                      (throw 'illegal-mode-spec nil))
                    (push (list this-op
                                (mode-desc-symbol mode-rec)



From ehuelsmann at common-lisp.net  Wed Feb 15 23:47:19 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Wed, 15 Feb 2006 17:47:19 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060215234719.05B3D7901A@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv20440

Modified Files:
	event.lisp parse-message.lisp 
Log Message:
Remove debugging print forms.

--- /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/15 23:24:34	1.18
+++ /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/15 23:47:19	1.19
@@ -1,4 +1,4 @@
-;;;; $Id: event.lisp,v 1.18 2006/02/15 23:24:34 ehuelsmann Exp $
+;;;; $Id: event.lisp,v 1.19 2006/02/15 23:47:19 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -232,8 +232,6 @@
   (destructuring-bind
       (target &rest arguments)
       (arguments message)
-    (print (arguments message))
-    (print arguments)
     (let* ((connection (connection message))
            (target (or (find-channel connection target)
                        (find-user connection target)))
--- /project/cl-irc/cvsroot/cl-irc/parse-message.lisp	2006/02/15 19:14:33	1.8
+++ /project/cl-irc/cvsroot/cl-irc/parse-message.lisp	2006/02/15 23:47:19	1.9
@@ -1,4 +1,4 @@
-;;;; $Id: parse-message.lisp,v 1.8 2006/02/15 19:14:33 ehuelsmann Exp $
+;;;; $Id: parse-message.lisp,v 1.9 2006/02/15 23:47:19 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/parse-message.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -64,11 +64,9 @@
   (multiple-value-bind
       (start return-string)
       (return-arguments string :start start)
-    (print return-string)
     (multiple-value-bind
         (return-index trailing)
         (return-trailing-argument string :start start)
-      (print trailing)
       (values return-index
               (append return-string (when (and trailing (string/= "" trailing))
                                       (list trailing)))))))



From ehuelsmann at common-lisp.net  Sun Feb 19 22:47:40 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Sun, 19 Feb 2006 16:47:40 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060219224740.9EDD62A01A@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv1364

Modified Files:
	event.lisp 
Log Message:
Fix RPL_ISUPPORT when server sends more than noe response (freenode does).

--- /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/15 23:47:19	1.19
+++ /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/19 22:47:40	1.20
@@ -1,4 +1,4 @@
-;;;; $Id: event.lisp,v 1.19 2006/02/15 23:47:19 ehuelsmann Exp $
+;;;; $Id: event.lisp,v 1.20 2006/02/19 22:47:40 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -63,26 +63,38 @@
                          invitelist-in-progress :invite)
 
 (defmethod default-hook ((message irc-rpl_isupport-message))
-  (let* ((capabilities (cdr (arguments message)))
-         (connection (connection message))
-         (current-case-mapping (case-map-name connection)))
-    (setf (server-capabilities connection)
-          (let ((new-values (mapcar #'(lambda (x)
-                                        (let ((eq-pos (position #\= x)))
-                                          (if eq-pos
-                                              (list (subseq x 0 eq-pos)
-                                                    (subseq x (1+ eq-pos)))
-                                            (list x)))) capabilities)))
-            (merge 'list new-values (copy-seq *default-isupport-values*)
-                   #'string= :key #'first)))
-    (setf (channel-mode-descriptions connection)
-          (chanmode-descs-from-isupport (server-capabilities connection))
-          (nick-prefixes connection)
-          (nick-prefixes-from-isupport (server-capabilities connection)))
-    (when (not (equal current-case-mapping
-                      (case-map-name connection)))
-      ;; we need to re-normalize nicks and channel names
-      (re-apply-case-mapping connection))))
+  (destructuring-bind
+      (target &rest capabilities)
+      ;; the last argument contains only an explanitory text
+      (butlast (arguments message))
+    (declare (ignore target))
+    (let* ((connection (connection message))
+           (current-case-mapping (case-map-name connection)))
+      (setf (server-capabilities connection)
+            (reduce #'(lambda (x y)
+                        ;; O(n^2), but we're talking small lists anyway...
+                        ;; maybe I should have chosen a hash interface
+                        ;; after all...
+                        (if (assoc (first y) x :test #'string=)
+                            x
+                          (cons y x)))
+                    (append
+                     (mapcar #'(lambda (x)
+                                 (let ((eq-pos (position #\= x)))
+                                   (if eq-pos
+                                       (list (subseq x 0 eq-pos)
+                                             (subseq x (1+ eq-pos)))
+                                     (list x)))) capabilities)
+                     (server-capabilities connection))
+                    :initial-value '()))
+      (setf (channel-mode-descriptions connection)
+            (chanmode-descs-from-isupport (server-capabilities connection))
+            (nick-prefixes connection)
+            (nick-prefixes-from-isupport (server-capabilities connection)))
+      (when (not (equal current-case-mapping
+                        (case-map-name connection)))
+        ;; we need to re-normalize nicks and channel names
+        (re-apply-case-mapping connection)))))
 
 (defmethod default-hook ((message irc-rpl_whoisuser-message))
   (destructuring-bind



From ehuelsmann at common-lisp.net  Mon Feb 20 06:53:25 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Mon, 20 Feb 2006 00:53:25 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060220065325.B61717E015@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv30492

Modified Files:
	protocol.lisp event.lisp 
Log Message:
Remove last uses of trailing-argument.

--- /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2006/02/15 20:14:21	1.36
+++ /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2006/02/20 06:53:25	1.37
@@ -1,4 +1,4 @@
-;;;; $Id: protocol.lisp,v 1.36 2006/02/15 20:14:21 ehuelsmann Exp $
+;;;; $Id: protocol.lisp,v 1.37 2006/02/20 06:53:25 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -889,8 +889,8 @@
             (received-time message)
             (command message)
             (source message)
-            (arguments message)
-            (trailing-argument message))
+            (butlast (arguments message))
+            (car (last (arguments message))))
     (force-output stream)))
 
 (defmethod apply-to-hooks ((message irc-message))
@@ -940,7 +940,7 @@
             (command message)
             (ctcp-command message)
             (source message)
-            (arguments message)
-            (trailing-argument message))
+            (butlast (arguments message))
+            (car (last (arguments message))))
     (force-output stream)))
 
--- /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/19 22:47:40	1.20
+++ /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/20 06:53:25	1.21
@@ -1,4 +1,4 @@
-;;;; $Id: event.lisp,v 1.20 2006/02/19 22:47:40 ehuelsmann Exp $
+;;;; $Id: event.lisp,v 1.21 2006/02/20 06:53:25 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -332,7 +332,7 @@
    (connection message)
    :notice (source message)
    (make-ctcp-message
-    (format nil "PING ~A" (trailing-argument message)))))
+    (format nil "PING ~A" (car (last (arguments message)))))
 
 (defmethod irc-message-event (connection (message ctcp-dcc-chat-request-message))
   (declare (ignore connection))



From ehuelsmann at common-lisp.net  Mon Feb 20 17:27:57 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Mon, 20 Feb 2006 11:27:57 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060220172757.75DDF2A024@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv9527

Modified Files:
	event.lisp 
Log Message:
Oops! Too few closing parents...

--- /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/20 06:53:25	1.21
+++ /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/20 17:27:57	1.22
@@ -1,4 +1,4 @@
-;;;; $Id: event.lisp,v 1.21 2006/02/20 06:53:25 ehuelsmann Exp $
+;;;; $Id: event.lisp,v 1.22 2006/02/20 17:27:57 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -332,7 +332,7 @@
    (connection message)
    :notice (source message)
    (make-ctcp-message
-    (format nil "PING ~A" (car (last (arguments message)))))
+    (format nil "PING ~A" (car (last (arguments message)))))))
 
 (defmethod irc-message-event (connection (message ctcp-dcc-chat-request-message))
   (declare (ignore connection))



From ehuelsmann at common-lisp.net  Mon Feb 20 20:26:54 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Mon, 20 Feb 2006 14:26:54 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060220202654.7C9E459018@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv4290

Modified Files:
	utility.lisp 
Log Message:
Add arguments binding helper macro now that trailing-argument is deprecated.

--- /project/cl-irc/cvsroot/cl-irc/utility.lisp	2006/02/15 23:24:34	1.11
+++ /project/cl-irc/cvsroot/cl-irc/utility.lisp	2006/02/20 20:26:54	1.12
@@ -1,4 +1,4 @@
-;;;; $Id: utility.lisp,v 1.11 2006/02/15 23:24:34 ehuelsmann Exp $
+;;;; $Id: utility.lisp,v 1.12 2006/02/20 20:26:54 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/utility.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -158,6 +158,75 @@
                     (subseq string cut-from end-position))
           (values start nil))))))
 
+
+;;
+;; Message arguments binding macro
+;;
+
+
+(defmacro destructuring-arguments (lambda-list message &body body)
+  "Destructures the arguments slot in MESSAGE according
+to LAMBDA-LIST and binds them in BODY.
+destructuring-irc-message-arguments's lambda list syntax is as follows:
+
+reqvars::= var*
+optvars::= [&optional {var | (var [init-form [supplied-p-parameter]])}*]
+restvar::= [&rest var]
+wholevar::= [&whole var]
+lastvar::= [&last var]
+lambda-list::= (wholevar reqvars optvars restvar lastvar)
+
+With the exception of &last, all lambda list keywords are
+analogous to a destructuring lambda list's (see clhs 3.4.5).
+
+If &last is given, the specified variable is bound to the last
+argument in the message. Specifying &last implies that all
+arguments past the last of the required variables will be
+ignored, even if there is no &rest lambda list keyword present.
+
+If both &rest and &last are specified, the last element in the
+list is also included in the rest list."
+  (let ((valid-bare-ll-keywords '(&optional &rest &whole))
+        (nothing (gensym))
+        (%message (gensym)))
+    (labels ((keyword-ll-entry-p (entry)
+               (eql (schar (symbol-name entry) 0) #\&))
+             (valid-bare-ll-entry-p (entry)
+               (or (not (keyword-ll-entry-p entry))
+                   (member entry valid-bare-ll-keywords :test 'string=)))
+             (append-&rest-p (last-entries destructuring-ll)
+              (not (or (null last-entries)
+                       (member '&rest destructuring-ll :test 'string=)))))
+      (let* ((last-entries (member '&last lambda-list :test 'string=))
+             (last-variable (second last-entries))
+             (destructuring-ll (butlast lambda-list (length last-entries)))
+             (invalid-ll-entries (remove-if #'valid-bare-ll-entry-p
+                                            destructuring-ll)))
+        (unless (or (null last-entries) (= 2 (length last-entries)))
+          (error "Invalid number of &last arguments in ~S" lambda-list))
+        (when (and last-variable (member last-variable destructuring-ll))
+          (error "Duplicate entry ~S in lambda list ~S"
+                 last-variable lambda-list))
+        (when invalid-ll-entries
+          (error "Invalid lambda list entries ~S found in ~S"
+                 invalid-ll-entries lambda-list))
+        `(let ((,%message ,message))
+           (let (,@(when last-entries
+                     `((,last-variable (car (last (arguments ,%message)))))))
+             (destructuring-bind ,(if (append-&rest-p last-entries
+                                                      destructuring-ll)
+                                      (append destructuring-ll
+                                              `(&rest ,nothing))
+                                      destructuring-ll)
+                 (arguments ,%message)
+               ,@(when (append-&rest-p last-entries destructuring-ll)
+                   `((declare (ignore ,nothing))))
+               , at body)))))))
+
+;;
+;; RPL_ISUPPORT support routines
+;;
+
 (defun parse-isupport-prefix-argument (prefix)
   (declare (type string prefix))
   (let ((closing-paren-pos (position #\) prefix)))



From ehuelsmann at common-lisp.net  Mon Feb 20 20:37:16 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Mon, 20 Feb 2006 14:37:16 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060220203716.DDBC36700F@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv5767

Modified Files:
	package.lisp 
Log Message:
Add arguments binding helper macro now that trailing-argument is deprecated.

--- /project/cl-irc/cvsroot/cl-irc/package.lisp	2006/01/27 22:54:17	1.10
+++ /project/cl-irc/cvsroot/cl-irc/package.lisp	2006/02/20 20:37:16	1.11
@@ -1,4 +1,4 @@
-;;;; $Id: package.lisp,v 1.10 2006/01/27 22:54:17 ehuelsmann Exp $
+;;;; $Id: package.lisp,v 1.11 2006/02/20 20:37:16 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/package.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -15,6 +15,7 @@
              :irc-message-event
              :start-background-message-handler
              :stop-background-message-handler
+             :destructuring-arguments
              :socket-connect
              :server-name
              :no-such-reply



From ehuelsmann at common-lisp.net  Wed Feb 22 18:54:18 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Wed, 22 Feb 2006 12:54:18 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060222185418.3452B7000E@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv379

Modified Files:
	event.lisp 
Log Message:
Verify there actually *is* a user to remove.

--- /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/20 17:27:57	1.22
+++ /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/22 18:54:18	1.23
@@ -1,4 +1,4 @@
-;;;; $Id: event.lisp,v 1.22 2006/02/20 17:27:57 ehuelsmann Exp $
+;;;; $Id: event.lisp,v 1.23 2006/02/22 18:54:18 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -207,9 +207,10 @@
         arguments
       (let ((channel (find-channel connection channel))
             (user (find-user connection source)))
-        (if (self-message-p message)
-            (remove-channel user channel)
-          (remove-user channel user))))))
+        (when (and user channel)
+          (if (self-message-p message)
+              (remove-channel user channel)
+            (remove-user channel user)))))))
 
 (defmethod default-hook ((message irc-quit-message))
   (let* ((connection (connection message))
@@ -283,9 +284,10 @@
       (declare (ignore arguments))
       (let* ((channel (find-channel connection channel))
              (user (find-user connection nick)))
-        (if (self-message-p message)
-            (remove-channel user channel)
-          (remove-user channel user))))))
+        (when (and user channel)
+          (if (self-message-p message)
+              (remove-channel user channel)
+            (remove-user channel user)))))))
 
 (defmethod default-hook ((message ctcp-time-message))
   (multiple-value-bind



From ehuelsmann at common-lisp.net  Wed Feb 22 18:55:18 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Wed, 22 Feb 2006 12:55:18 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060222185518.2C0037300E@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv472

Modified Files:
	protocol.lisp 
Log Message:
When changing a nick: remove under the old nick, re-add with the new one.

--- /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2006/02/20 06:53:25	1.37
+++ /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2006/02/22 18:55:18	1.38
@@ -1,4 +1,4 @@
-;;;; $Id: protocol.lisp,v 1.37 2006/02/20 06:53:25 ehuelsmann Exp $
+;;;; $Id: protocol.lisp,v 1.38 2006/02/22 18:55:18 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -781,17 +781,17 @@
     user))
 
 (defmethod change-nickname ((connection connection) (user user) new-nickname)
-  (let ((new-user user)
-        (channels (channels user)))
+  (let ((channels (channels user)))
     (remove-user connection user)
-    (setf (nickname new-user) new-nickname)
-    (setf (normalized-nickname new-user)
+    (dolist (channel channels)
+      (remove-user channel user))
+    (setf (nickname user) new-nickname)
+    (setf (normalized-nickname user)
           (normalize-nickname connection new-nickname))
     (dolist (channel channels)
-      (remove-user channel user)
-      (add-user channel new-user))
+      (add-user channel user))
     (add-user connection user)
-    new-user))
+    user))
 
 ;; IRC Message
 ;;



From ehuelsmann at common-lisp.net  Wed Feb 22 18:59:13 2006
From: ehuelsmann at common-lisp.net (ehuelsmann)
Date: Wed, 22 Feb 2006 12:59:13 -0600 (CST)
Subject: [cl-irc-cvs] CVS cl-irc
Message-ID: <20060222185913.2A42B79005@common-lisp.net>

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv598

Modified Files:
	protocol.lisp event.lisp 
Log Message:
Prevent ctcp request loops: NOTICE messages are responses. By Andreas Fuchs.

--- /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2006/02/22 18:55:18	1.38
+++ /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2006/02/22 18:59:13	1.39
@@ -1,4 +1,4 @@
-;;;; $Id: protocol.lisp,v 1.38 2006/02/22 18:55:18 ehuelsmann Exp $
+;;;; $Id: protocol.lisp,v 1.39 2006/02/22 18:59:13 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -932,6 +932,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\"~%"
--- /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/22 18:54:18	1.23
+++ /project/cl-irc/cvsroot/cl-irc/event.lisp	2006/02/22 18:59:13	1.24
@@ -1,4 +1,4 @@
-;;;; $Id: event.lisp,v 1.23 2006/02/22 18:54:18 ehuelsmann Exp $
+;;;; $Id: event.lisp,v 1.24 2006/02/22 18:59:13 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -289,52 +289,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)
+                    , at 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))