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

[Helmut Eller]

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

Modified Files:
	swank.lisp 
Log Message:
(create-server): New keyword based variant to start the server in
background.

(setup-server): Add support to keep the socket open for single-threaded
Lisps.

Date: Tue Apr 27 18:27:28 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.177 slime/swank.lisp:1.178
--- slime/swank.lisp:1.177	Tue Apr 27 17:24:14 2004
+++ slime/swank.lisp	Tue Apr 27 18:27:27 2004
@@ -12,6 +12,7 @@
   (:export #:startup-multiprocessing
            #:start-server 
            #:create-swank-server
+           #:create-server
            #:ed-in-emacs
            #:print-indentation-lossage
            #:swank-debugger-hook
@@ -208,16 +209,22 @@
 (defvar *communication-style* (preferred-communication-style))
 (defvar *log-events* nil)
 
-(defun start-server (port-file &optional (background *communication-style*)
+(defun start-server (port-file &optional (style *communication-style*)
                      dont-close)
   (setup-server 0 (lambda (port) (announce-server-port port-file port))
-                background dont-close))
-                     
+                style dont-close))
+
+(defun create-server (&key (port +server-port+)
+                      (style *communication-style*)
+                      dont-close)
+  "Start a SWANK server on PORT."
+  (setup-server port #'simple-announce-function style dont-close))
+
 (defun create-swank-server (&optional (port +server-port+)
-                            (background *communication-style*)
+                            (style *communication-style*)
                             (announce-fn #'simple-announce-function)
                             dont-close)
-  (setup-server port announce-fn background dont-close))
+  (setup-server port announce-fn style dont-close))
 
 (defparameter *loopback-interface* "127.0.0.1")
 
@@ -226,12 +233,21 @@
   (let* ((socket (create-socket *loopback-interface* port))
          (port (local-port socket)))
     (funcall announce-fn port)
-    (cond ((eq style :spawn)
-           (spawn (lambda () 
-                    (loop do (serve-connection socket :spawn dont-close)
-                          while dont-close))
-                  :name "Swank"))
-          (t (serve-connection socket style nil)))
+    (case style
+      (:spawn
+       (spawn (lambda () 
+                (loop do (serve-connection socket :spawn dont-close)
+                      while dont-close))
+              :name "Swank"))
+      ((:fd-handler :sigio)
+       (add-fd-handler socket 
+                       (lambda ()
+                         (serve-connection socket style dont-close))))
+      ((nil)
+       (unwind-protect
+            (loop do (serve-connection socket style dont-close)
+                  while dont-close)
+         (close-socket socket))))
     port))
 
 (defun serve-connection (socket style dont-close)