/[slime]/slime/swank.lisp
ViewVC logotype

Diff of /slime/swank.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.169 by heller, Wed Apr 21 18:56:42 2004 UTC revision 1.170 by heller, Wed Apr 21 21:51:23 2004 UTC
# Line 29  Line 29 
29             #:unprofile-all             #:unprofile-all
30             #:profile-package             #:profile-package
31             #:set-default-directory             #:set-default-directory
32               #:quit-lisp
33             ))             ))
34    
35  (in-package :swank)  (in-package :swank)
# Line 779  exists." Line 780  exists."
780      (cond (package (values symbol package))      (cond (package (values symbol package))
781            (t (error "Unknown symbol: ~S [in ~A]" string default-package)))))            (t (error "Unknown symbol: ~S [in ~A]" string default-package)))))
782    
783  (defslimefun arglist-for-echo-area (names)  (defslimefun arglist-for-echo-area (names &optional without-name)
784    "Return the arglist for the first function, macro, or special-op in NAMES."    "Return the arglist for the first function, macro, or special-op in NAMES."
785    (multiple-value-bind (symbol name)    (multiple-value-bind (symbol name)
786        (loop for name in names        (loop for name in names
# Line 788  exists." Line 789  exists."
789                       (macro-function symbol)                       (macro-function symbol)
790                       (special-operator-p symbol))                       (special-operator-p symbol))
791              return (values symbol name))              return (values symbol name))
792      (cond (symbol (format-arglist-for-echo-area symbol name))      (cond (symbol (format-arglist-for-echo-area symbol name without-name))
793            (t ""))))            (t ""))))
794    
795  (defun format-arglist-for-echo-area (symbol name)  (defun format-arglist-for-echo-area (symbol name without-name)
796    (multiple-value-bind (arglist c) (ignore-errors (values (arglist symbol)))    (multiple-value-bind (arglist c) (ignore-errors (values (arglist symbol)))
797      (cond (c (format nil "(~A -- <not available>)" symbol))      (cond ((and c without-name) " <not available>)")
798              (c (format nil "(~A -- <not available>)" symbol))
799            (t (let ((string (arglist-to-string arglist)))            (t (let ((string (arglist-to-string arglist)))
800                 (format nil "(~A~A~A)"                 (format nil "~:[(~A~;~*~]~A~A)"
801                           without-name
802                         name                         name
803                         (if (= (length string) 2) "" " ")                         (if (= (length string) 2) "" " ")
804                         (subseq string 1 (1- (length string)))))))))                         (subseq string 1 (1- (length string)))))))))

Legend:
Removed from v.1.169  
changed lines
  Added in v.1.170

  ViewVC Help
Powered by ViewVC 1.1.5