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

Modified Files: application.lisp message-display.lisp message-processing.lisp receivers.lisp Log Message: Add "reconnect" support.

* notices when connections are dropped * offers to reconnect when the connection is dropped. * connection setup now believes in reconnecting.

--- /project/beirc/cvsroot/beirc/application.lisp 2006/04/07 01:42:56 1.75 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/04/12 18:27:16 1.76 @@ -374,9 +374,8 @@ (make-instance 'bar-event :sheet frame)) (sleep 1)))

-(defun join-missing-channels (frame) - (let* ((connection (current-connection frame)) - (server (when connection (irc:server-name connection)))) +(defun join-missing-channels (frame &optional (connection (current-connection frame))) + (let* ((server (when connection (irc:server-name connection)))) (when server (loop for join-channel in (cdr (assoc server *auto-join-alist* :test #'equal)) do (unless (gethash join-channel (receivers frame)) @@ -890,15 +889,20 @@ (nick 'string :prompt "Nick name" :default *default-nick*) (pass 'string :prompt "Password" :default nil) (port 'number :prompt "Port" :default irc::*default-irc-server-port*)) - (let ((success nil)) - (or (server-receiver-from-args *application-frame* server port nick) + (let ((success nil) + (maybe-server-receiver (server-receiver-from-args *application-frame* server port nick))) + (or (and maybe-server-receiver (connection-open-p maybe-server-receiver)) (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))) + (server-receiver (if maybe-server-receiver + (prog1 maybe-server-receiver + (reinit-receiver-for-new-connection maybe-server-receiver + connection)) + (intern-receiver (format nil "~A on ~A:~A" nick server port) connection frame)))) (unwind-protect (progn (setf (irc:client-stream connection) (make-broadcast-stream)) @@ -1030,13 +1034,17 @@ (command (save-input-line stream frame) object))) - (window-clear stream))) + (window-clear stream)))

(defun irc-event-loop (frame connection) - (unwind-protect - (let ((*application-frame* frame)) - (irc:read-message-loop connection)) - (irc:remove-all-hooks connection))) + (let ((*application-frame* frame)) + (unwind-protect (irc:read-message-loop connection) + (setf (connection-open-p (server-receiver frame connection)) nil) + (irc:remove-all-hooks connection) + (irc:irc-message-event connection + (make-fake-irc-message 'irc-connection-closed-message + :command "Connnection closed" + :source (irc:server-name connection))))))

;;; Hack:

--- /project/beirc/cvsroot/beirc/message-display.lisp 2006/04/02 20:51:54 1.45 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/04/12 18:27:16 1.46 @@ -494,6 +494,14 @@ (with-drawing-options (*standard-output* :ink +grey12+ :text-size :small) (format-message* "Click here to close this tab."))))

+(defun offer-reconnect (receiver) + (let* ((conn (connection receiver)) + (server (irc:server-name conn)) + (nickname (irc:nickname (irc:user conn)))) + (with-output-as-presentation (t `(com-connect ,server :nick ,nickname) 'command) + (with-drawing-options (*standard-output* :ink +grey12+ :text-size :small) + (format-message* (format nil "Click here to reconnect to ~A as ~A" server nickname)))))) + (defmethod print-message ((message irc:irc-err_nosuchnick-message) receiver) (formatting-message (t message receiver) ((format t " ")) @@ -672,6 +680,13 @@ (irc:irc-rpl_invitelist-message "INVITED: ") (irc:irc-rpl_exceptlist-message "UNBANNED: ")))

+(defmethod print-message ((message irc-connection-closed-message) receiver) + (formatting-message (t message receiver) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +red3+) + (format-message* "Connection to server closed.") + (offer-reconnect receiver))))) + ;;; the display function (& utilities)

(defgeneric preamble-length (message) --- /project/beirc/cvsroot/beirc/message-processing.lisp 2006/04/04 18:37:28 1.7 +++ /project/beirc/cvsroot/beirc/message-processing.lisp 2006/04/12 18:27:16 1.8 @@ -71,5 +71,4 @@ (define-beirc-hook autojoin-hoook ((message cl-irc:irc-rpl_welcome-message)) "When a connection is established, check the list of channels for autojoin and set them up accordingly." - (declare (ignore message)) - (join-missing-channels *application-frame*)) + (join-missing-channels *application-frame* (irc:connection message))) --- /project/beirc/cvsroot/beirc/receivers.lisp 2006/04/11 22:28:58 1.26 +++ /project/beirc/cvsroot/beirc/receivers.lisp 2006/04/12 18:27:16 1.27 @@ -9,7 +9,8 @@ (messages-directed-to-me :accessor messages-directed-to-me :initform 0) (channel :reader channel :initform nil :initarg :channel) (connection :accessor connection :initarg :connection) - (query :reader query :initform nil :initarg :query) ;; <- XXX: remove this. + (connection-open-p :accessor connection-open-p :initform t) ; used only on server receivers. + (query :reader query :initform nil :initarg :query) (focused-nicks :accessor focused-nicks :initform nil) (title :reader title :initarg :title) (last-visited :accessor last-visited :initform 0) @@ -18,6 +19,8 @@ (pane :reader pane) (tab-pane :accessor tab-pane)))

+(defclass irc-connection-closed-message (irc:irc-message) ()) + (defun slot-value-or-something (object &key (slot 'name) (something "without name")) (if (slot-boundp object slot) (slot-value object slot) @@ -107,6 +110,23 @@ (setf (gethash (list connection normalized-name) (receivers frame)) receiver) receiver))))

+(defun reinit-receiver-for-new-connection (server-receiver connection &optional (frame *application-frame*)) + (let ((old-connection (connection server-receiver))) + (maphash (lambda (key receiver) + (destructuring-bind (rec-connection name) key + (when (eql old-connection rec-connection) + (remhash key (receivers frame)) + (setf (gethash (list connection name) (receivers frame)) receiver) + (setf (connection receiver) connection) + (dolist (message (messages receiver)) + ;; KLUDGE: reset the connection of messages so + ;; that channel/user finding queries don't fail + ;; horribly + (setf (irc:connection message) connection))) + (write-char #\Newline *debug-io*))) + (receivers frame)))) + + (defun remove-receiver (receiver frame) (tab-layout:remove-pane (tab-pane receiver) (find-pane-named frame 'query)) @@ -256,7 +276,6 @@ cl-irc:irc-rpl_endofexceptlist-message cl-irc:irc-ping-message))

- ;;; default receiver. (defmethod receiver-for-message ((message irc:irc-message) frame) #+or ; comment out to debug on uncaught messages.