[slime-cvs] CVS slime/contrib
CVS User trittweiler
trittweiler at common-lisp.net
Thu Jan 1 15:54:30 UTC 2009
Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv4642/contrib
Modified Files:
slime-autodoc.el ChangeLog
Log Message:
* slime-autodoc.el: Autodoc is now implemented on top of ElDoc.
(Suggested by Madhu.)
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2008/09/07 12:44:11 1.10
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2009/01/01 15:54:30 1.11
@@ -19,26 +19,21 @@
(require 'slime-parse)
(require 'slime-enclosing-context)
-(defvar slime-use-autodoc-mode t
+(defcustom slime-use-autodoc-mode t
"When non-nil always enable slime-autodoc-mode in slime-mode.")
-(defun slime-fontify-string (string)
- "Fontify STRING as `font-lock-mode' does in Lisp mode."
- (with-current-buffer (get-buffer-create " *slime-fontify*")
- (erase-buffer)
- (if (not (eq major-mode 'lisp-mode))
- (lisp-mode))
- (insert string)
- (let ((font-lock-verbose nil))
- (font-lock-fontify-buffer))
- (goto-char (point-min))
- (when (re-search-forward "===> \\(\\(.\\|\n\\)*\\) <===" nil t)
- (let ((highlight (match-string 1)))
- ;; Can't use (replace-match highlight) here -- broken in Emacs 21
- (delete-region (match-beginning 0) (match-end 0))
- (slime-insert-propertized '(face highlight) highlight)))
- (buffer-substring (point-min) (point-max))))
+(defcustom slime-autodoc-use-multiline-p nil
+ "If non-nil, allow long autodoc messages to resize echo area display."
+ :type 'boolean
+ :group 'slime-ui)
+
+(defcustom slime-autodoc-delay 0.2
+ "*Delay before autodoc messages are fetched and displayed, in seconds."
+ :type 'number
+ :group 'slime-ui)
+
+;;; FIXME: unused?
(defun slime-arglist (name)
"Show the argument list for NAME."
(interactive (list (slime-read-symbol-name "Arglist of: ")))
@@ -49,98 +44,9 @@
(message "%s" (slime-fontify-string arglist))
(error "Arglist not available")))))
-
;;;; Autodocs (automatic context-sensitive help)
-(defvar slime-autodoc-mode nil
- "*When non-nil, print documentation about symbols as the point moves.")
-
-(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-autodoc-mode (&optional arg)
- "Enable `slime-autodoc'."
- (interactive "P")
- (cond ((< (prefix-numeric-value arg) 0) (setq slime-autodoc-mode nil))
- (arg (setq slime-autodoc-mode t))
- (t (setq slime-autodoc-mode (not slime-autodoc-mode))))
- (if slime-autodoc-mode
- (progn
- (slime-autodoc-start-timer)
- (add-hook 'pre-command-hook
- 'slime-autodoc-pre-command-refresh-echo-area t))
- (slime-autodoc-stop-timer)))
-
-(defvar slime-autodoc-last-message "")
-
-(defun slime-autodoc ()
- "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)
- ;; Asynchronously fetch, cache, and display documentation
- (slime-eval-async
- retrieve-form
- (slime-rcurry
- (lambda (doc cache-key)
- (let ((doc (if doc (slime-fontify-string doc) "")))
- (slime-update-autodoc-cache cache-key doc)
- (slime-autodoc-message doc)))
- cache-key))))))
-
-(defcustom slime-autodoc-use-multiline-p nil
- "If non-nil, allow long autodoc messages to resize echo area display."
- :type 'boolean
- :group 'slime-ui)
-
-(defvar slime-autodoc-message-function 'slime-autodoc-show-message)
-
-(defun slime-autodoc-message (doc)
- "Display the autodoc documentation string DOC."
- (funcall slime-autodoc-message-function doc))
-
-(defun slime-autodoc-show-message (doc)
- (unless slime-autodoc-use-multiline-p
- (setq doc (slime-oneliner doc)))
- (setq slime-autodoc-last-message doc)
- (message "%s" doc))
-
-(defvar slime-autodoc-dimensions-function nil)
-
-(defun slime-autodoc-message-dimensions ()
- "Return the available width and height for pretty printing autodoc
-messages."
- (cond
- (slime-autodoc-dimensions-function
- (funcall slime-autodoc-dimensions-function))
- (slime-autodoc-use-multiline-p
- ;; Use the full width of the minibuffer;
- ;; minibuffer will grow vertically if necessary
- (values (window-width (minibuffer-window))
- nil))
- (t
- ;; Try to fit everything in one line; we cut off when displaying
- (values 1000 1))))
-
-(defun slime-autodoc-pre-command-refresh-echo-area ()
- (unless (string= slime-autodoc-last-message "")
- (if (slime-autodoc-message-ok-p)
- (message "%s" slime-autodoc-last-message)
- (setq slime-autodoc-last-message ""))))
-
(defun slime-autodoc-thing-at-point ()
"Return a cache key and a swank form."
(let ((global (slime-autodoc-global-at-point)))
@@ -201,6 +107,39 @@
(when-let (pos (position cur-op-name bound-fn-names :test 'equal))
(nth pos arglists)))))
+(defvar slime-autodoc-dimensions-function nil)
+
+(defun slime-autodoc-message-dimensions ()
+ "Return the available width and height for pretty printing autodoc
+messages."
+ (cond
+ (slime-autodoc-dimensions-function
+ (funcall slime-autodoc-dimensions-function))
+ (slime-autodoc-use-multiline-p
+ ;; Use the full width of the minibuffer;
+ ;; minibuffer will grow vertically if necessary
+ (values (window-width (minibuffer-window))
+ nil))
+ (t
+ ;; Try to fit everything in one line; we cut off when displaying
+ (values 1000 1))))
+
+
+;;;; 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."
@@ -213,7 +152,7 @@
(when-let (symbol (intern-soft symbol-name))
(get symbol 'slime-autodoc-cache)))))
-(defun slime-update-autodoc-cache (symbol-name documentation)
+(defun slime-store-into-autodoc-cache (symbol-name documentation)
"Update the autodoc cache for SYMBOL with DOCUMENTATION.
Return DOCUMENTATION."
(ecase slime-autodoc-cache-type
@@ -225,61 +164,83 @@
documentation)
-;;;;; Asynchronous message idle timer
+;;;; Formatting autodoc
-(defvar slime-autodoc-idle-timer nil
- "Idle timer for the next autodoc message.")
+(defun slime-format-autodoc (doc)
+ (setq doc (slime-fontify-string doc))
+ (unless slime-autodoc-use-multiline-p
+ (setq doc (slime-oneliner doc)))
+ doc)
-(defvar slime-autodoc-delay 0.2
- "*Delay before autodoc messages are fetched and displayed, in seconds.")
+(defun slime-fontify-string (string)
+ "Fontify STRING as `font-lock-mode' does in Lisp mode."
+ (with-current-buffer (get-buffer-create " *slime-fontify*")
+ (erase-buffer)
+ (if (not (eq major-mode 'lisp-mode))
+ (lisp-mode))
+ (insert string)
+ (let ((font-lock-verbose nil))
+ (font-lock-fontify-buffer))
+ (goto-char (point-min))
+ (when (re-search-forward "===> \\(\\(.\\|\n\\)*\\) <===" nil t)
+ (let ((highlight (match-string 1)))
+ ;; Can't use (replace-match highlight) here -- broken in Emacs 21
+ (delete-region (match-beginning 0) (match-end 0))
+ (slime-insert-propertized '(face highlight) highlight)))
+ (buffer-substring (point-min) (point-max))))
+
+
+;;;; slime-autodoc-mode
+
+(defun slime-compute-autodoc ()
+ "Returns the cached arglist information as string, or nil.
+If it's not in the cache, the cache will be updated asynchronously."
+ (multiple-value-bind (cache-key retrieve-form) (slime-autodoc-thing-at-point)
+ (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 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))
+
+(defun slime-autodoc-mode (&optional arg)
+ (interactive "P")
+ (make-local-variable 'eldoc-documentation-function)
+ (make-local-variable 'eldoc-idle-delay)
+ (setq eldoc-documentation-function 'slime-compute-autodoc)
+ (setq eldoc-idle-delay slime-autodoc-delay)
+ (if (eldoc-mode arg)
+ (progn
+ (setq slime-echo-arglist-function
+ #'(lambda () (eldoc-message (slime-compute-autodoc))))
+ (setq slime-autodoc-mode t))
+ (progn
+ (setq slime-echo-arglist-function 'slime-show-arglist)
+ (setq slime-autodoc-mode nil))))
-(defun slime-autodoc-start-timer ()
- "(Re)start the timer that prints autodocs every `slime-autodoc-delay' seconds."
- (interactive)
- (when slime-autodoc-idle-timer
- (cancel-timer slime-autodoc-idle-timer))
- (setq slime-autodoc-idle-timer
- (run-with-idle-timer slime-autodoc-delay slime-autodoc-delay
- 'slime-autodoc-timer-hook)))
-
-(defun slime-autodoc-stop-timer ()
- "Stop the timer that prints autodocs.
-See also `slime-autodoc-start-timer'."
- (when slime-autodoc-idle-timer
- (cancel-timer slime-autodoc-idle-timer)
- (setq slime-autodoc-idle-timer nil)))
-
-(defun slime-autodoc-timer-hook ()
- "Function to be called after each Emacs becomes idle.
-When `slime-autodoc-mode' is non-nil, print apropos information about
-the symbol at point if applicable."
- (when (slime-autodoc-message-ok-p)
- (condition-case err
- (slime-autodoc)
- (error
- (setq slime-autodoc-mode nil)
- (message "Error: %S; slime-autodoc-mode now disabled." err)))))
-
-(defun slime-autodoc-message-ok-p ()
- "Return true if printing a message is currently okay (shouldn't
-annoy the user)."
- (and (or slime-mode (eq major-mode 'slime-repl-mode)
- (eq major-mode 'sldb-mode))
- slime-autodoc-mode
- (or (null (current-message))
- (string= (current-message) slime-autodoc-last-message))
- (not executing-kbd-macro)
- (not (and (boundp 'edebug-active) (symbol-value 'edebug-active)))
- (not cursor-in-echo-area)
- (not (active-minibuffer-window))
- (not (eq (selected-window) (minibuffer-window)))
- (slime-background-activities-enabled-p)))
+(defadvice eldoc-display-message-no-interference-p
+ (after slime-autodoc-message-ok-p)
+ (when slime-autodoc-mode
+ (setq ad-return-value
+ (and ad-return-value
+ (not (active-minibuffer-window))
+ (slime-background-activities-enabled-p))))
+ ad-return-value)
-;;; Initialization
+;;;; Initialization
(defun slime-autodoc-init ()
- (setq slime-echo-arglist-function 'slime-autodoc)
(dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook))
(add-hook h 'slime-autodoc-maybe-enable)))
@@ -287,6 +248,7 @@
(when slime-use-autodoc-mode
(slime-autodoc-mode 1)))
+;;; FIXME: This doesn't disable eldoc-mode in existing buffers.
(defun slime-autodoc-unload ()
(setq slime-echo-arglist-function 'slime-show-arglist)
(dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook))
--- /project/slime/cvsroot/slime/contrib/ChangeLog 2008/12/31 16:55:26 1.160
+++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/01/01 15:54:30 1.161
@@ -1,3 +1,8 @@
+2009-01-01 Tobias C. Rittweiler <tcr at freebits.de>
+
+ * slime-autodoc.el: Autodoc is now implemented on top of ElDoc.
+ (Suggested by Madhu.)
+
2008-12-31 Tobias C. Rittweiler <tcr at freebits.de>
* swank-arglists.lisp (format-arglist-for-echo-area): Catch errors
More information about the slime-cvs
mailing list