216 lines
7.3 KiB
EmacsLisp
216 lines
7.3 KiB
EmacsLisp
(require 'slime)
|
||
(require 'eldoc)
|
||
(require 'cl-lib)
|
||
(require 'slime-parse)
|
||
|
||
(define-slime-contrib slime-autodoc
|
||
"Show fancy arglist in echo area."
|
||
(:license "GPL")
|
||
(:authors "Luke Gorrie <luke@bluetail.com>"
|
||
"Lawrence Mitchell <wence@gmx.li>"
|
||
"Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>"
|
||
"Tobias C. Rittweiler <tcr@freebits.de>")
|
||
(:slime-dependencies slime-parse)
|
||
(:swank-dependencies swank-arglists)
|
||
(:on-load (slime-autodoc--enable))
|
||
(:on-unload (slime-autodoc--disable)))
|
||
|
||
(defcustom slime-autodoc-accuracy-depth 10
|
||
"Number of paren levels that autodoc takes into account for
|
||
context-sensitive arglist display (local functions. etc)"
|
||
:type 'integer
|
||
:group 'slime-ui)
|
||
|
||
;;;###autoload
|
||
(defcustom slime-autodoc-mode-string (purecopy " adoc")
|
||
"String to display in mode line when Autodoc Mode is enabled; nil for none."
|
||
:type '(choice string (const :tag "None" nil))
|
||
:group 'slime-ui)
|
||
|
||
|
||
|
||
(defun slime-arglist (name)
|
||
"Show the argument list for NAME."
|
||
(interactive (list (slime-read-symbol-name "Arglist of: " t)))
|
||
(let ((arglist (slime-retrieve-arglist name)))
|
||
(if (eq arglist :not-available)
|
||
(error "Arglist not available")
|
||
(message "%s" (slime-autodoc--fontify arglist)))))
|
||
|
||
;; used also in slime-c-p-c.el.
|
||
(defun slime-retrieve-arglist (name)
|
||
(let ((name (cl-etypecase name
|
||
(string name)
|
||
(symbol (symbol-name name)))))
|
||
(car (slime-eval `(swank:autodoc '(,name ,slime-cursor-marker))))))
|
||
|
||
(defun slime-autodoc-manually ()
|
||
"Like autodoc informtion forcing multiline display."
|
||
(interactive)
|
||
(let ((doc (slime-autodoc t)))
|
||
(cond (doc (eldoc-message doc))
|
||
(t (eldoc-message nil)))))
|
||
|
||
;; Must call eldoc-add-command otherwise (eldoc-display-message-p)
|
||
;; returns nil and eldoc clears the echo area instead.
|
||
(eldoc-add-command 'slime-autodoc-manually)
|
||
|
||
(defun slime-autodoc-space (n)
|
||
"Like `slime-space' but nicer."
|
||
(interactive "p")
|
||
(self-insert-command n)
|
||
(let ((doc (slime-autodoc)))
|
||
(when doc
|
||
(eldoc-message doc))))
|
||
|
||
(eldoc-add-command 'slime-autodoc-space)
|
||
|
||
|
||
;;;; Autodoc cache
|
||
|
||
(defvar slime-autodoc--cache-last-context nil)
|
||
(defvar slime-autodoc--cache-last-autodoc nil)
|
||
|
||
(defun slime-autodoc--cache-get (context)
|
||
"Return the cached autodoc documentation for `context', or nil."
|
||
(and (equal context slime-autodoc--cache-last-context)
|
||
slime-autodoc--cache-last-autodoc))
|
||
|
||
(defun slime-autodoc--cache-put (context autodoc)
|
||
"Update the autodoc cache for CONTEXT with AUTODOC."
|
||
(setq slime-autodoc--cache-last-context context)
|
||
(setq slime-autodoc--cache-last-autodoc autodoc))
|
||
|
||
|
||
;;;; Formatting autodoc
|
||
|
||
(defsubst slime-autodoc--canonicalize-whitespace (string)
|
||
(replace-regexp-in-string "[ \n\t]+" " " string))
|
||
|
||
(defun slime-autodoc--format (doc multilinep)
|
||
(let ((doc (slime-autodoc--fontify doc)))
|
||
(cond (multilinep doc)
|
||
(t (slime-oneliner (slime-autodoc--canonicalize-whitespace doc))))))
|
||
|
||
(defun slime-autodoc--fontify (string)
|
||
"Fontify STRING as `font-lock-mode' does in Lisp mode."
|
||
(with-current-buffer (get-buffer-create (slime-buffer-name :fontify 'hidden))
|
||
(erase-buffer)
|
||
(unless (eq major-mode 'lisp-mode)
|
||
;; Just calling (lisp-mode) will turn slime-mode on in that buffer,
|
||
;; which may interfere with this function
|
||
(setq major-mode 'lisp-mode)
|
||
(lisp-mode-variables t))
|
||
(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 eldoc-highlight-function-argument) highlight)))
|
||
(buffer-substring (point-min) (point-max))))
|
||
|
||
(define-obsolete-function-alias 'slime-fontify-string
|
||
'slime-autodoc--fontify
|
||
"SLIME 2.10")
|
||
|
||
|
||
;;;; Autodocs (automatic context-sensitive help)
|
||
|
||
(defun slime-autodoc (&optional force-multiline)
|
||
"Returns the cached arglist information as string, or nil.
|
||
If it's not in the cache, the cache will be updated asynchronously."
|
||
(save-excursion
|
||
(save-match-data
|
||
(let ((context (slime-autodoc--parse-context)))
|
||
(when context
|
||
(let* ((cached (slime-autodoc--cache-get context))
|
||
(multilinep (or force-multiline
|
||
eldoc-echo-area-use-multiline-p)))
|
||
(cond (cached (slime-autodoc--format cached multilinep))
|
||
(t
|
||
(when (slime-background-activities-enabled-p)
|
||
(slime-autodoc--async context multilinep))
|
||
nil))))))))
|
||
|
||
;; Return the context around point that can be passed to
|
||
;; swank:autodoc. nil is returned if nothing reasonable could be
|
||
;; found.
|
||
(defun slime-autodoc--parse-context ()
|
||
(and (slime-autodoc--parsing-safe-p)
|
||
(let ((levels slime-autodoc-accuracy-depth))
|
||
(slime-parse-form-upto-point levels))))
|
||
|
||
(defun slime-autodoc--parsing-safe-p ()
|
||
(cond ((fboundp 'slime-repl-inside-string-or-comment-p)
|
||
(not (slime-repl-inside-string-or-comment-p)))
|
||
(t
|
||
(not (slime-inside-string-or-comment-p)))))
|
||
|
||
(defun slime-autodoc--async (context multilinep)
|
||
(slime-eval-async
|
||
`(swank:autodoc ',context ;; FIXME: misuse of quote
|
||
:print-right-margin ,(window-width (minibuffer-window)))
|
||
(slime-curry #'slime-autodoc--async% context multilinep)))
|
||
|
||
(defun slime-autodoc--async% (context multilinep doc)
|
||
(cl-destructuring-bind (doc &optional cache-p) doc
|
||
(unless (eq doc :not-available)
|
||
(when cache-p
|
||
(slime-autodoc--cache-put context doc))
|
||
;; Now that we've got our information,
|
||
;; get it to the user ASAP.
|
||
(when (eldoc-display-message-p)
|
||
(eldoc-message (slime-autodoc--format doc multilinep))))))
|
||
|
||
|
||
;;; Minor mode definition
|
||
|
||
;; Compute the prefix for slime-doc-map, usually this is C-c C-d.
|
||
(defun slime-autodoc--doc-map-prefix ()
|
||
(concat
|
||
(car (rassoc '(slime-prefix-map) slime-parent-bindings))
|
||
(car (rassoc '(slime-doc-map) slime-prefix-bindings))))
|
||
|
||
(define-minor-mode slime-autodoc-mode
|
||
"Toggle echo area display of Lisp objects at point."
|
||
:lighter slime-autodoc-mode-string
|
||
:keymap (let ((prefix (slime-autodoc--doc-map-prefix)))
|
||
`((,(concat prefix "A") . slime-autodoc-manually)
|
||
(,(concat prefix (kbd "C-A")) . slime-autodoc-manually)
|
||
(,(kbd "SPC") . slime-autodoc-space)))
|
||
(set (make-local-variable 'eldoc-documentation-function) 'slime-autodoc)
|
||
(set (make-local-variable 'eldoc-minor-mode-string) nil)
|
||
(setq slime-autodoc-mode (eldoc-mode arg))
|
||
(when (called-interactively-p 'interactive)
|
||
(message "Slime autodoc mode %s."
|
||
(if slime-autodoc-mode "enabled" "disabled"))))
|
||
|
||
|
||
;;; Noise to enable/disable slime-autodoc-mode
|
||
|
||
(defun slime-autodoc--on () (slime-autodoc-mode 1))
|
||
(defun slime-autodoc--off () (slime-autodoc-mode 0))
|
||
|
||
(defvar slime-autodoc--relevant-hooks
|
||
'(slime-mode-hook slime-repl-mode-hook sldb-mode-hook))
|
||
|
||
(defun slime-autodoc--enable ()
|
||
(dolist (h slime-autodoc--relevant-hooks)
|
||
(add-hook h 'slime-autodoc--on))
|
||
(dolist (b (buffer-list))
|
||
(with-current-buffer b
|
||
(when slime-mode
|
||
(slime-autodoc--on)))))
|
||
|
||
(defun slime-autodoc--disable ()
|
||
(dolist (h slime-autodoc--relevant-hooks)
|
||
(remove-hook h 'slime-autodoc--on))
|
||
(dolist (b (buffer-list))
|
||
(with-current-buffer b
|
||
(when slime-autodoc-mode
|
||
(slime-autodoc--off)))))
|
||
|
||
(provide 'slime-autodoc)
|