[slime-cvs] CVS slime

[heller]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv10577

Modified Files:
	ChangeLog swank.lisp 
Log Message:
Fix close-connection.

* swank.lisp (close-connection): Use *log-output* instead of
*debug-io* (which could be redirected to the to-be-closed
connection).



--- /project/slime/cvsroot/slime/ChangeLog	2007/09/15 15:15:25	1.1219
+++ /project/slime/cvsroot/slime/ChangeLog	2007/09/19 11:12:07	1.1220
@@ -1,3 +1,9 @@
+2007-09-19  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (close-connection): Use *log-output* instead of
+	*debug-io* (which could be redirected to the to-be-closed
+	connection).
+
 2007-09-15  Helmut Eller  <heller at common-lisp.net>
 
 	Let slime-setup load contribs.
--- /project/slime/cvsroot/slime/swank.lisp	2007/09/10 15:39:05	1.510
+++ /project/slime/cvsroot/slime/swank.lisp	2007/09/19 11:12:07	1.511
@@ -676,8 +676,8 @@
 
 (defun simple-announce-function (port)
   (when *swank-debug-p*
-    (format *debug-io* "~&;; Swank started at port: ~D.~%" port)
-    (force-output *debug-io*)))
+    (format *log-output* "~&;; Swank started at port: ~D.~%" port)
+    (force-output *log-output*)))
 
 (defun open-streams (connection)
   "Return the 5 streams for IO redirection:
@@ -773,7 +773,7 @@
   (connection.socket-io *emacs-connection*))
 
 (defun close-connection (c &optional condition backtrace)
-  (format *debug-io* "~&;; swank:close-connection: ~A~%" condition)
+  (format *log-output* "~&;; swank:close-connection: ~A~%" condition)
   (let ((cleanup (connection.cleanup c)))
     (when cleanup
       (funcall cleanup c)))
@@ -783,10 +783,10 @@
   (setf *connections* (remove c *connections*))
   (run-hook *connection-closed-hook* c)
   (when (and condition (not (typep condition 'end-of-file)))
-    (finish-output *debug-io*)
-    (format *debug-io* "~&;; Event history start:~%")
-    (dump-event-history *debug-io*)
-    (format *debug-io* ";; Event history end.~%~
+    (finish-output *log-output*)
+    (format *log-output* "~&;; Event history start:~%")
+    (dump-event-history *log-output*)
+    (format *log-output* ";; Event history end.~%~
                         ;; Backtrace:~%~{~A~%~}~
                         ;; Connection to Emacs lost. [~%~
                         ;;  condition: ~A~%~
@@ -798,7 +798,7 @@
             (ignore-errors (stream-external-format (connection.socket-io c)))
             (connection.communication-style c)
             *use-dedicated-output-stream*)
-    (finish-output *debug-io*)))
+    (finish-output *log-output*)))
 
 (defvar *debug-on-swank-error* nil
   "When non-nil internal swank errors will drop to a
@@ -807,17 +807,18 @@
 
 (defmacro with-reader-error-handler ((connection) &body body)
   (let ((con (gensym))
-        (block (gensym)))
+        (blck (gensym)))
     `(let ((,con ,connection))
-       (block ,block
+       (block ,blck
          (handler-bind ((swank-error
                          (lambda (e)
                            (if *debug-on-swank-error*
                                (invoke-debugger e)
-                               (return-from ,block
-                                 (close-connection ,con 
-                                                   (swank-error.condition e)
-                                                   (swank-error.backtrace e)))))))
+                               (return-from ,blck
+                                 (close-connection 
+                                  ,con 
+                                  (swank-error.condition e)
+                                  (swank-error.backtrace e)))))))
            (progn , at body))))))
 
 (defslimefun simple-break ()
@@ -1251,6 +1252,7 @@
 
 (defun update-redirection-after-close (closed-connection)
   "Update redirection after a connection closes."
+  (check-type closed-connection connection)
   (when (eq *global-stdio-connection* closed-connection)
     (if (and (default-connection) *globally-redirect-io*)
         ;; Redirect to another connection.
@@ -1688,9 +1690,7 @@
              (let ((i (car values)))
                (format nil "~A~D (#x~X, #o~O, #b~B)" 
                        *echo-area-prefix* i i i i)))
-            (t (with-output-to-string (s)
-                 (pprint-logical-block (s () :prefix *echo-area-prefix*)
-                   (format s "~{~S~^, ~}" values))))))))
+            (t (format nil "~a~{~S~^, ~}" *echo-area-prefix* values))))))
 
 (defslimefun interactive-eval (string)
   (with-buffer-syntax ()