Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv20220
Modified Files: application.lisp Log Message: Fix /close. Rename /close inactive queries to /delete in[...]. Fix /quit
* /Close now accepts server receivers and DTRT when it hits them.
* /close inactive queries was getting in the way of the /close command. rename it to /delete inactive queries.
* /quit threw an error; fixed that.
--- /project/beirc/cvsroot/beirc/application.lisp 2006/02/25 19:55:55 1.44 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/02/26 00:07:15 1.45 @@ -139,6 +139,11 @@ (pushnew (cons connection newval) (slot-value frame 'connection-processes) :key #'car :test #'connection=))
+(defmethod remove-connection-process ((frame beirc) connection) + (setf (slot-value *application-frame* 'connection-processes) + (delete connection (connection-processes *application-frame*) :key #'car))) + + (defmethod current-nickname (&optional (connection (current-connection *application-frame*))) (let ((user (when connection (irc:user connection)))) @@ -247,7 +252,7 @@ (let ((pane (get-frame-pane frame 'status-bar))) (redisplay-frame-pane frame pane) (when *auto-close-inactive-query-windows-p* - (com-close-inactive-queries)) + (com-remove-inactive-queries)) (medium-force-output (sheet-medium pane))))
;;; @@ -366,15 +371,18 @@ (switch-to-pane (nth (1- position) list-of-panes) 'tab-layout-pane)))))
(define-beirc-command (com-close :name t) ((receiver 'receiver :prompt "receiver")) - (when (member receiver (server-receivers *application-frame*) :key #'cdr) - (error "Don't know how to close server tabs. Sorry.")) (let* ((connection (current-connection *application-frame*)) (channel (irc:find-channel connection (title receiver)))) - (when channel - (irc:part connection channel))) + (cond + ((member receiver (server-receivers *application-frame*) :key #'cdr) + (disconnect connection *application-frame* "Client Quit") + (setf (slot-value *application-frame* 'server-receivers) + (delete receiver (server-receivers *application-frame*) :key #'cdr))) + (channel + (irc:part connection channel)))) (remove-receiver receiver *application-frame*))
-(define-beirc-command (com-close-inactive-queries :name t) () +(define-beirc-command (com-remove-inactive-queries :name t) () (let ((receivers-to-close nil)) (maphash (lambda (name receiver) (declare (ignore name)) @@ -763,13 +771,14 @@ (disconnect connection frame "Client error."))))))
(defun disconnect (connection frame reason) - (raise-receiver (server-receiver frame)) - (irc:quit connection reason) - (when (and (connection-process frame connection) - (not (eql (clim-sys:current-process) - (connection-process frame connection)))) - (destroy-process (connection-process frame connection))) - (setf (connection-process frame connection) nil)) + (let ((*application-frame* frame)) + (raise-receiver (server-receiver frame connection)) + (when (connection-process frame connection) + (irc:quit connection reason) + (when (not (eql (clim-sys:current-process) + (connection-process frame connection))) + (destroy-process (print (connection-process frame connection) *debug-io*))) + (remove-connection-process frame connection))))
(defun disconnect-all (frame reason) (loop for (conn . receiver) in (server-receivers frame)