[slime-cvs] CVS slime/contrib
trittweiler
trittweiler at common-lisp.net
Sun Sep 7 12:34:23 UTC 2008
Update of /project/slime/cvsroot/slime/contrib
In directory clnet:/tmp/cvs-serv7171/contrib
Modified Files:
swank-arglists.lisp slime-autodoc.el ChangeLog
Log Message:
Slime-autodoc now also displays arglists of local functions.
* swank-arglists.lisp (defslimefun format-arglist-for-echo-area):
New RPC.
* slime-autodoc.el (slime-make-autodoc-cache-key): New; extracted
from slime-autodoc-thing-at-point.
(slime-make-autodoc-swank-form): New; partially extracted from
slime-autodoc-thing-at-point. Use `slime-autodoc-local-arglist'.
(slime-autodoc-local-arglist): New function.
(slime-autodoc-thing-at-point): Use the two new functions.
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2008/08/27 17:53:12 1.22
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2008/09/07 12:34:22 1.23
@@ -455,7 +455,15 @@
(*print-length* . 20)
(*print-escape* . nil))) ; no package qualifiers.
-(defun decoded-arglist-to-string (arglist
+(defslimefun format-arglist-for-echo-area
+ (arglist &rest args
+ &key operator highlight (package *package*)
+ print-right-margin print-lines)
+ "Formats ARGLIST (given as string) for Emacs' echo area."
+ (declare (ignore operator highlight package print-right-margin print-lines))
+ (apply #'decoded-arglist-to-string (decode-arglist (read-from-string arglist)) args))
+
+(defun decoded-arglist-to-string (decoded-arglist
&key operator highlight (package *package*)
print-right-margin print-lines)
"Print the decoded ARGLIST for display in the echo area. The
@@ -469,7 +477,7 @@
(let ((*package* package)
(*print-right-margin* print-right-margin)
(*print-lines* print-lines))
- (print-arglist arglist :operator operator :highlight highlight))))))
+ (print-arglist decoded-arglist :operator operator :highlight highlight))))))
(defslimefun variable-desc-for-echo-area (variable-name)
"Return a short description of VARIABLE-NAME, or NIL."
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2008/03/18 13:21:42 1.8
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2008/09/07 12:34:22 1.9
@@ -17,6 +17,7 @@
;;
(require 'slime-parse)
+(require 'slime-enclosing-context)
(defvar slime-use-autodoc-mode t
"When non-nil always enable slime-autodoc-mode in slime-mode.")
@@ -88,8 +89,8 @@
"Print some apropos information about the code at point, if applicable."
(destructuring-bind (cache-key retrieve-form) (slime-autodoc-thing-at-point)
(let ((cached (slime-get-cached-autodoc cache-key)))
- (if cached
- (slime-autodoc-message cached)
+ (if cached
+ (slime-autodoc-message cached)
;; Asynchronously fetch, cache, and display documentation
(slime-eval-async
retrieve-form
@@ -146,21 +147,10 @@
(if global
(values (slime-qualify-cl-symbol-name global)
`(swank:variable-desc-for-echo-area ,global))
- (multiple-value-bind (operators arg-indices points)
- (slime-enclosing-form-specs)
- (values (mapcar* (lambda (designator arg-index)
- (cons
- (if (symbolp designator)
- (slime-qualify-cl-symbol-name designator)
- designator)
- arg-index))
- operators arg-indices)
- (multiple-value-bind (width height)
- (slime-autodoc-message-dimensions)
- `(swank:arglist-for-echo-area ',operators
- :arg-indices ',arg-indices
- :print-right-margin ,width
- :print-lines ,height)))))))
+ (multiple-value-bind (operators arg-indices points)
+ (slime-enclosing-form-specs)
+ (values (slime-make-autodoc-cache-key operators arg-indices points)
+ (slime-make-autodoc-swank-form operators arg-indices points))))))
(defun slime-autodoc-global-at-point ()
"Return the global variable name at point, if any."
@@ -180,6 +170,38 @@
(and (< (length name) 80) ; avoid overflows in regexp matcher
(string-match slime-global-variable-name-regexp name)))
+(defun slime-make-autodoc-cache-key (ops indices points)
+ (mapcar* (lambda (designator arg-index)
+ (let ((designator (if (symbolp designator)
+ (slime-qualify-cl-symbol-name designator)
+ designator)))
+ `(,designator . ,arg-index)))
+ operators arg-indices))
+
+(defun slime-make-autodoc-swank-form (ops indices points)
+ (multiple-value-bind (width height)
+ (slime-autodoc-message-dimensions)
+ (let ((local-arglist (slime-autodoc-local-arglist ops indices points)))
+ (if local-arglist
+ `(swank:format-arglist-for-echo-area ,local-arglist
+ :operator ,(first (first ops))
+ :highlight ,(first indices)
+ :print-right-margin ,width
+ :print-lines ,height)
+ `(swank:arglist-for-echo-area ',ops
+ :arg-indices ',indices
+ :print-right-margin ,width
+ :print-lines ,height)))))
+
+(defun slime-autodoc-local-arglist (ops indices points)
+ (let* ((cur-op (first ops))
+ (cur-op-name (first cur-op)))
+ (multiple-value-bind (bound-fn-names arglists)
+ (slime-find-bound-functions ops indices points)
+ (when-let (pos (position cur-op-name bound-fn-names :test 'equal))
+ (nth pos arglists)))))
+
+
(defun slime-get-cached-autodoc (symbol-name)
"Return the cached autodoc documentation for SYMBOL-NAME, or nil."
(ecase slime-autodoc-cache-type
--- /project/slime/cvsroot/slime/contrib/ChangeLog 2008/09/07 12:24:37 1.126
+++ /project/slime/cvsroot/slime/contrib/ChangeLog 2008/09/07 12:34:22 1.127
@@ -1,4 +1,18 @@
-2008-07-09 Tobias C. Rittweiler <tcr at freebits.de>
+2008-09-07 Tobias C. Rittweiler <tcr at freebits.de>
+
+ Slime-autodoc now also displays arglists of local functions.
+
+ * swank-arglists.lisp (defslimefun format-arglist-for-echo-area):
+ New RPC.
+
+ * slime-autodoc.el (slime-make-autodoc-cache-key): New; extracted
+ from slime-autodoc-thing-at-point.
+ (slime-make-autodoc-swank-form): New; partially extracted from
+ slime-autodoc-thing-at-point. Use `slime-autodoc-local-arglist'.
+ (slime-autodoc-local-arglist): New function.
+ (slime-autodoc-thing-at-point): Use the two new functions.
+
+2008-09-07 Tobias C. Rittweiler <tcr at freebits.de>
* slime-enclosing-context.el: New utility contrib on top of
`slime-parse' to extract some context around point, like bound
More information about the slime-cvs
mailing list