[slime-cvs] CVS update: slime/swank-sbcl.lisp slime/swank-openmcl.lisp slime/swank-lispworks.lisp slime/swank-allegro.lisp
Helmut Eller
heller at common-lisp.net
Wed Dec 10 13:26:09 UTC 2003
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv6458
Modified Files:
swank-sbcl.lisp swank-openmcl.lisp swank-lispworks.lisp
swank-allegro.lisp
Log Message:
(create-swank-server): Accept an announce-function keyword argument.
Date: Wed Dec 10 08:26:09 2003
Author: heller
Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.38 slime/swank-sbcl.lisp:1.39
--- slime/swank-sbcl.lisp:1.38 Sun Dec 7 14:16:24 2003
+++ slime/swank-sbcl.lisp Wed Dec 10 08:26:08 2003
@@ -78,7 +78,8 @@
(return (sb-bsd-sockets:socket-accept socket))
(sb-bsd-sockets:interrupted-error ()))))
-(defun create-swank-server (port &key reuse-address)
+(defun create-swank-server (port &key (reuse-address t)
+ (announce #'simple-announce-function))
"Create a SWANK TCP server."
(let ((socket (open-listener port reuse-address)))
(sb-sys:add-fd-handler
@@ -86,7 +87,7 @@
:input (lambda (fd)
(declare (ignore fd))
(accept-connection socket)))
- (nth-value 1 (sb-bsd-sockets:socket-name socket))))
+ (funcall announce (nth-value 1 (sb-bsd-sockets:socket-name socket)))))
(defun open-stream-to-emacs ()
(let* ((server-socket (open-listener 0 t))
Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.28 slime/swank-openmcl.lisp:1.29
--- slime/swank-openmcl.lisp:1.28 Sun Dec 7 14:16:24 2003
+++ slime/swank-openmcl.lisp Wed Dec 10 08:26:08 2003
@@ -13,7 +13,7 @@
;;; The LLGPL is also available online at
;;; http://opensource.franz.com/preamble.html
;;;
-;;; $Id: swank-openmcl.lisp,v 1.28 2003/12/07 19:16:24 heller Exp $
+;;; $Id: swank-openmcl.lisp,v 1.29 2003/12/10 13:26:08 heller Exp $
;;;
;;;
@@ -76,15 +76,15 @@
;; In OpenMCL, the Swank backend runs in a separate thread and simply
;; blocks on its TCP port while waiting for forms to evaluate.
-(defun create-swank-server (port &key reuse-address)
- "Create a Swank TCP server on `port'.
-Return the port number that the socket is actually listening on."
+(defun create-swank-server (port &key (reuse-address t)
+ (announce #'simple-announce-function))
+ "Create a Swank TCP server on `port'."
(let ((server-socket (ccl:make-socket :connect :passive :local-port port
:reuse-address reuse-address)))
+ (funcall announce (ccl:local-port server-socket))
(ccl:process-run-function "Swank Request Processor"
#'swank-accept-connection
- server-socket)
- (ccl:local-port server-socket)))
+ server-socket)))
(defun swank-accept-connection (server-socket)
"Accept one Swank TCP connection on SOCKET and then close it.
Index: slime/swank-lispworks.lisp
diff -u slime/swank-lispworks.lisp:1.7 slime/swank-lispworks.lisp:1.8
--- slime/swank-lispworks.lisp:1.7 Sun Dec 7 14:16:24 2003
+++ slime/swank-lispworks.lisp Wed Dec 10 08:26:08 2003
@@ -7,7 +7,7 @@
;;; This code has been placed in the Public Domain. All warranties
;;; are disclaimed.
;;;
-;;; $Id: swank-lispworks.lisp,v 1.7 2003/12/07 19:16:24 heller Exp $
+;;; $Id: swank-lispworks.lisp,v 1.8 2003/12/10 13:26:08 heller Exp $
;;;
(in-package :swank)
@@ -30,15 +30,21 @@
(defun without-interrupts* (body)
(lispworks:without-interrupts (funcall body)))
-(defun create-swank-server (port &key reuse-address)
+(defun create-swank-server (port &key (reuse-address t)
+ (announce #'simple-announce-function))
"Create a Swank TCP server on `port'.
Return the port number that the socket is actually listening on."
(declare (ignore reuse-address))
- (comm:start-up-server-and-mp :announce *terminal-io* :service port
- :process-name "Swank Request Processor"
- :function 'swank-accept-connection
- )
- port)
+ (flet ((sentinel (socket condition)
+ (cond (socket
+ (let ((port (nth-value 1 (comm:get-socket-address socket))))
+ (funcall announce port)))
+ (t
+ (format *terminal-io* ";; Swank condition: ~A~%"
+ condition)))))
+ (comm:start-up-server :announce #'sentinel :service port
+ :process-name "Swank server"
+ :function 'swank-accept-connection)))
(defconstant +sigint+ 2)
Index: slime/swank-allegro.lisp
diff -u slime/swank-allegro.lisp:1.2 slime/swank-allegro.lisp:1.3
--- slime/swank-allegro.lisp:1.2 Sun Dec 7 14:16:24 2003
+++ slime/swank-allegro.lisp Wed Dec 10 08:26:08 2003
@@ -7,7 +7,7 @@
;;; This code has been placed in the Public Domain. All warranties
;;; are disclaimed.
;;;
-;;; $Id: swank-allegro.lisp,v 1.2 2003/12/07 19:16:24 heller Exp $
+;;; $Id: swank-allegro.lisp,v 1.3 2003/12/10 13:26:08 heller Exp $
;;;
;;; This code was written for
;;; Allegro CL Trial Edition "5.0 [Linux/X86] (8/29/98 10:57)"
@@ -36,27 +36,21 @@
;;; TCP Server
-(defun create-swank-server (port &key (reuse-address t))
- "Create a Swank TCP server on `port'.
-Return the port number that the socket is actually listening on."
+(defun create-swank-server (port &key (reuse-address t)
+ (announce #'simple-announce-function))
+ "Create a Swank TCP server on `port'."
(let ((server-socket (socket:make-socket :connect :passive :local-port port
:reuse-address reuse-address)))
- (mp:process-run-function "Swank Request Processor"
- #'swank-accept-connection
- server-socket)
- (socket:local-port server-socket)))
+ (funcall announce (socket:local-port server-socket))
+ (swank-accept-connection server-socket)))
(defun swank-accept-connection (server-socket)
"Accept one Swank TCP connection on SOCKET.
Run the connection handler in a new thread."
(loop
- (let ((socket (socket:accept-connection server-socket :wait t)))
- (mp:process-run-function
- (list :name (format nil "Swank Client ~D" (socket:socket-os-fd socket))
- :initial-bindings `((*emacs-io* . ',socket)))
- #'request-loop))))
+ (request-loop (socket:accept-connection server-socket :wait t))))
-(defun request-loop ()
+(defun request-loop (*emacs-io*)
"Thread function for a single Swank connection. Processes requests
until the remote Emacs goes away."
(unwind-protect
More information about the slime-cvs
mailing list