[slime-cvs] CVS update: slime/ChangeLog slime/slime.el

[Peter Seibel]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv8064

Modified Files:
	ChangeLog slime.el 
Log Message:
Change slime-list-connections to be a bit more useful.

Date: Thu Feb 26 14:20:05 2004
Author: pseibel

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.269 slime/ChangeLog:1.270
--- slime/ChangeLog:1.269	Thu Feb 26 13:38:00 2004
+++ slime/ChangeLog	Thu Feb 26 14:20:04 2004
@@ -1,3 +1,9 @@
+2004-02-26  Peter Seibel  <peter at javamonkey.com>
+
+	* slime.el (slime-list-connections): Make the buffer created by
+	this function do a bit more: Can use it to switch to different
+	connections and change the default.
+
 2004-02-26  Marco Baringer  <mb at bese.it>
 
 	* swank-openmcl.lisp (ccl::force-break-in-listener): Pass a


Index: slime/slime.el
diff -u slime/slime.el:1.220 slime/slime.el:1.221
--- slime/slime.el:1.220	Wed Feb 25 15:47:27 2004
+++ slime/slime.el	Thu Feb 26 14:20:04 2004
@@ -4693,28 +4693,71 @@
 
 ;;;;; Connection listing
 
+(define-derived-mode slime-connection-list-mode fundamental-mode
+  "connection-list"
+  "SLIME Connection List Mode.
+
+\\{slime-connection-list-mode-map}"
+  (when slime-truncate-lines
+    (set (make-local-variable 'truncate-lines) t)))
+
+(slime-define-keys slime-connection-list-mode-map
+  ((kbd "RET") 'slime-goto-connection)
+  ("d"         'slime-connection-list-make-default)
+  ("q"         'slime-temp-buffer-quit))
+
+(defun slime-goto-connection ()
+  (interactive)
+  (let ((slime-dispatching-connection 
+         (slime-find-connection-by-type-name
+          (slime-extract-type-name-from-line))))
+    (slime-switch-to-output-buffer)))
+
+(defun slime-connection-list-make-default ()
+  (interactive)
+  (let ((slime-dispatching-connection 
+         (slime-find-connection-by-type-name
+          (slime-extract-type-name-from-line))))
+    (slime-make-default-connection)
+    (slime-draw-connection-list)))
+
+(defun slime-extract-type-name-from-line ()
+  (save-excursion
+    (beginning-of-line)
+    (search-forward-regexp "[0-9]\\s *\\([0-9a-zA-Z]+\\)")
+    (match-string 1)))
+
 (defun slime-list-connections ()
   "Display a list of all connections."
   (interactive)
   (when (get-buffer "*SLIME connections*")
     (kill-buffer  "*SLIME connections*"))
-  (slime-with-output-to-temp-buffer "*SLIME connections*"
-    (let ((default (slime-connection)))
-      (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  %-7s  %-17s  %-7s %-s\n"
-                     (if (eq default p) "*" " ")
-                     (slime-connection-number)
-                     (slime-lisp-implementation-type-name)
-                     (or (process-id p) (process-contact p))
-                     (slime-pid)
-                     (slime-lisp-implementation-type)))))))))
+  (slime-draw-connection-list))
+
+(defun slime-draw-connection-list ()
+  (let ((default-pos nil))
+    (slime-with-output-to-temp-buffer "*SLIME connections*"
+      (slime-connection-list-mode)
+      (let ((default (slime-connection)))
+        (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 (reverse slime-net-processes))
+          (let ((slime-dispatching-connection p))
+            (if (eq default p) (setf default-pos (point)))
+            (insert
+             (slime-with-connection-buffer (p)
+               (format "%s%2d  %-7s  %-17s  %-7s %-s\n"
+                       (if (eq default p) "*" " ")
+                       (slime-connection-number)
+                       (slime-lisp-implementation-type-name)
+                       (or (process-id p) (process-contact p))
+                       (slime-pid)
+                       (slime-lisp-implementation-type))))))))
+    (with-current-buffer (get-buffer "*SLIME connections*")
+      (goto-char default-pos))))
+
 
 
 ;;; Inspector