[slime-cvs] CVS update: slime/swank.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv26438

Modified Files:
	swank.lisp 
Log Message:
(setup-server): Pass loopback-interface to create-socket.
(*loopback-interface*): New parameter.

(sldb-loop): Move send :debug event inside unwind-protect, to avoid
losing :debug-return events.  
Date: Sun Feb  8 14:12:38 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.118 slime/swank.lisp:1.119
--- slime/swank.lisp:1.118	Sun Feb  8 10:37:33 2004
+++ slime/swank.lisp	Sun Feb  8 14:12:38 2004
@@ -166,9 +166,11 @@
                             (announce-fn #'simple-announce-function))
   (setup-server port announce-fn background))
 
+(defparameter *loopback-interface* "127.0.0.1")
+
 (defun setup-server (port announce-fn style)
   (declare (type function announce-fn))
-  (let* ((socket (create-socket port))
+  (let* ((socket (create-socket *loopback-interface* port))
          (port (local-port socket)))
     (funcall announce-fn port)
     (cond ((eq style :spawn)
@@ -234,7 +236,7 @@
 Return an output stream suitable for writing program output.
 
 This is an optimized way for Lisp to deliver output to Emacs."
-  (let* ((socket (create-socket 0))
+  (let* ((socket (create-socket *loopback-interface* 0))
          (port (local-port socket)))
     (encode-message `(:open-dedicated-output-stream ,port) socket-io)
     (accept-connection socket)))
@@ -686,17 +688,18 @@
        (lambda () (sldb-loop *sldb-level*)))))
 
 (defun sldb-loop (level)
-  (send-to-emacs (list* :debug (current-thread) *sldb-level*
-                        (debugger-info-for-emacs 0 *sldb-initial-frames*)))
-  (catch 'sldb-enter-default-debugger
-    (unwind-protect
+  (unwind-protect
+       (catch 'sldb-enter-default-debugger
+         (send-to-emacs 
+          (list* :debug (current-thread) *sldb-level* 
+                 (debugger-info-for-emacs 0 *sldb-initial-frames*)))
          (loop (catch 'sldb-loop-catcher
                  (with-simple-restart (abort "Return to sldb level ~D." level)
                    (send-to-emacs (list :debug-activate (current-thread)
                                         *sldb-level*))
                    (handler-bind ((sldb-condition #'handle-sldb-condition))
-                     (read-from-emacs)))))
-      (send-to-emacs `(:debug-return ,(current-thread) ,level)))))
+                     (read-from-emacs))))))
+    (send-to-emacs `(:debug-return ,(current-thread) ,level))))
 
 (defun sldb-break-with-default-debugger ()
   (throw 'sldb-enter-default-debugger nil))