[slime-cvs] CVS update: slime/slime.el slime/swank-backend.lisp slime/swank-cmucl.lisp slime/swank-sbcl.lisp slime/swank-openmcl.lisp slime/swank-lispworks.lisp slime/swank-clisp.lisp
Helmut Eller
heller at common-lisp.net
Tue Feb 24 23:31:35 UTC 2004
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv15681
Modified Files:
slime.el swank-backend.lisp swank-cmucl.lisp swank-sbcl.lisp
swank-openmcl.lisp swank-lispworks.lisp swank-clisp.lisp
Log Message:
* slime.el: Various bits of support for maintaining multiple SLIME
connections to different Lisp implementations simultaneously.
* swank-{backend,cmucl,sbcl,clisp,lispworks,openmcl}.lisp
(lisp-implementation-type-name): Add function to
return simple name of lisp implementation; used by new
multi-connection functionality in slime.el.
Date: Tue Feb 24 18:31:34 2004
Author: heller
Index: slime/slime.el
diff -u slime/slime.el:1.216 slime/slime.el:1.217
--- slime/slime.el:1.216 Mon Feb 23 17:14:56 2004
+++ slime/slime.el Tue Feb 24 18:31:34 2004
@@ -633,6 +633,27 @@
(put 'destructure-case 'lisp-indent-function 1)
+(defmacro* slime-with-chosen-connection ((&optional
+ (prefix-arg 'current-prefix-arg))
+ &body body)
+ "Make the connection choosen by PREFIX-ARG current.
+
+(slime-with-chosen-connection (&optional (PREFIX-ARG 'current-prefix-arg))
+ &body BODY)"
+ `(let ((slime-buffer-connection (slime-get-named-connection ,prefix-arg)))
+ , at body))
+
+(put 'slime-with-chosen-connection 'lisp-indent-function 1)
+
+(defun slime-get-named-connection (prefix-arg)
+ "Get a connection based on PREIFX-ARG."
+ (cond ((not prefix-arg)
+ (slime-connection))
+ ((equal prefix-arg '(4))
+ (slime-find-connection-by-type-name
+ (slime-read-lisp-implementation-type-name)))
+ (t (error "Invalid prefix argument: %S" prefix-arg))))
+
(defmacro slime-define-keys (keymap &rest key-command)
`(progn . ,(mapcar (lambda (k-c) `(define-key ,keymap . ,k-c))
key-command)))
@@ -1229,8 +1250,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 +1271,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)
@@ -1275,8 +1308,8 @@
(make-variable-buffer-local
(defvar ,real-var , at initial-value-and-doc))
;; Accessor
- (defun ,varname ()
- (slime-with-connection-buffer () ,real-var))
+ (defun ,varname (&optional process)
+ (slime-with-connection-buffer (process) ,real-var))
;; Setf
(defsetf ,varname () (store)
`(slime-with-connection-buffer ()
@@ -1299,6 +1332,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.")
@@ -1394,18 +1430,20 @@
(when (equal slime-net-processes (list proc))
(setq slime-connection-counter 0))
(slime-with-connection-buffer ()
- (setq slime-connection-number (incf slime-connection-counter)))
- (setf (slime-pid) (slime-eval '(swank:getpid)))
- (setf (slime-lisp-implementation-type)
- (slime-eval '(cl:lisp-implementation-type)))
- (setq slime-state-name "")
- (when-let (repl-buffer (slime-repl-buffer))
- ;; REPL buffer already exists - update its local
- ;; `slime-connection' binding.
- (with-current-buffer repl-buffer
- (setq slime-buffer-connection proc)))
- (when slime-global-debugger-hook
- (slime-eval '(swank:install-global-debugger-hook) "COMMON-LISP-USER")))
+ (setq slime-connection-number (incf slime-connection-counter))
+ (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
+ ;; `slime-connection' binding.
+ (with-current-buffer repl-buffer
+ (setq slime-buffer-connection proc)))
+ (when slime-global-debugger-hook
+ (slime-eval '(swank:install-global-debugger-hook) "COMMON-LISP-USER"))))
(defun slime-busy-p ()
slime-rex-continuations)
@@ -1692,10 +1730,11 @@
(defun slime-switch-to-output-buffer ()
"Select the output buffer, preferably in a different window."
(interactive)
- (set-buffer (slime-output-buffer))
- (unless (eq (current-buffer) (window-buffer))
- (pop-to-buffer (current-buffer) t))
- (goto-char (point-max)))
+ (slime-with-chosen-connection ()
+ (set-buffer (slime-output-buffer))
+ (unless (eq (current-buffer) (window-buffer))
+ (pop-to-buffer (current-buffer) t))
+ (goto-char (point-max))))
;;; REPL
@@ -2227,7 +2266,8 @@
`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))
+ (slime-with-chosen-connection ()
+ (slime-compile-file t)))
(defun slime-compile-file (&optional load)
"Compile current buffer's file and highlight resulting compiler notes.
@@ -2275,16 +2315,19 @@
(defun slime-compile-defun ()
"Compile the current toplevel form."
(interactive)
- (slime-compile-string (slime-defun-at-point)
- (save-excursion
- (end-of-defun)
- (beginning-of-defun)
- (point))))
+ (slime-with-chosen-connection ()
+ (slime-compile-string
+ (slime-defun-at-point)
+ (save-excursion
+ (end-of-defun)
+ (beginning-of-defun)
+ (point)))))
(defun slime-compile-region (start end)
"Compile the region."
(interactive "r")
- (slime-compile-string (buffer-substring-no-properties start end) start))
+ (slime-with-chosen-connection ()
+ (slime-compile-string (buffer-substring-no-properties start end) start)))
(defun slime-compile-string (string start-offset)
(slime-eval-async
@@ -4639,18 +4682,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: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.31 slime/swank-backend.lisp:1.32
--- slime/swank-backend.lisp:1.31 Sat Feb 21 11:35:55 2004
+++ slime/swank-backend.lisp Tue Feb 24 18:31:34 2004
@@ -38,6 +38,7 @@
#:frame-locals
#:frame-source-location-for-emacs
#:frame-source-position
+ #:lisp-implementation-type-name
#:getpid
#:give-goahead
#:give-gohead
@@ -202,8 +203,12 @@
(defgeneric call-without-interrupts (fn)
(:documentation "Call FN in a context where interrupts are disabled."))
-(defgeneric getpid ()
- (:documentation "Return the (Unix) process ID of this superior Lisp."))
+(definterface getpid ()
+ "Return the (Unix) process ID of this superior Lisp.")
+
+(definterface lisp-implementation-type-name ()
+ "Return a short name for the Lisp implementation."
+ (lisp-implementation-type))
;;;; Compilation
Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.69 slime/swank-cmucl.lisp:1.70
--- slime/swank-cmucl.lisp:1.69 Mon Feb 23 02:21:07 2004
+++ slime/swank-cmucl.lisp Tue Feb 24 18:31:34 2004
@@ -132,12 +132,13 @@
;;;; Unix signals
(defmethod call-without-interrupts (fn)
- (sys:without-interrupts (funcall fn))
- ;;(funcall fn)
- )
+ (sys:without-interrupts (funcall fn)))
-(defmethod getpid ()
+(defimplementation getpid ()
(unix:unix-getpid))
+
+(defimplementation lisp-implementation-type-name ()
+ "cmucl")
;;;; Stream handling
Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.67 slime/swank-sbcl.lisp:1.68
--- slime/swank-sbcl.lisp:1.67 Sat Feb 21 11:42:52 2004
+++ slime/swank-sbcl.lisp Tue Feb 24 18:31:34 2004
@@ -189,6 +189,9 @@
(defmethod getpid ()
(sb-unix:unix-getpid))
+(defimplementation lisp-implementation-type-name ()
+ "sbcl")
+
;;; Utilities
(defvar *swank-debugger-stack-frame*)
Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.63 slime/swank-openmcl.lisp:1.64
--- slime/swank-openmcl.lisp:1.63 Sun Feb 8 14:19:42 2004
+++ slime/swank-openmcl.lisp Tue Feb 24 18:31:34 2004
@@ -95,6 +95,9 @@
(defmethod getpid ()
(ccl::getpid))
+(defimplementation lisp-implementation-type-name ()
+ "openmcl")
+
(let ((ccl::*warn-if-redefine-kernel* nil))
(defun ccl::force-break-in-listener (p)
(ccl::process-interrupt
Index: slime/swank-lispworks.lisp
diff -u slime/swank-lispworks.lisp:1.22 slime/swank-lispworks.lisp:1.23
--- slime/swank-lispworks.lisp:1.22 Sun Feb 8 14:19:42 2004
+++ slime/swank-lispworks.lisp Tue Feb 24 18:31:34 2004
@@ -77,6 +77,9 @@
(defmethod getpid ()
(system::getpid))
+(defimplementation lisp-implementation-type-name ()
+ "lispworks")
+
(defimplementation arglist-string (fname)
(format-arglist fname #'lw:function-lambda-list))
Index: slime/swank-clisp.lisp
diff -u slime/swank-clisp.lisp:1.20 slime/swank-clisp.lisp:1.21
--- slime/swank-clisp.lisp:1.20 Wed Feb 18 02:32:44 2004
+++ slime/swank-clisp.lisp Tue Feb 24 18:31:34 2004
@@ -58,6 +58,9 @@
#+win32 (defmethod getpid () (or (system::getenv "PID") -1))
;; the above is likely broken; we need windows NT users!
+(defimplementation lisp-implementation-type-name ()
+ "clisp")
+
;;; TCP Server
More information about the slime-cvs
mailing list