[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