sly-autodoc.el (6490B)
1 ;;; -*-lexical-binding:t-*- 2 ;;; (require 'sly) 3 (require 'eldoc) 4 (require 'cl-lib) 5 (require 'sly-parse "lib/sly-parse") 6 7 (define-sly-contrib sly-autodoc 8 "Show fancy arglist in echo area." 9 (:license "GPL") 10 (:authors "Luke Gorrie <luke@bluetail.com>" 11 "Lawrence Mitchell <wence@gmx.li>" 12 "Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>" 13 "Tobias C. Rittweiler <tcr@freebits.de>") 14 (:slynk-dependencies slynk/arglists) 15 (:on-load (add-hook 'sly-editing-mode-hook 'sly-autodoc-mode) 16 (add-hook 'sly-mrepl-mode-hook 'sly-autodoc-mode) 17 (add-hook 'sly-minibuffer-setup-hook 'sly-autodoc-mode)) 18 (:on-unload (remove-hook 'sly-editing-mode-hook 'sly-autodoc-mode) 19 (remove-hook 'sly-mrepl-mode-hook 'sly-autodoc-mode) 20 (remove-hook 'sly-minibuffer-setup-hook 'sly-autodoc-mode))) 21 22 (defcustom sly-autodoc-accuracy-depth 10 23 "Number of paren levels that autodoc takes into account for 24 context-sensitive arglist display (local functions. etc)" 25 :type 'integer 26 :group 'sly-ui) 27 28 29 30 (defun sly-arglist (name) 31 "Show the argument list for NAME." 32 (interactive (list (sly-read-symbol-name "Arglist of: " t))) 33 (let ((arglist (sly-autodoc--retrieve-arglist name))) 34 (if (eq arglist :not-available) 35 (error "Arglist not available") 36 (message "%s" (sly-autodoc--fontify arglist))))) 37 38 (defun sly-autodoc--retrieve-arglist (name) 39 (let ((name (cl-etypecase name 40 (string name) 41 (symbol (symbol-name name))))) 42 (car (sly-eval `(slynk:autodoc '(,name ,sly-cursor-marker)))))) 43 44 (defun sly-autodoc-manually () 45 "Like autodoc information forcing multiline display." 46 (interactive) 47 (let ((doc (sly-autodoc t))) 48 (cond (doc (eldoc-message (format "%s" doc))) 49 (t (eldoc-message nil))))) 50 51 ;; Must call eldoc-add-command otherwise (eldoc-display-message-p) 52 ;; returns nil and eldoc clears the echo area instead. 53 (eldoc-add-command 'sly-autodoc-manually) 54 55 (defun sly-autodoc-space (n) 56 "Like `sly-space' but nicer." 57 (interactive "p") 58 (self-insert-command n) 59 (let ((doc (sly-autodoc))) 60 (when doc 61 (eldoc-message (format "%s" doc))))) 62 63 (eldoc-add-command 'sly-autodoc-space) 64 65 66 ;;;; Autodoc cache 67 68 (defvar sly-autodoc--cache-last-context nil) 69 (defvar sly-autodoc--cache-last-autodoc nil) 70 71 72 ;;;; Formatting autodoc 73 74 (defsubst sly-autodoc--canonicalize-whitespace (string) 75 (replace-regexp-in-string "[ \n\t]+" " " string)) 76 77 (defvar sly-autodoc-preamble nil) 78 79 (defun sly-autodoc--format (doc multilinep) 80 (let* ((strings (delete nil 81 (list sly-autodoc-preamble 82 (and doc 83 (sly-autodoc--fontify doc))))) 84 (message (and strings (mapconcat #'identity strings "\n")))) 85 (when message 86 (cond (multilinep message) 87 (t (sly-oneliner (sly-autodoc--canonicalize-whitespace message))))))) 88 89 (defun sly-autodoc--fontify (string) 90 "Fontify STRING as `font-lock-mode' does in Lisp mode." 91 (with-current-buffer (get-buffer-create (sly-buffer-name :fontify :hidden t)) 92 (erase-buffer) 93 (unless (eq major-mode 'lisp-mode) 94 ;; Just calling (lisp-mode) will turn sly-mode on in that buffer, 95 ;; which may interfere with this function 96 (setq major-mode 'lisp-mode) 97 (lisp-mode-variables t)) 98 (insert string) 99 (let ((font-lock-verbose nil)) 100 (font-lock-fontify-buffer)) 101 (goto-char (point-min)) 102 (when (re-search-forward "===> \\(\\(.\\|\n\\)*\\) <===" nil t) 103 (let ((highlight (match-string 1))) 104 ;; Can't use (replace-match highlight) here -- broken in Emacs 21 105 (delete-region (match-beginning 0) (match-end 0)) 106 (sly-insert-propertized '(face eldoc-highlight-function-argument) 107 highlight))) 108 (buffer-substring (point-min) (point-max)))) 109 110 111 ;;;; Autodocs (automatic context-sensitive help) 112 113 (defun sly-autodoc (&optional force-multiline) 114 "Returns the cached arglist information as string, or nil. 115 If it's not in the cache, the cache will be updated asynchronously." 116 (interactive "P") 117 (save-excursion 118 (save-match-data 119 ;; See github#385 and 120 ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=45117 121 (let* ((inhibit-quit t) 122 (context 123 (cons 124 (sly-current-connection) 125 (sly-autodoc--parse-context)))) 126 (when (car context) 127 (let* ((cached (and (equal context sly-autodoc--cache-last-context) 128 sly-autodoc--cache-last-autodoc)) 129 (multilinep (or force-multiline 130 eldoc-echo-area-use-multiline-p))) 131 (cond (cached (sly-autodoc--format cached multilinep)) 132 (t 133 (when (sly-background-activities-enabled-p) 134 (sly-autodoc--async context multilinep)) 135 nil)))))))) 136 137 ;; Return the context around point that can be passed to 138 ;; slynk:autodoc. nil is returned if nothing reasonable could be 139 ;; found. 140 (defun sly-autodoc--parse-context () 141 (and (not (sly-inside-string-or-comment-p)) 142 (sly-parse-form-upto-point sly-autodoc-accuracy-depth))) 143 144 (defun sly-autodoc--async (context multilinep) 145 (sly-eval-async 146 `(slynk:autodoc ',(cdr context) ;; FIXME: misuse of quote 147 :print-right-margin ,(window-width (minibuffer-window))) 148 (sly-curry #'sly-autodoc--async% context multilinep))) 149 150 (defun sly-autodoc--async% (context multilinep doc) 151 (cl-destructuring-bind (doc &optional cache-p) doc 152 (unless (eq doc :not-available) 153 (when cache-p 154 (setq sly-autodoc--cache-last-context context) 155 (setq sly-autodoc--cache-last-autodoc doc)) 156 ;; Now that we've got our information, 157 ;; get it to the user ASAP. 158 (when (eldoc-display-message-p) 159 (eldoc-message (format "%s" (sly-autodoc--format doc multilinep))))))) 160 161 162 ;;; Minor mode definition 163 (defvar sly-autodoc-mode-map 164 (let ((map (make-sparse-keymap))) 165 (define-key map (kbd "C-c C-d A") 'sly-autodoc) 166 map)) 167 168 (define-minor-mode sly-autodoc-mode 169 "Toggle echo area display of Lisp objects at point." 170 nil nil nil 171 (cond (sly-autodoc-mode 172 (set (make-local-variable 'eldoc-documentation-function) 'sly-autodoc) 173 (set (make-local-variable 'eldoc-minor-mode-string) "") 174 (eldoc-mode sly-autodoc-mode)) 175 (t 176 (eldoc-mode -1) 177 (set (make-local-variable 'eldoc-documentation-function) nil) 178 (set (make-local-variable 'eldoc-minor-mode-string) " ElDoc")))) 179 180 (provide 'sly-autodoc)