Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv10954

Modified Files: application.lisp Log Message: Do nothing if connecting to a server/nick that we're already connected to.

--- /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 19:29:10 1.59 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 20:22:57 1.60 @@ -133,6 +133,14 @@ &optional (connection (current-connection *application-frame*))) (cdr (assoc connection (server-receivers frame) :test #'connection=)))

+(defmethod server-receiver-from-args ((frame beirc) server-name port nickname) + (loop for (connection . receiver) in (server-receivers frame) + if (and (equal (irc:nickname (irc:user connection)) nickname) + (equal (irc:server-name connection) server-name) + ;; TODO: no port. + ) + do (return receiver))) + (defmethod (setf server-receiver) (newval (frame beirc) &optional (connection (current-connection *application-frame*))) (pushnew (cons connection newval) (slot-value frame 'server-receivers) @@ -817,33 +825,34 @@ (pass 'string :prompt "Password" :default nil) (port 'number :prompt "Port" :default irc::*default-irc-server-port*)) (let ((success nil)) - (let* ((frame *application-frame*) - (connection (apply #'irc:connect - :nickname nick :server server :connection-type 'beirc-connection :port port - (if (null pass) - nil - `(:password ,pass)))) - (server-receiver (intern-receiver (format nil "~A on ~A:~A" nick server port) connection frame))) - (unwind-protect - (progn - (setf (irc:client-stream connection) (make-broadcast-stream)) - (when (tab-layout:find-in-tab-panes-list (find-pane-named frame 'server) - (find-pane-named frame 'query)) - (tab-layout:remove-pane (find-pane-named frame 'server) - (find-pane-named frame 'query))) - (setf (server-receiver frame connection) server-receiver) - (setf (ui-process *application-frame*) (current-process)) - (setf (connection-process *application-frame* connection) - (clim-sys:make-process #'(lambda () - (restart-case - (irc-event-loop frame connection) - (disconnect () - :report "Terminate this connection" - (disconnect connection frame "Client Disconnect")))) - :name "IRC Message Muffling Loop")) - (setf success t)) - (unless success - (disconnect connection frame "Client error.")))))) + (or (server-receiver-from-args *application-frame* server port nick) + (let* ((frame *application-frame*) + (connection (apply #'irc:connect + :nickname nick :server server :connection-type 'beirc-connection :port port + (if (null pass) + nil + `(:password ,pass)))) + (server-receiver (intern-receiver (format nil "~A on ~A:~A" nick server port) connection frame))) + (unwind-protect + (progn + (setf (irc:client-stream connection) (make-broadcast-stream)) + (when (tab-layout:find-in-tab-panes-list (find-pane-named frame 'server) + (find-pane-named frame 'query)) + (tab-layout:remove-pane (find-pane-named frame 'server) + (find-pane-named frame 'query))) + (setf (server-receiver frame connection) server-receiver) + (setf (ui-process *application-frame*) (current-process)) + (setf (connection-process *application-frame* connection) + (clim-sys:make-process #'(lambda () + (restart-case + (irc-event-loop frame connection) + (disconnect () + :report "Terminate this connection" + (disconnect connection frame "Client Disconnect")))) + :name "IRC Message Muffling Loop")) + (setf success t)) + (unless success + (disconnect connection frame "Client error.")))))))

(defun disconnect (connection frame reason) (let ((*application-frame* frame))