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

[Helmut Eller]

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

Modified Files:
	swank.lisp 
Log Message:
(arglist-for-echo-area): New argument to control if the operator name
should be included.

Date: Wed Apr 21 17:51:23 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.169 slime/swank.lisp:1.170
--- slime/swank.lisp:1.169	Wed Apr 21 14:56:42 2004
+++ slime/swank.lisp	Wed Apr 21 17:51:23 2004
@@ -29,6 +29,7 @@
            #:unprofile-all
            #:profile-package
            #:set-default-directory
+           #:quit-lisp
            ))
 
 (in-package :swank)
@@ -779,7 +780,7 @@
     (cond (package (values symbol package))
           (t (error "Unknown symbol: ~S [in ~A]" string default-package)))))
 
-(defslimefun arglist-for-echo-area (names)
+(defslimefun arglist-for-echo-area (names &optional without-name)
   "Return the arglist for the first function, macro, or special-op in NAMES."
   (multiple-value-bind (symbol name)
       (loop for name in names
@@ -788,14 +789,16 @@
                      (macro-function symbol)
                      (special-operator-p symbol))
             return (values symbol name))
-    (cond (symbol (format-arglist-for-echo-area symbol name))
+    (cond (symbol (format-arglist-for-echo-area symbol name without-name))
           (t ""))))
 
-(defun format-arglist-for-echo-area (symbol name)
+(defun format-arglist-for-echo-area (symbol name without-name)
   (multiple-value-bind (arglist c) (ignore-errors (values (arglist symbol)))
-    (cond (c (format nil "(~A -- <not available>)" symbol))
+    (cond ((and c without-name) " <not available>)")
+          (c (format nil "(~A -- <not available>)" symbol))
           (t (let ((string (arglist-to-string arglist)))
-               (format nil "(~A~A~A)" 
+               (format nil "~:[(~A~;~*~]~A~A)"
+                       without-name
                        name
                        (if (= (length string) 2) "" " ")
                        (subseq string 1 (1- (length string)))))))))