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

[Luke Gorrie]

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

Modified Files:
	swank-sbcl.lisp 
Log Message:
Updated for new network interface.

Date: Mon Jan 12 23:21:41 2004
Author: lgorrie

Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.46 slime/swank-sbcl.lisp:1.47
--- slime/swank-sbcl.lisp:1.46	Sun Jan 11 21:14:03 2004
+++ slime/swank-sbcl.lisp	Mon Jan 12 23:21:41 2004
@@ -61,42 +61,29 @@
 
 ;;; TCP Server
 
-
-(defmethod create-socket-server (init-fn &key announce-fn (port 0)
-                                 (accept-background t)
-                                 (handle-background t)
-                                 (loop t)
-                                 (reuse-address t))
+(defmethod accept-socket/stream (&key (port 0) announce-fn (reuse-address t))
   (let ((socket (open-listener port reuse-address)))
     (funcall announce-fn (local-tcp-port socket))
-    (setup-socket-accept socket init-fn accept-background handle-background loop)))
-
-(defun setup-socket-accept (socket init-fn accept-background handle-background loop)
-  (flet ((accept-client (&optional fd)
-           (declare (ignore fd))
-           (accept-one-client socket init-fn handle-background (not loop))))
-    (cond (accept-background (add-input-handler socket #'accept-client))
-          (loop              (loop (accept-client)))
-          (t                 (accept-client)))))
+    (let ((client-socket (accept socket)))
+      (sb-bsd-sockets:socket-close socket)
+      (make-socket-io-stream client-socket))))
 
-(defun accept-one-client (server-socket init-fn background close)
-  (let* ((client-socket (accept server-socket))
-         (socket-stream (make-socket-io-stream client-socket))
-         (handler-fn (funcall init-fn socket-stream)))
-    (when close
-      (sb-sys:invalidate-descriptor (sb-bsd-sockets:socket-file-descriptor
-                                     server-socket))
-      (sb-bsd-sockets:socket-close server-socket))
-    (if background
-        (add-input-handler client-socket
-                           (lambda (fdes)
-                             (declare (ignore fdes))
-                             (funcall handler-fn)))
-        (loop (funcall handler-fn)))))
+(defmethod accept-socket/run (&key (port 0) announce-fn init-fn (reuse-address t))
+  (let ((socket (open-listener port reuse-address)))
+    (funcall announce-fn (local-tcp-port socket))
+    (add-input-handler socket (lambda ()
+                                (setup-client (accept socket) init-fn)))))
 
+(defun setup-client (socket init-fn)
+  (let* ((socket-io (make-socket-io-stream socket))
+         (handler-fn (funcall init-fn socket-io)))
+    (add-input-handler socket handler-fn)))
+  
 (defun add-input-handler (socket handler-fn)
   (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor socket)
-                         :input handler-fn))
+                         :input (lambda (fd)
+                                  (declare (ignore fd))
+                                  (funcall handler-fn))))
 
 (defun open-listener (port reuse-address)
   (let ((socket (make-instance 'sb-bsd-sockets:inet-socket