[slime-cvs] CVS update: slime/swank.lisp slime/swank-sbcl.lisp slime/swank-openmcl.lisp slime/swank-cmucl.lisp slime/slime.el slime/ChangeLog
Luke Gorrie
lgorrie at common-lisp.net
Sat Oct 25 01:54:02 UTC 2003
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv10599
Modified Files:
swank.lisp swank-sbcl.lisp swank-openmcl.lisp swank-cmucl.lisp
slime.el ChangeLog
Log Message:
Changed the connection setup to use a dynamic collision-free TCP
port. The new protocol is this:
Emacs calls (swank:start-server FILENAME) via the listener. FILENAME
is /tmp/slime.${emacspid}
Lisp starts a TCP server on a dynamic available port and writes the
port number it gets to FILENAME.
Emacs asynchronously polls for FILENAME's creation. When it exists,
Emacs reads the port number, deletes the file, and makes the
connection.
The advantage is that you can run multiple Emacsen each with an
inferior lisp, and the port numbers will never collide and Emacs
will always connect to the right lisp.
All backends are updated, but only CMUCL and SBCL are
tested. Therefore, OpenMCL is almost certainly broken just now.
Date: Fri Oct 24 21:54:01 2003
Author: lgorrie
Index: slime/swank.lisp
diff -u slime/swank.lisp:1.44 slime/swank.lisp:1.45
--- slime/swank.lisp:1.44 Wed Oct 22 17:04:55 2003
+++ slime/swank.lisp Fri Oct 24 21:54:00 2003
@@ -30,9 +30,15 @@
;;; Setup and Hooks
-(defun start-server (&optional (port server-port))
- "Start the Slime backend on TCP port `port'."
- (create-swank-server port :reuse-address t)
+(defun start-server (port-file-namestring)
+ "Create a SWANK server and write its port number to the file
+PORT-FILE-NAMESTRING in ascii text."
+ (let ((port (create-swank-server 0 :reuse-address t)))
+ (with-open-file (s port-file-namestring
+ :direction :output
+ :if-exists :overwrite
+ :if-does-not-exist :create)
+ (format s "~S~%" port)))
(when *swank-debug-p*
(format *debug-io* "~&;; Swank ready.~%")))
Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.13 slime/swank-sbcl.lisp:1.14
--- slime/swank-sbcl.lisp:1.13 Thu Oct 23 11:52:24 2003
+++ slime/swank-sbcl.lisp Fri Oct 24 21:54:00 2003
@@ -61,13 +61,17 @@
(sb-bsd-sockets:socket-file-descriptor socket)
:input (lambda (fd)
(declare (ignore fd))
- (accept-connection socket)))))
+ (accept-connection socket)))
+ (nth-value 1 (sb-bsd-sockets:socket-name socket))))
(defun accept-connection (server-socket)
- "Accept a SWANK TCP connection on SOCKET."
+ "Accept one Swank TCP connection on SOCKET and then close it."
(let* ((socket (sb-bsd-sockets:socket-accept server-socket))
(stream (sb-bsd-sockets:socket-make-stream
socket :input t :output t :element-type 'base-char)))
+ (sb-sys:invalidate-descriptor (sb-bsd-sockets:socket-file-descriptor
+ server-socket))
+ (sb-bsd-sockets:socket-close server-socket)
(sb-sys:add-fd-handler
(sb-bsd-sockets:socket-file-descriptor socket)
:input (lambda (fd)
Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.11 slime/swank-openmcl.lisp:1.12
--- slime/swank-openmcl.lisp:1.11 Sun Oct 19 17:40:29 2003
+++ slime/swank-openmcl.lisp Fri Oct 24 21:54:00 2003
@@ -13,7 +13,7 @@
;;; The LLGPL is also available online at
;;; http://opensource.franz.com/preamble.html
;;;
-;;; $Id: swank-openmcl.lisp,v 1.11 2003/10/19 21:40:29 heller Exp $
+;;; $Id: swank-openmcl.lisp,v 1.12 2003/10/25 01:54:00 lgorrie Exp $
;;;
;;;
@@ -59,20 +59,24 @@
;; 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'."
- (ccl:process-run-function "Swank Request Processor" #'swank-main-loop
- port reuse-address))
-
-(defun swank-main-loop (port reuse-address)
- "Create the TCP server and accept connections in a new thread."
+ "Create a Swank TCP server on `port'.
+Return the port number that the socket is actually listening on."
(let ((server-socket (ccl:make-socket :connect :passive :local-port port
:reuse-address reuse-address)))
- (loop
- (let ((socket (ccl:accept-connection server-socket :wait t)))
- (ccl:process-run-function
- (list :name (format nil "Swank Client ~D" (ccl:socket-os-fd socket))
- :initial-bindings `((*emacs-io* . ',socket)))
- #'request-loop)))))
+ (ccl:process-run-function "Swank Request Processor"
+ #'swank-accept-connection
+ server-socket)
+ (ccl:local-port server-socket)))
+
+(defun swank-accept-connection (server-socket)
+ "Accept one Swank TCP connection on SOCKET and then close it.
+Run the connection handler in a new thread."
+ (let ((socket (ccl:accept-connection server-socket :wait t)))
+ (close server-socket)
+ (ccl:process-run-function
+ (list :name (format nil "Swank Client ~D" (ccl:socket-os-fd socket))
+ :initial-bindings `((*emacs-io* . ',socket)))
+ #'request-loop)))
(defun request-loop ()
"Thread function for a single Swank connection. Processes requests
Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.11 slime/swank-cmucl.lisp:1.12
--- slime/swank-cmucl.lisp:1.11 Wed Oct 22 17:06:01 2003
+++ slime/swank-cmucl.lisp Fri Oct 24 21:54:00 2003
@@ -73,15 +73,17 @@
(let* ((hostent (ext:lookup-host-entry address))
(address (car (ext:host-entry-addr-list hostent)))
(ip (ext:htonl address)))
- (system:add-fd-handler
- (ext:create-inet-listener port :stream
- :reuse-address reuse-address
- :host ip)
- :input #'accept-connection)))
+ (let ((fd (ext:create-inet-listener port :stream
+ :reuse-address reuse-address
+ :host ip)))
+ (system:add-fd-handler fd :input #'accept-connection)
+ (nth-value 1 (ext::get-socket-host-and-port fd)))))
(defun accept-connection (socket)
- "Accept a SWANK TCP connection on SOCKET."
- (setup-request-handler (ext:accept-tcp-connection socket)))
+ "Accept one Swank TCP connection on SOCKET and then close it."
+ (setup-request-handler (ext:accept-tcp-connection socket))
+ (sys:invalidate-descriptor socket)
+ (unix:unix-close socket))
(defun setup-request-handler (socket)
"Setup request handling for SOCKET."
Index: slime/slime.el
diff -u slime/slime.el:1.58 slime/slime.el:1.59
--- slime/slime.el:1.58 Fri Oct 24 18:19:20 2003
+++ slime/slime.el Fri Oct 24 21:54:00 2003
@@ -61,9 +61,6 @@
(require 'easy-mmode)
(defalias 'define-minor-mode 'easy-mmode-define-minor-mode))
-(defvar slime-swank-port 4005
- "TCP port number for the Lisp Swank server.")
-
(defvar slime-path
(let ((path (locate-library "slime")))
(and path (file-name-directory path)))
@@ -599,50 +596,45 @@
"Timer object for connection retries.")
(defun slime ()
- "Start an inferior^_superior Lisp and connect to its Swank server.
-With a prefix argument, prompt for the port number for Lisp
-communication. The port is remembered for future connections."
+ "Start an inferior^_superior Lisp and connect to its Swank server."
(interactive)
- (when current-prefix-arg
- (slime-read-and-update-swank-port))
(when (slime-connected-p)
(slime-disconnect))
(slime-maybe-start-lisp)
- (slime-connect "localhost" slime-swank-port))
+ (slime-connect))
-(defun slime-read-and-update-swank-port ()
- "Prompt the user for the port number to use for Lisp communication."
- (let* ((port-string (format "%S" slime-swank-port))
- (new-port-string (read-from-minibuffer "SLIME Port: " port-string))
- (new-port (read new-port-string)))
- (if (integerp new-port)
- (setq slime-swank-port new-port)
- (error "Not a valid port: %S" new-port-string))))
-
(defun slime-maybe-start-lisp ()
"Start an inferior lisp unless one is already running."
(unless (get-buffer-process (get-buffer "*inferior-lisp*"))
(call-interactively 'inferior-lisp)
- (slime-start-swank-server)))
+ (comint-proc-query (inferior-lisp-proc)
+ (format "(load %S)\n"
+ (concat slime-path slime-backend)))))
(defun slime-start-swank-server ()
"Start a Swank server on the inferior lisp."
(comint-proc-query (inferior-lisp-proc)
- (format "(load %S)\n"
- (concat slime-path slime-backend)))
- (comint-proc-query (inferior-lisp-proc)
- (format "(swank:start-server %S)\n" slime-swank-port)))
+ (format "(swank:start-server %S)\n"
+ (slime-swank-port-file))))
+
+(defun slime-swank-port-file ()
+ "Filename where the SWANK server writes its TCP port number."
+ (format "/tmp/slime.%S" (emacs-pid)))
+
+(defun slime-read-swank-port ()
+ "Read the Swank server port number from the `slime-swank-port-file'."
+ (save-excursion
+ (with-temp-buffer
+ (insert-file-contents (slime-swank-port-file))
+ (goto-char (point-min))
+ (let ((port (read (current-buffer))))
+ (assert (integerp port))
+ port))))
-(defun slime-connect (host port &optional retries)
+(defun slime-connect (&optional retries)
"Connect to a running Swank server."
- (interactive (list (read-string "Host: " "localhost")
- (let ((port
- (read-string "Port: "
- (number-to-string slime-swank-port))))
- (or (ignore-errors (string-to-number port)) port))))
- (lexical-let ((host host)
- (port port)
- (retries (or retries slime-swank-connection-retries))
+ (slime-start-swank-server)
+ (lexical-let ((retries (or retries slime-swank-connection-retries))
(attempt 0))
(labels
;; A small one-state machine to attempt a connection with
@@ -651,15 +643,19 @@
()
(unless (active-minibuffer-window)
(message "\
-Connecting to Swank at %s:%S. (Abort with `M-x slime-disconnect'.)"
- host port))
- (setq slime-state-name (format "[connect:%S]" (incf attempt)))
+Polling %S.. (Abort with `M-x slime-disconnect'.)"
+ (slime-swank-port-file)))
+ (setq slime-state-name (format "[polling:%S]" (incf attempt)))
(force-mode-line-update)
(setq slime-connect-retry-timer nil) ; remove old timer
- (cond ((slime-net-connect host port)
- (slime-init-connection)
- (message "Connected to Swank on %s:%S. %s"
- host port (slime-random-words-of-encouragement)))
+ (cond ((file-exists-p (slime-swank-port-file))
+ (let ((port (slime-read-swank-port)))
+ (message "Connecting to Swank on port %S.." port)
+ (delete-file (slime-swank-port-file))
+ (slime-net-connect "localhost" port)
+ (slime-init-connection)
+ (message "Connected to Swank server on port %S. %s"
+ port (slime-random-words-of-encouragement))))
((and retries (zerop retries))
(message "Failed to connect to Swank."))
(t
@@ -711,20 +707,16 @@
(defun slime-net-connect (host port)
"Establish a connection with a CL."
- (condition-case nil
- (progn
- (setq slime-net-process
- (open-network-stream "SLIME Lisp" nil host port))
- (let ((buffer (slime-make-net-buffer "*cl-connection*")))
- (set-process-buffer slime-net-process buffer)
- (set-process-filter slime-net-process 'slime-net-filter)
- (set-process-sentinel slime-net-process 'slime-net-sentinel)
- (when (fboundp 'set-process-coding-system)
- (set-process-coding-system slime-net-process
- 'no-conversion 'no-conversion)))
- slime-net-process)
- (file-error () nil)
- (network-error () nil)))
+ (setq slime-net-process
+ (open-network-stream "SLIME Lisp" nil host port))
+ (let ((buffer (slime-make-net-buffer "*cl-connection*")))
+ (set-process-buffer slime-net-process buffer)
+ (set-process-filter slime-net-process 'slime-net-filter)
+ (set-process-sentinel slime-net-process 'slime-net-sentinel)
+ (when (fboundp 'set-process-coding-system)
+ (set-process-coding-system slime-net-process
+ 'no-conversion 'no-conversion)))
+ slime-net-process)
(defun slime-make-net-buffer (name)
"Make a buffer suitable for a network process."
Index: slime/ChangeLog
diff -u slime/ChangeLog:1.65 slime/ChangeLog:1.66
--- slime/ChangeLog:1.65 Fri Oct 24 18:20:46 2003
+++ slime/ChangeLog Fri Oct 24 21:54:00 2003
@@ -1,5 +1,23 @@
2003-10-25 Luke Gorrie <luke at bluetail.com>
+ * Everywhere: Changed the connection setup to use a dynamic
+ collision-free TCP port. The new protocol is this:
+
+ Emacs calls (swank:start-server FILENAME) via the
+ listener. FILENAME is /tmp/slime.${emacspid}
+ Lisp starts a TCP server on a dynamic available port and writes
+ the port number it gets to FILENAME.
+ Emacs asynchronously polls for FILENAME's creation. When it
+ exists, Emacs reads the port number, deletes the file, and makes
+ the connection.
+
+ The advantage is that you can run multiple Emacsen each with an
+ inferior lisp, and the port numbers will never collide and Emacs
+ will always connect to the right lisp.
+
+ All backends are updated, but only CMUCL and SBCL are
+ tested. Therefore, OpenMCL is almost certainly broken just now.
+
* slime.el (inferior-slime-closing-return): New command that
closes all open lists and sends the result to Lisp. Bound to C-RET
and (for people who use C-m for RET) C-M-m.
More information about the slime-cvs
mailing list