Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv2852

Modified Files: application.lisp Log Message: add "auto-join on reconnect" feature to com-connect; also, disconnect if there was an error during connecting.

Date: Sun Oct 2 10:25:37 2005 Author: afuchs

Index: beirc/application.lisp diff -u beirc/application.lisp:1.19 beirc/application.lisp:1.20 --- beirc/application.lisp:1.19 Sun Oct 2 06:01:25 2005 +++ beirc/application.lisp Sun Oct 2 10:25:37 2005 @@ -524,28 +524,38 @@ ((server 'string :prompt "Server") &key (nick 'string :prompt "Nick name" :default *default-nick*)) - (cond ((current-connection *application-frame*) - (format *query-io* "You are already connected.~%")) - (t - (setf (slot-value *application-frame* 'connection) - (irc:connect :nickname nick :server server :connection-type 'beirc-connection)) - (setf (irc:client-stream (current-connection *application-frame*)) - (make-broadcast-stream)) - (setf (slot-value *application-frame* 'nick) nick) - (let ((connection (current-connection *application-frame*))) - (let ((frame *application-frame*)) - (initialize-receiver-with-pane (server-receiver frame) frame - (find-pane-named frame 'server) - :add-pane-p nil) - (setf (gethash "*Server*" (receivers frame)) (server-receiver frame)) - (setf (connection-process *application-frame*) - (clim-sys:make-process #'(lambda () - (restart-case - (irc-event-loop frame connection) - (disconnect () - :report "Disconnect from IRC" - (disconnect frame "Client Disconnect")))) - :name "IRC Message Muffling Loop"))))))) + (let ((success nil)) + (cond ((current-connection *application-frame*) + (format *query-io* "You are already connected.~%")) + (t + (setf (slot-value *application-frame* 'connection) + (irc:connect :nickname nick :server server :connection-type 'beirc-connection)) + (unwind-protect + (progn + (setf (irc:client-stream (current-connection *application-frame*)) + (make-broadcast-stream)) + (setf (slot-value *application-frame* 'nick) nick) + (let ((connection (current-connection *application-frame*))) + (let ((frame *application-frame*)) + (loop for receiver being the hash-values of (receivers frame) + if (channelp (channel receiver)) + do (irc:join connection (channel receiver))) + (initialize-receiver-with-pane (server-receiver frame) frame + (find-pane-named frame 'server) + :add-pane-p nil) + (setf (gethash "*Server*" (receivers frame)) (server-receiver frame)) + (setf (connection-process *application-frame*) + (clim-sys:make-process #'(lambda () + (restart-case + (irc-event-loop frame connection) + (disconnect () + :report "Disconnect from IRC" + (disconnect frame "Client Disconnect")))) + :name "IRC Message Muffling Loop")))) + (setf success t)) + (unless success + (disconnect *application-frame* "Client error."))))))) + (defun disconnect (frame reason) (raise-receiver (server-receiver frame)) (irc:quit (current-connection frame) reason)