[slime-cvs] CVS update: slime/swank.lisp

[Helmut Eller]

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

Modified Files:
	swank.lisp 
Log Message:
(connection-info): Include the initial package and a more
self-descriptive format.

Date: Sun Oct  9 20:55:53 2005
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.342 slime/swank.lisp:1.343
--- slime/swank.lisp:1.342	Wed Sep 28 00:44:28 2005
+++ slime/swank.lisp	Sun Oct  9 20:55:52 2005
@@ -54,6 +54,7 @@
 
 (in-package :swank)
 
+
 ;;;; Top-level variables, constants, macros
 
 (defconstant cl-package (find-package :cl)
@@ -136,6 +137,7 @@
 include some arbitrary initial value like NIL."
   (error "A required &KEY or &OPTIONAL argument was not supplied."))
 
+
 ;;;; Hooks
 ;;;
 ;;; We use Emacs-like `add-hook' and `run-hook' utilities to support
@@ -164,6 +166,7 @@
 (defvar *pre-reply-hook* '()
   "Hook run (without arguments) immediately before replying to an RPC.")
 
+
 ;;;; Connections
 ;;;
 ;;; Connection structures represent the network connections between
@@ -260,6 +263,7 @@
   (declare (ignore connection))
   (emacs-connected))
 
+
 ;;;; Helper macros
 
 (defmacro with-io-redirection ((connection) &body body)
@@ -327,6 +331,7 @@
     (apply #'format *log-output* format-string args)
     (force-output *log-output*)))
 
+
 ;;;; TCP Server
 
 (defvar *use-dedicated-output-stream* t
@@ -507,12 +512,13 @@
      (slime-protocol-error (e)
        (close-connection ,connection e))))
 
-(defun simple-break ()
+(defslimefun simple-break ()
   (with-simple-restart  (continue "Continue from interrupt.")
     (let ((*debugger-hook* #'swank-debugger-hook))
       (invoke-debugger 
        (make-condition 'simple-error 
-                       :format-control "Interrupt from Emacs")))))
+                       :format-control "Interrupt from Emacs"))))
+  nil)
 
 ;;;;;; Thread based communication
 
@@ -996,8 +1002,8 @@
       (prin1-to-string object))))
 
 (defun force-user-output ()
-  (force-output (connection.user-io *emacs-connection*))
-  (force-output (connection.user-output *emacs-connection*)))
+  (finish-output (connection.user-io *emacs-connection*))
+  (finish-output (connection.user-output *emacs-connection*)))
 
 (defun clear-user-input  ()
   (clear-input (connection.user-input *emacs-connection*)))
@@ -1051,17 +1057,24 @@
                  ((:abort) (abort)))))))))
 
 (defslimefun connection-info ()
-  "Return a list of the form: 
-\(PID IMPLEMENTATION-TYPE IMPLEMENTATION-NAME FEATURES 
- COMMUNICATION-STYLE IMPLEMENTATION-VERSION MACHINE-INSTANCE)."
+  "Return a key-value list of the form: 
+\(&key PID STYLE LISP-IMPLEMENTATION MACHINE FEATURES PACKAGE)
+PID: is the process-id of Lisp process (or nil, depending on the STYLE)
+STYLE: the communication style
+LISP-IMPLEMENTATION: a list (&key TYPE TYPE-NAME VERSION)
+FEATURES: a list of keywords
+PACKAGE: a list (&key NAME PROMPT)"
   (setq *slime-features* *features*)
-  (list (getpid)
-        (lisp-implementation-type)
-        (lisp-implementation-type-name)
-        (features-for-emacs)
-        (connection.communication-style *emacs-connection*)
-        (lisp-implementation-version)
-        (machine-instance)))
+  `(:pid ,(getpid) :style ,(connection.communication-style *emacs-connection*)
+    :lisp-implementation (:type ,(lisp-implementation-type)
+                          :type-name ,(lisp-implementation-type-name)
+                          :version ,(lisp-implementation-version))
+    :machine (:instance ,(machine-instance)
+              :type ,(machine-type)
+              :version ,(machine-version))
+    :features ,(features-for-emacs)
+    :package (:name ,(package-name *package*)
+              :prompt ,(package-string-for-prompt *package*))))
 
 (defslimefun io-speed-test (&optional (n 5000) (m 1))
   (let* ((s *standard-output*)