[slime-devel] PATCH: Some more support for running multiple simultaneous connections
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@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@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))) + ,@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@javamonkey.com Lisp is the red pill. -- John Fraser, comp.lang.lisp
Peter Seibel <peter@javamonkey.com> writes:
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.
Nice work! It's good that someone who actually uses the functionality also writes code.
(Speaking of which, is there a reason certain buffer local vars (e.g. slime-connection-number) aren't defined with slime-def-connection-var?)
Probably just an oversight.
+(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))) + ,@body))
I changed this a bit, so that the 'current-prefix-arg' is used. This way we don't have to modify the signatures of other functions.
+(slime-def-connection-var slime-lisp-implementation-type-name nil + "The short name for the implementation type of the Lisp process.")
We could call this slime-connection-name and use a similar naming scheme as Emacs uses for buffer names, so that we can have multiple connections to Lisps of the same type.
+(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)))))
I merged this into slime-switch-to-output-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)))
Please use fewer than 80 characters per line.
+(defslimefun lisp-implementation-type-name () + #+cmu "cmu" + #+sbcl "sbcl" + #+openmcl "openmcl" + #+lispworks "lispworks" + #+allegro "allegro" + #+clisp "clisp")
No, no, no. This style is taboo. The proper way is to define a new interface function and to implement it in the implementation specific file. I'll ask Erik Enge to give you CVS write permissions. Helmut.
Helmut Eller <e9626484@stud3.tuwien.ac.at> writes:
I changed this a bit, so that the 'current-prefix-arg' is used. This way we don't have to modify the signatures of other functions.
Ah. I wasn't aware of that variable. I learn something about emacs everyday. Nice.
+(defslimefun lisp-implementation-type-name () + #+cmu "cmu" + #+sbcl "sbcl" + #+openmcl "openmcl" + #+lispworks "lispworks" + #+allegro "allegro" + #+clisp "clisp")
No, no, no. This style is taboo. The proper way is to define a new interface function and to implement it in the implementation specific file.
Oh yeah. I didn't think of it was such a simple function but you are, of course, correct.
I'll ask Erik Enge to give you CVS write permissions.
Cool. In the meantime, you might want to apply this patch--you forgot to include these two functions that are used by some of the code you checked in. -Peter Index: slime.el =================================================================== RCS file: /project/slime/cvsroot/slime/slime.el,v retrieving revision 1.217 diff -u -r1.217 slime.el --- slime.el 24 Feb 2004 23:31:34 -0000 1.217 +++ slime.el 25 Feb 2004 02:24:11 -0000 @@ -654,6 +654,29 @@ (slime-read-lisp-implementation-type-name))) (t (error "Invalid prefix argument: %S" prefix-arg)))) +(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-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))) + (defmacro slime-define-keys (keymap &rest key-command) `(progn . ,(mapcar (lambda (k-c) `(define-key ,keymap . ,k-c)) key-command))) -- Peter Seibel peter@javamonkey.com Lisp is the red pill. -- John Fraser, comp.lang.lisp
Peter Seibel <peter@javamonkey.com> writes:
Cool. In the meantime, you might want to apply this patch--you forgot to include these two functions that are used by some of the code you checked in.
Oops. Now in CVS. Helmut.
participants (2)
-
Helmut Eller -
Peter Seibel