[slime-cvs] CVS slime/contrib
CVS User trittweiler
trittweiler at common-lisp.net
Tue Dec 29 19:29:31 UTC 2009
Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv5176/contrib
Modified Files:
swank-arglists.lisp slime-autodoc.el ChangeLog
Log Message:
More cleanup.
The RP swank:arglist-for-echo-area is now called swank:autodoc.
* swank-arglists.lisp (autodoc): Renamed from
arglist-for-echo-area.
(variable-desc-for-echo-area): Deleted. Above function subsumes
this functionality now.
(print-variable-to-string): Extracted from
variable-desc-for-echo-area.
* slime-autodoc.el (slime-retrieve-arglist): Change RPC.
(slime-make-autodoc-rpc-form): Ditto.
(slime-autodoc-cache-type): Deleted.
(slime-autodoc-cache): Deleted.
(slime-autodoc-last-buffer-form): Replacement.
(slime-autodoc-last-autodoc): Replacement.
(slime-get-cached-autodoc): Adapted accordingly.
(slime-store-into-autodoc-cache): Adapted accordingly.
(slime-compute-autodoc): Simplified slightly.
(autodoc.1 [test]): Extended.
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2009/12/29 19:01:37 1.51
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2009/12/29 19:29:30 1.52
@@ -1060,21 +1060,7 @@
(setf (arglist.provided-args arglist) (list type-specifier))
arglist))))
-
;;; Slimefuns
-
-(defslimefun variable-desc-for-echo-area (variable-name)
- "Return a short description of VARIABLE-NAME, or NIL."
- (with-buffer-syntax ()
- (let ((sym (parse-symbol variable-name)))
- (if (and sym (boundp sym))
- (let ((*print-pretty* t) (*print-level* 4)
- (*print-length* 10) (*print-lines* 1)
- (*print-readably* nil))
- (call/truncated-output-to-string
- 75 (lambda (s)
- (format s "~A => ~S" sym (symbol-value sym)))))
- :not-available))))
;;; We work on a RAW-FORM, or BUFFER-FORM, which represent the form at
;;; user's point in Emacs. A RAW-FORM looks like
@@ -1097,7 +1083,7 @@
;;; %CURSOR-MARKER%)). Only the forms up to point should be
;;; considered.
-(defslimefun arglist-for-echo-area (raw-form &key print-right-margin print-lines)
+(defslimefun autodoc (raw-form &key print-right-margin print-lines)
"Return a string representing the arglist for the deepest subform in
RAW-FORM that does have an arglist. The highlighted parameter is
wrapped in ===> X <===."
@@ -1106,19 +1092,35 @@
(unless (debug-on-swank-error)
(let ((*print-right-margin* print-right-margin)
(*print-lines* print-lines))
- (return-from arglist-for-echo-area
+ (return-from autodoc
(format nil "Arglist Error: \"~A\"" c)))))))
(with-buffer-syntax ()
(multiple-value-bind (form arglist obj-at-cursor form-path)
(find-subform-with-arglist (parse-raw-form raw-form))
- (declare (ignore obj-at-cursor))
- (with-available-arglist (arglist) arglist
- (decoded-arglist-to-string
- arglist
- :print-right-margin print-right-margin
- :print-lines print-lines
- :operator (car form)
- :highlight (form-path-to-arglist-path form-path form arglist)))))))
+ (cond ((and obj-at-cursor
+ (symbolp obj-at-cursor)
+ (boundp obj-at-cursor))
+ (print-variable-to-string obj-at-cursor))
+ (t
+ (with-available-arglist (arglist) arglist
+ (decoded-arglist-to-string
+ arglist
+ :print-right-margin print-right-margin
+ :print-lines print-lines
+ :operator (car form)
+ :highlight (form-path-to-arglist-path form-path
+ form
+ arglist)))))))))
+
+(defun print-variable-to-string (symbol)
+ "Return a short description of VARIABLE-NAME, or NIL."
+ (let ((*print-pretty* t) (*print-level* 4)
+ (*print-length* 10) (*print-lines* 1)
+ (*print-readably* nil))
+ (call/truncated-output-to-string
+ 75 (lambda (s)
+ (format s "~A => ~S" symbol (symbol-value symbol))))))
+
(defslimefun complete-form (raw-form)
"Read FORM-STRING in the current buffer package, then complete it
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2009/12/23 08:34:17 1.26
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2009/12/29 19:29:31 1.27
@@ -21,7 +21,6 @@
"slime-autodoc doesn't work with XEmacs"))
(require 'slime-parse)
-(require 'slime-enclosing-context)
(defcustom slime-use-autodoc-mode t
"When non-nil always enable slime-autodoc-mode in slime-mode.")
@@ -54,25 +53,21 @@
(let ((name (etypecase name
(string name)
(symbol (symbol-name name)))))
- (slime-eval `(swank:arglist-for-echo-area '(,name ,slime-cursor-marker)))))
+ (slime-eval `(swank:autodoc '(,name ,slime-cursor-marker)))))
;;;; Autodocs (automatic context-sensitive help)
(defun slime-make-autodoc-rpc-form ()
"Return a cache key and a swank form."
- (let ((global (slime-autodoc-global-at-point)))
- (if global
- (values (slime-qualify-cl-symbol-name global)
- `(swank:variable-desc-for-echo-area ,global))
- (let* ((levels slime-autodoc-accuracy-depth)
- (buffer-form (slime-parse-form-upto-point levels)))
- (values buffer-form
- (multiple-value-bind (width height)
- (slime-autodoc-message-dimensions)
- `(swank:arglist-for-echo-area ',buffer-form
- :print-right-margin ,width
- :print-lines ,height)))))))
+ (let* ((levels slime-autodoc-accuracy-depth)
+ (buffer-form (slime-parse-form-upto-point levels)))
+ (values buffer-form
+ (multiple-value-bind (width height)
+ (slime-autodoc-message-dimensions)
+ `(swank:autodoc ',buffer-form
+ :print-right-margin ,width
+ :print-lines ,height)))))
(defun slime-autodoc-global-at-point ()
"Return the global variable name at point, if any."
@@ -112,41 +107,19 @@
;;;; Autodoc cache
-(defvar slime-autodoc-cache-type 'last
- "*Cache policy for automatically fetched documentation.
-Possible values are:
- nil - none.
- last - cache only the most recently-looked-at symbol's documentation.
- The values are stored in the variable `slime-autodoc-cache'.
-
-More caching means fewer calls to the Lisp process, but at the risk of
-using outdated information.")
-
-(defvar slime-autodoc-cache nil
- "Cache variable for when `slime-autodoc-cache-type' is 'last'.
-The value is (SYMBOL-NAME . DOCUMENTATION).")
-
-(defun slime-get-cached-autodoc (symbol-name)
- "Return the cached autodoc documentation for SYMBOL-NAME, or nil."
- (ecase slime-autodoc-cache-type
- ((nil) nil)
- ((last)
- (when (equal (car slime-autodoc-cache) symbol-name)
- (cdr slime-autodoc-cache)))
- ((all)
- (when-let (symbol (intern-soft symbol-name))
- (get symbol 'slime-autodoc-cache)))))
+(defvar slime-autodoc-last-buffer-form nil)
+(defvar slime-autodoc-last-autodoc nil)
-(defun slime-store-into-autodoc-cache (symbol-name documentation)
+(defun slime-get-cached-autodoc (buffer-form)
+ "Return the cached autodoc documentation for `buffer-form', or nil."
+ (when (equal buffer-form slime-autodoc-last-buffer-form)
+ slime-autodoc-last-autodoc))
+
+(defun slime-store-into-autodoc-cache (buffer-form autodoc)
"Update the autodoc cache for SYMBOL with DOCUMENTATION.
Return DOCUMENTATION."
- (ecase slime-autodoc-cache-type
- ((nil) nil)
- ((last)
- (setq slime-autodoc-cache (cons symbol-name documentation)))
- ((all)
- (put (intern symbol-name) 'slime-autodoc-cache documentation)))
- documentation)
+ (setq slime-autodoc-last-buffer-form buffer-form)
+ (setq slime-autodoc-last-autodoc autodoc))
;;;; Formatting autodoc
@@ -190,23 +163,22 @@
;; data.
(save-match-data
(unless (slime-inside-string-or-comment-p)
- (multiple-value-bind (cache-key retrieve-form) (slime-make-autodoc-rpc-form)
+ (multiple-value-bind (cache-key retrieve-form)
+ (slime-make-autodoc-rpc-form)
(let ((cached (slime-get-cached-autodoc cache-key)))
(if cached
cached
;; If nothing is in the cache, we first decline, and fetch
;; the arglist information asynchronously.
- (prog1 nil
- (slime-eval-async retrieve-form
- (lexical-let ((cache-key cache-key))
- (lambda (doc)
- (let ((doc (if (eq doc :not-available)
- ""
- (slime-format-autodoc doc))))
- ;; Now that we've got our information, get it to
- ;; the user ASAP.
- (eldoc-message doc)
- (slime-store-into-autodoc-cache cache-key doc)))))))))))))
+ (slime-eval-async retrieve-form
+ (lexical-let ((cache-key cache-key))
+ (lambda (doc)
+ (unless (eq doc :not-available)
+ (setq doc (slime-format-autodoc doc))
+ ;; Now that we've got our information,
+ ;; get it to the user ASAP.
+ (eldoc-message doc)
+ (slime-store-into-autodoc-cache cache-key doc))))))))))))
(make-variable-buffer-local (defvar slime-autodoc-mode nil))
@@ -269,13 +241,21 @@
'equal))
(def-slime-test autodoc.1
- (buffer-sexpr wished-arglist)
+ (buffer-sexpr wished-arglist &optional skip-trailing-test-p)
""
'(("(swank::emacs-connected*HERE*" "(emacs-connected)")
("(swank::create-socket*HERE*" "(create-socket host port)")
("(swank::create-socket *HERE*" "(create-socket ===> host <=== port)")
("(swank::create-socket foo *HERE*" "(create-socket host ===> port <===)")
+ ("#'(lambda () (swank::create-socket*HERE*" "(create-socket host port)")
+ ("`(lambda () ,(swank::create-socket*HERE*" "(create-socket host port)")
+
+ ("(remove-if #'(lambda () (swank::create-socket*HERE*"
+ "(create-socket host port)")
+ ("`(remove-if #'(lambda () ,@(swank::create-socket*HERE*"
+ "(create-socket host port)")
+
("(swank::symbol-status foo *HERE*"
"(symbol-status symbol &optional ===> (package (symbol-package symbol)) <===)")
@@ -291,7 +271,16 @@
"(apply 'eval-for-emacs &optional form ===> buffer-package <=== id &rest args)")
("(apply #'swank::eval-for-emacs foo *HERE*"
- "(apply #'eval-for-emacs &optional form ===> buffer-package <=== id &rest args)"))
+ "(apply #'eval-for-emacs &optional form ===> buffer-package <=== id &rest args)")
+
+ ("(swank::with-retry-restart (:msg *HERE*"
+ "(with-retry-restart (&key ===> (msg \"Retry.\") <===) &body body)")
+ ("(swank::start-server \"/tmp/foo\" :coding-system *HERE*"
+ "(start-server port-file &key (style swank:*communication-style*) (dont-close swank:*dont-close*) ===> (coding-system swank::*coding-system*) <===)")
+
+ ("(swank::with-struct *HERE*(foo. x y) *struct* body1)"
+ "(with-struct (conc-name &rest names) obj &body body)"
+ t))
(slime-check-top-level)
(with-temp-buffer
(setq slime-buffer-package "COMMON-LISP-USER")
@@ -300,8 +289,9 @@
(search-backward "*HERE*")
(delete-region (match-beginning 0) (match-end 0))
(slime-check-autodoc-at-point wished-arglist)
- (insert ")") (backward-char)
- (slime-check-autodoc-at-point wished-arglist)
+ (unless skip-trailing-test-p
+ (insert ")") (backward-char)
+ (slime-check-autodoc-at-point wished-arglist))
))
(provide 'slime-autodoc)
--- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/12/29 19:01:37 1.321
+++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/12/29 19:29:31 1.322
@@ -1,5 +1,29 @@
2009-12-29 Tobias C. Rittweiler <tcr at freebits.de>
+ More cleanup.
+
+ The RP swank:arglist-for-echo-area is now called swank:autodoc.
+
+ * swank-arglists.lisp (autodoc): Renamed from
+ arglist-for-echo-area.
+ (variable-desc-for-echo-area): Deleted. Above function subsumes
+ this functionality now.
+ (print-variable-to-string): Extracted from
+ variable-desc-for-echo-area.
+
+ * slime-autodoc.el (slime-retrieve-arglist): Change RPC.
+ (slime-make-autodoc-rpc-form): Ditto.
+ (slime-autodoc-cache-type): Deleted.
+ (slime-autodoc-cache): Deleted.
+ (slime-autodoc-last-buffer-form): Replacement.
+ (slime-autodoc-last-autodoc): Replacement.
+ (slime-get-cached-autodoc): Adapted accordingly.
+ (slime-store-into-autodoc-cache): Adapted accordingly.
+ (slime-compute-autodoc): Simplified slightly.
+ (autodoc.1 [test]): Extended.
+
+2009-12-29 Tobias C. Rittweiler <tcr at freebits.de>
+
Some cleanup of arglist code.
* swank-arglists.lisp (remove-from-tree-if): Deleted.
More information about the slime-cvs
mailing list