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

[Helmut Eller]

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

Modified Files:
	swank.lisp 
Log Message:
(setup-server, serve-connection): New dont-close argument to keep the
socket open after the first request.
(start-server, create-swank-server): Update callers.

Date: Wed Mar  3 03:51:25 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.132 slime/swank.lisp:1.133
--- slime/swank.lisp:1.132	Wed Mar  3 02:18:02 2004
+++ slime/swank.lisp	Wed Mar  3 03:51:24 2004
@@ -156,30 +156,36 @@
 (defvar *swank-in-background* nil)
 (defvar *log-events* nil)
 
-(defun start-server (port-file &optional (background *swank-in-background*))
+(defun start-server (port-file &optional (background *swank-in-background*)
+                     dont-close)
   (setup-server 0 (lambda (port) (announce-server-port port-file port))
-                background))
+                background dont-close))
                      
 (defun create-swank-server (&optional (port +server-port+)
                             (background *swank-in-background*)
-                            (announce-fn #'simple-announce-function))
-  (setup-server port announce-fn background))
+                            (announce-fn #'simple-announce-function)
+                            dont-close)
+  (setup-server port announce-fn background dont-close))
 
 (defparameter *loopback-interface* "127.0.0.1")
 
-(defun setup-server (port announce-fn style)
+(defun setup-server (port announce-fn style dont-close)
   (declare (type function announce-fn))
   (let* ((socket (create-socket *loopback-interface* port))
          (port (local-port socket)))
     (funcall announce-fn port)
     (cond ((eq style :spawn)
-           (spawn (lambda () (serve-connection socket :spawn)) :name "Swank"))
-          (t (serve-connection socket style)))
+           (spawn (lambda () 
+                    (loop do (serve-connection socket :spawn dont-close)
+                          while dont-close))
+                  :name "Swank"))
+          (t (serve-connection socket style nil)))
     port))
 
-(defun serve-connection (socket style)
+(defun serve-connection (socket style dont-close)
   (let ((client (accept-connection socket)))
-    (close-socket socket)
+    (unless dont-close
+      (close-socket socket))
     (let ((connection (create-connection client style)))
       (init-emacs-connection connection)
       (serve-requests connection))))