[slime-devel] PATCH: Some more support for running multiple simultaneous connections
Peter Seibel
peter at javamonkey.com
Tue Feb 24 19:25:52 UTC 2004
Here's a patch containing some code I wrote to support running
multiple simultaneous SLIME connections to different Lisp
implementations. I think I made about as good use of the existing
infrastructure as I could but may have missed something. (Speaking of
which, is there a reason certain buffer local vars (e.g.
slime-connection-number) aren't defined with
slime-def-connection-var?)
Anyway, here it is:
Index: ChangeLog
===================================================================
RCS file: /project/slime/cvsroot/slime/ChangeLog,v
retrieving revision 1.262
diff -u -r1.262 ChangeLog
--- ChangeLog 23 Feb 2004 07:21:31 -0000 1.262
+++ ChangeLog 24 Feb 2004 19:17:11 -0000
@@ -1,3 +1,12 @@
+2004-02-24 Peter Seibel <peter at javamonkey.com>
+
+ * slime.el: Various bits of support for maintaining multiple SLIME
+ connections to different Lisp implementations simultaneously.
+
+ * swank.lisp (lisp-implementation-type-name): Add function to
+ return simple name of lisp implementation; used by new
+ multi-connection functionality in slime.el.
+
2004-02-22 Lawrence Mitchell <wence at gmx.li>
* swank.lisp (format-arglist): Bind *PRINT-PRETTY* to NIL.
Index: slime.el
===================================================================
RCS file: /project/slime/cvsroot/slime/slime.el,v
retrieving revision 1.216
diff -u -r1.216 slime.el
--- slime.el 23 Feb 2004 22:14:56 -0000 1.216
+++ slime.el 24 Feb 2004 19:17:13 -0000
@@ -633,6 +633,15 @@
(put 'destructure-case 'lisp-indent-function 1)
+
+(defmacro* slime-with-chosen-connection ((n) &rest body)
+ "Make the connection choosen by a universal argument current."
+ `(let ((slime-buffer-connection (slime-get-named-connection ,n slime-buffer-connection)))
+ , at body))
+
+(put 'slime-with-chosen-connection 'lisp-indent-function 1)
+
+
(defmacro slime-define-keys (keymap &rest key-command)
`(progn . ,(mapcar (lambda (k-c) `(define-key ,keymap . ,k-c))
key-command)))
@@ -1229,8 +1238,9 @@
(when (eq process slime-default-connection)
(when slime-net-processes
(slime-select-connection (car slime-net-processes))
- (message (format "Default connection closed; switched to #%S"
- (slime-connection-number))))))
+ (message (format "Default connection closed; switched to #%S (%S)"
+ (slime-connection-number)
+ (slime-lisp-implementation-type-name))))))
(defun slime-connection-number (&optional connection)
(slime-with-connection-buffer (connection)
@@ -1249,7 +1259,18 @@
(length slime-net-processes))
slime-net-processes)))
(slime-select-connection conn)
- (message (format "Selected connection #%S" (slime-connection-number)))))
+ (message (format "Selected connection #%S (%s)"
+ (slime-connection-number)
+ (slime-lisp-implementation-type-name)))))
+
+(defun slime-make-default-connection ()
+ "Make the current buffer connection the default connection."
+ (interactive)
+ (slime-select-connection slime-buffer-connection)
+ (message (format "Connection #%S (%s) now default SLIME connection."
+ (slime-connection-number)
+ (slime-lisp-implementation-type-name))))
+
(put 'slime-with-connection-buffer 'lisp-indent-function 1)
@@ -1299,6 +1320,9 @@
(slime-def-connection-var slime-lisp-implementation-type nil
"The implementation type of the Lisp process.")
+(slime-def-connection-var slime-lisp-implementation-type-name nil
+ "The short name for the implementation type of the Lisp process.")
+
(slime-def-connection-var slime-use-sigint-for-interrupt nil
"If non-nil use a SIGINT for interrupting.")
@@ -1398,6 +1422,8 @@
(setf (slime-pid) (slime-eval '(swank:getpid)))
(setf (slime-lisp-implementation-type)
(slime-eval '(cl:lisp-implementation-type)))
+ (setf (slime-lisp-implementation-type-name)
+ (slime-eval '(swank:lisp-implementation-type-name)))
(setq slime-state-name "")
(when-let (repl-buffer (slime-repl-buffer))
;; REPL buffer already exists - update its local
@@ -1766,6 +1792,41 @@
(defvar slime-repl-mode-map)
+(defun slime-switch-to-repl (p)
+ "Switch to the REPL. With a prefix arg, prompt for a named REPL."
+ (interactive "p")
+ (cond
+ ((= p 1)
+ (slime-switch-to-output-buffer))
+ ((or (= p 4) (= p 16))
+ (switch-to-buffer
+ (slime-find-connection-buffer-by-type-name (slime-read-lisp-implementation-type-name)))
+ (if (= p 16) (slime-make-default-connection)))))
+
+(defun slime-find-connection-by-type-name (name)
+ (dolist (p slime-net-processes)
+ (let ((slime-dispatching-connection p))
+ (slime-with-connection-buffer (p)
+ (when (string= (slime-lisp-implementation-type-name) name)
+ (return p))))))
+
+(defun slime-find-connection-buffer-by-type-name (name)
+ (let* ((p (slime-find-connection-by-type-name name))
+ (slime-dispatching-connection p))
+ (slime-with-connection-buffer (p)
+ (slime-repl-buffer))))
+
+(defun slime-read-lisp-implementation-type-name ()
+ (let ((default (slime-lisp-implementation-type-name)))
+ (completing-read
+ (format "Name (default %s): " default)
+ (mapcar #'(lambda (p) (let ((slime-dispatching-connection p)) (slime-with-connection-buffer (p) (list (slime-lisp-implementation-type-name))))) slime-net-processes)
+ nil
+ t
+ nil
+ nil
+ default)))
+
(defun slime-repl-buffer (&optional create)
"Get the REPL buffer for the current connection; optionally create."
(funcall (if create #'get-buffer-create #'get-buffer)
@@ -2219,15 +2280,20 @@
;;; Compilation and the creation of compiler-note annotations
-(defun slime-compile-and-load-file ()
+(defun slime-compile-and-load-file (n)
"Compile and load the buffer's file and highlight compiler notes.
Each source location that is the subject of a compiler note is
underlined and annotated with the relevant information. The commands
`slime-next-note' and `slime-previous-note' can be used to navigate
between compiler notes and to display their full details."
- (interactive)
- (slime-compile-file t))
+ (interactive "p")
+ (slime-with-chosen-connection (n)
+ (slime-compile-file t)))
+
+(defun slime-get-named-connection (n default)
+ "Get a named connection based on an interactive `p' argument."
+ (case n (1 default) (4 (slime-find-connection-by-type-name (slime-read-lisp-implementation-type-name)))))
(defun slime-compile-file (&optional load)
"Compile current buffer's file and highlight resulting compiler notes.
@@ -2272,19 +2338,22 @@
(slime-compilation-finished-continuation t))
(message "Compiling system %s.." system-name))
-(defun slime-compile-defun ()
+(defun slime-compile-defun (n)
"Compile the current toplevel form."
- (interactive)
- (slime-compile-string (slime-defun-at-point)
- (save-excursion
- (end-of-defun)
- (beginning-of-defun)
- (point))))
+ (interactive "p")
+ (slime-with-chosen-connection (n)
+ (slime-compile-string
+ (slime-defun-at-point)
+ (save-excursion
+ (end-of-defun)
+ (beginning-of-defun)
+ (point)))))
-(defun slime-compile-region (start end)
+(defun slime-compile-region (n start end)
"Compile the region."
- (interactive "r")
- (slime-compile-string (buffer-substring-no-properties start end) start))
+ (interactive "p\nr")
+ (slime-with-chosen-connection (n)
+ (slime-compile-string (buffer-substring-no-properties start end) start)))
(defun slime-compile-string (string start-offset)
(slime-eval-async
@@ -4639,18 +4708,21 @@
(kill-buffer "*SLIME connections*"))
(slime-with-output-to-temp-buffer "*SLIME connections*"
(let ((default (slime-connection)))
- (insert " Nr Type Port Pid\n"
- " -- ---- ---- ---\n")
+ (insert
+ (format "%s%2s %-7s %-17s %-7s %-s\n" " " "Nr" "Name" "Port" "Pid" "Type"))
+ (insert
+ (format "%s%2s %-7s %-17s %-7s %-s\n" " " "--" "----" "----" "---" "----"))
(dolist (p slime-net-processes)
(let ((slime-dispatching-connection p))
(insert
(slime-with-connection-buffer (p)
- (format "%s%2d %-20s %-17s %-5s\n"
+ (format "%s%2d %-7s %-17s %-7s %-s\n"
(if (eq default p) "*" " ")
(slime-connection-number)
- (slime-lisp-implementation-type)
+ (slime-lisp-implementation-type-name)
(or (process-id p) (process-contact p))
- (slime-pid)))))))))
+ (slime-pid)
+ (slime-lisp-implementation-type)))))))))
;;; Inspector
Index: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.124
diff -u -r1.124 swank.lisp
--- swank.lisp 23 Feb 2004 07:21:07 -0000 1.124
+++ swank.lisp 24 Feb 2004 19:17:14 -0000
@@ -1483,6 +1483,18 @@
(setq *thread-list* nil))
+
+
+;;;; Meta-info about Lisp
+
+(defslimefun lisp-implementation-type-name ()
+ #+cmu "cmu"
+ #+sbcl "sbcl"
+ #+openmcl "openmcl"
+ #+lispworks "lispworks"
+ #+allegro "allegro"
+ #+clisp "clisp")
+
;;; Local Variables:
;;; eval: (font-lock-add-keywords 'lisp-mode '(("(\\(defslimefun\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-keyword-face) (2 font-lock-function-name-face))))
;;; End:
--
Peter Seibel peter at javamonkey.com
Lisp is the red pill. -- John Fraser, comp.lang.lisp
More information about the slime-devel
mailing list