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)