From lisppaste at common-lisp.net Thu Sep 1 19:05:31 2005 From: lisppaste at common-lisp.net (Lisppaste and co.) Date: Thu, 1 Sep 2005 21:05:31 +0200 (CEST) Subject: [Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp Message-ID: <20050901190531.8D2AA8853E@common-lisp.net> Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/lisppaste/cl-irc/example Modified Files: cliki.lisp Log Message: (for bmastenbrook): add a socket-error catch from trivial-sockets; fix a bad regexp which prevented adding terms with quotes in them (like "Bob") Date: Thu Sep 1 21:05:30 2005 Author: lisppaste Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.31 cl-irc/example/cliki.lisp:1.32 --- cl-irc/example/cliki.lisp:1.31 Tue Aug 9 03:26:14 2005 +++ cl-irc/example/cliki.lisp Thu Sep 1 21:05:30 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.31 2005/08/09 01:26:14 lisppaste Exp $ +;;;; $Id: cliki.lisp,v 1.32 2005/09/01 19:05:30 lisppaste Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -332,6 +332,9 @@ (sb-ext:timeout (c) (return-from cliki-return (progn (signal 'lookup-failure) "I can't be expected to work when CLiki doesn't respond to me, can I?"))) + (trivial-sockets:socket-error (c) + (return-from cliki-return (progn (signal 'lookup-failure) + "I can't be expected to work when CLiki doesn't respond to me, can I?"))) (serious-condition (c &rest whatever) (return-from cliki-return (progn (signal 'lookup-failure) (regex-replace-all "\\n" (format nil "An error was encountered in lookup: ~A." c) " ")))))) )) @@ -508,7 +511,7 @@ (should-send-cant-find t)) (setf first-pass (regex-replace-all "\\s\\s+" first-pass " ")) (setf first-pass (regex-replace-all "\\s*$" first-pass "")) - (let ((scanned (or (nth-value 1 (scan-to-strings "^add\\s+\"([^\"]+)\"\\s+as:*\\s+(.+)$" first-pass)) + (let ((scanned (or (nth-value 1 (scan-to-strings "^add\\s+\"(.+)\"\\s+as:*\\s+(.+)$" first-pass)) (nth-value 1 (scan-to-strings "^add\\s+(.+)\\s+as:*\\s+(.+)$" first-pass))))) (if scanned (let ((term (elt scanned 0)) From ehuelsmann at common-lisp.net Tue Sep 13 20:34:42 2005 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Tue, 13 Sep 2005 22:34:42 +0200 (CEST) Subject: [Cl-irc-cvs] CVS update: cl-irc/event.lisp Message-ID: <20050913203442.53E1A880DE@common-lisp.net> Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv12600 Modified Files: event.lisp Log Message: Prevent the bot from crashing when it got out-of-sync. * event.lisp (default-hook irc-nick-message): If we can't find the old user object, create a new one to set the nick on. Date: Tue Sep 13 22:34:41 2005 Author: ehuelsmann Index: cl-irc/event.lisp diff -u cl-irc/event.lisp:1.9 cl-irc/event.lisp:1.10 --- cl-irc/event.lisp:1.9 Sun Mar 27 23:40:30 2005 +++ cl-irc/event.lisp Tue Sep 13 22:34:41 2005 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.9 2005/03/27 21:40:30 ehuelsmann Exp $ +;;;; $Id: event.lisp,v 1.10 2005/09/13 20:34:41 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -163,11 +163,10 @@ (channel (or (find-channel connection (trailing-argument message)) (make-channel connection :name (trailing-argument message))))) - (if (self-message-p message) - (add-channel connection channel) - (progn - (add-user connection user) - (add-user channel user))))) + (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) @@ -229,9 +228,9 @@ target mode-name value)))))) (defmethod default-hook ((message irc-nick-message)) - (let ((con (connection message))) - (change-nickname con (find-user con (source message)) - (trailing-argument message)))) + (let* ((con (connection message)) + (user (find-or-create-user con (source message)))) + (change-nickname con user (trailing-argument message)))) (defmethod default-hook ((message irc-kick-message)) (let* ((connection (connection message)) From bmastenbrook at common-lisp.net Sun Sep 18 14:25:13 2005 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sun, 18 Sep 2005 16:25:13 +0200 (CEST) Subject: [Cl-irc-cvs] CVS update: cl-irc/command.lisp Message-ID: <20050918142513.29B8D8854E@common-lisp.net> Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv5595 Modified Files: command.lisp Log Message: Add antifuchs' pass-on-connect support Date: Sun Sep 18 16:24:50 2005 Author: bmastenbrook Index: cl-irc/command.lisp diff -u cl-irc/command.lisp:1.10 cl-irc/command.lisp:1.11 --- cl-irc/command.lisp:1.10 Sun Apr 17 21:45:42 2005 +++ cl-irc/command.lisp Sun Sep 18 16:24:45 2005 @@ -1,4 +1,4 @@ -;;;; $Id: command.lisp,v 1.10 2005/04/17 19:45:42 ehuelsmann Exp $ +;;;; $Id: command.lisp,v 1.11 2005/09/18 14:24:45 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/command.lisp,v $ ;;;; See LICENSE for licensing information. @@ -241,6 +241,7 @@ (defun connect (&key (nickname *default-nickname*) (username nil) (realname nil) + (password nil) (mode 0) (server *default-irc-server*) (port *default-irc-server-port*) @@ -255,6 +256,8 @@ :username username :realname realname))) (setf (user connection) user) + (unless (null password) + (pass connection password)) (nick connection nickname) (user- connection (or username nickname) mode (or realname nickname)) (add-default-hooks connection) From bmastenbrook at common-lisp.net Sun Sep 25 14:55:05 2005 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sun, 25 Sep 2005 16:55:05 +0200 (CEST) Subject: [Cl-irc-cvs] CVS update: cl-irc/command.lisp cl-irc/event.lisp cl-irc/protocol.lisp Message-ID: <20050925145505.A836888545@common-lisp.net> 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)