[beirc-cvs] CVS beirc

[afuchs]

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)