[Cl-irc-cvs] CVS update: cl-irc/command.lisp cl-irc/event.lisp cl-irc/protocol.lisp

[Brian Mastenbrook]

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

Modified Files:
	command.lisp event.lisp protocol.lisp 
Log Message:
Three patches from Mr. Fuchs:

* the way to handle all IRC messages is by defining your own subclass of connection; use this
* fix a usage of an undefined function
* find-or-make-user should use username, hostmask and realname values as soon as they're available

Date: Sun Sep 25 16:55:03 2005
Author: bmastenbrook

Index: cl-irc/command.lisp
diff -u cl-irc/command.lisp:1.11 cl-irc/command.lisp:1.12
--- cl-irc/command.lisp:1.11	Sun Sep 18 16:24:45 2005
+++ cl-irc/command.lisp	Sun Sep 25 16:55:02 2005
@@ -1,4 +1,4 @@
-;;;; $Id: command.lisp,v 1.11 2005/09/18 14:24:45 bmastenbrook Exp $
+;;;; $Id: command.lisp,v 1.12 2005/09/25 14:55:02 bmastenbrook Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/command.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -245,10 +245,12 @@
                      (mode 0)
                      (server *default-irc-server*)
                      (port *default-irc-server-port*)
+                     (connection-type 'connection)
                      (logging-stream t))
   "Connect to server and return a connection object."
   (let* ((stream (socket-connect server port))
-         (connection (make-connection :server-stream stream
+         (connection (make-connection :connection-type connection-type
+                                      :server-stream stream
                                       :client-stream logging-stream
                                       :server-name server))
          (user (make-user connection


Index: cl-irc/event.lisp
diff -u cl-irc/event.lisp:1.10 cl-irc/event.lisp:1.11
--- cl-irc/event.lisp:1.10	Tue Sep 13 22:34:41 2005
+++ cl-irc/event.lisp	Sun Sep 25 16:55:02 2005
@@ -1,4 +1,4 @@
-;;;; $Id: event.lisp,v 1.10 2005/09/13 20:34:41 ehuelsmann Exp $
+;;;; $Id: event.lisp,v 1.11 2005/09/25 14:55:02 bmastenbrook Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -229,7 +229,9 @@
 
 (defmethod default-hook ((message irc-nick-message))
   (let* ((con (connection message))
-         (user (find-or-create-user con (source message))))
+         (user (find-or-make-user con (source message)
+                                  :hostname (host message)
+                                  :username (user message))))
     (change-nickname con user (trailing-argument message))))
 
 (defmethod default-hook ((message irc-kick-message))


Index: cl-irc/protocol.lisp
diff -u cl-irc/protocol.lisp:1.24 cl-irc/protocol.lisp:1.25
--- cl-irc/protocol.lisp:1.24	Sun Apr 17 23:14:30 2005
+++ cl-irc/protocol.lisp	Sun Sep 25 16:55:02 2005
@@ -1,4 +1,4 @@
-;;;; $Id: protocol.lisp,v 1.24 2005/04/17 21:14:30 ehuelsmann Exp $
+;;;; $Id: protocol.lisp,v 1.25 2005/09/25 14:55:02 bmastenbrook Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -185,12 +185,13 @@
 (defgeneric case-map-name (connection))
 (defgeneric re-apply-case-mapping (connection))
 
-(defun make-connection (&key (user nil)
+(defun make-connection (&key (connection-type 'connection)
+                             (user nil)
                              (server-name "")
                              (server-stream nil)
                              (client-stream t)
                              (hooks nil))
-  (let ((connection (make-instance 'connection
+  (let ((connection (make-instance connection-type
                                    :user user
                                    :server-name server-name
                                    :server-stream server-stream
@@ -772,12 +773,21 @@
 
 (defmethod find-or-make-user ((connection connection) nickname &key (username "")
                               (hostname "") (realname ""))
-  (or (find-user connection nickname)
-      (make-user connection
-                 :nickname nickname
-                 :username username
-                 :hostname hostname
-                 :realname realname)))
+  (let ((user (find-user connection nickname)))
+    (unless user
+      (setf user
+            (make-user connection
+                       :nickname nickname
+                       :username username
+                       :hostname hostname
+                       :realname realname)))
+    (labels ((update-slot-if-known (slotname value)
+               (when (string= (slot-value user slotname) "")
+                 (setf (slot-value user slotname) value))))
+      (update-slot-if-known 'username username)
+      (update-slot-if-known 'hostname hostname)
+      (update-slot-if-known 'realname realname))
+    user))
 
 (defmethod change-nickname ((connection connection) (user user) new-nickname)
   (let ((new-user user)