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)
