Klimi's new dotfiles with stow.
No puede seleccionar más de 25 temas Los temas deben comenzar con una letra o número, pueden incluir guiones ('-') y pueden tener hasta 35 caracteres de largo.

481 líneas
21 KiB

hace 4 años
  1. ;;; cider-eldoc.el --- eldoc support for Clojure -*- lexical-binding: t -*-
  2. ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov
  3. ;; Copyright © 2013-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors
  4. ;;
  5. ;; Author: Tim King <kingtim@gmail.com>
  6. ;; Phil Hagelberg <technomancy@gmail.com>
  7. ;; Bozhidar Batsov <bozhidar@batsov.com>
  8. ;; Artur Malabarba <bruce.connor.am@gmail.com>
  9. ;; Hugo Duncan <hugo@hugoduncan.org>
  10. ;; Steve Purcell <steve@sanityinc.com>
  11. ;; This program is free software: you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation, either version 3 of the License, or
  14. ;; (at your option) any later version.
  15. ;; This program is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  18. ;; GNU General Public License for more details.
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  21. ;; This file is not part of GNU Emacs.
  22. ;;; Commentary:
  23. ;; eldoc support for Clojure.
  24. ;;; Code:
  25. (require 'cider-client)
  26. (require 'cider-common) ; for cider-symbol-at-point
  27. (require 'subr-x)
  28. (require 'cider-compat)
  29. (require 'cider-util)
  30. (require 'nrepl-dict)
  31. (require 'seq)
  32. (require 'eldoc)
  33. (defvar cider-extra-eldoc-commands '("yas-expand")
  34. "Extra commands to be added to eldoc's safe commands list.")
  35. (defcustom cider-eldoc-max-num-sexps-to-skip 30
  36. "The maximum number of sexps to skip while searching the beginning of current sexp."
  37. :type 'integer
  38. :group 'cider
  39. :package-version '(cider . "0.10.1"))
  40. (defvar-local cider-eldoc-last-symbol nil
  41. "The eldoc information for the last symbol we checked.")
  42. (defcustom cider-eldoc-ns-function #'identity
  43. "A function that returns a ns string to be used by eldoc.
  44. Takes one argument, a namespace name.
  45. For convenience, some functions are already provided for this purpose:
  46. `cider-abbreviate-ns', and `cider-last-ns-segment'."
  47. :type '(choice (const :tag "Full namespace" identity)
  48. (const :tag "Abbreviated namespace" cider-abbreviate-ns)
  49. (const :tag "Last name in namespace" cider-last-ns-segment)
  50. (function :tag "Custom function"))
  51. :group 'cider
  52. :package-version '(cider . "0.13.0"))
  53. (defcustom cider-eldoc-max-class-names-to-display 3
  54. "The maximum number of classes to display in an eldoc string.
  55. An eldoc string for Java interop forms can have a number of classes prefixed to
  56. it, when the form belongs to more than 1 class. When, not nil we only display
  57. the names of first `cider-eldoc-max-class-names-to-display' classes and add
  58. a \"& x more\" suffix. Otherwise, all the classes are displayed."
  59. :type 'integer
  60. :safe #'integerp
  61. :group 'cider
  62. :package-version '(cider . "0.13.0"))
  63. (defcustom cider-eldoc-display-for-symbol-at-point t
  64. "When non-nil, display eldoc for symbol at point if available.
  65. So in (map inc ...) when the cursor is over inc its eldoc would be
  66. displayed. When nil, always display eldoc for first symbol of the sexp."
  67. :type 'boolean
  68. :safe #'booleanp
  69. :group 'cider
  70. :package-version '(cider . "0.13.0"))
  71. (defcustom cider-eldoc-display-context-dependent-info nil
  72. "When non-nil, display context dependent info in the eldoc where possible.
  73. CIDER will try to add expected function arguments based on the current context,
  74. for example for the datomic.api/q function where it will show the expected
  75. inputs of the query at point."
  76. :type 'boolean
  77. :group 'cider
  78. :package-version '(cider . "0.15.0"))
  79. (defun cider--eldoc-format-class-names (class-names)
  80. "Return a formatted CLASS-NAMES prefix string.
  81. CLASS-NAMES is a list of classes to which a Java interop form belongs.
  82. Only keep the first `cider-eldoc-max-class-names-to-display' names, and
  83. add a \"& x more\" suffix. Return nil if the CLASS-NAMES list is empty or
  84. mapping `cider-eldoc-ns-function' on it returns an empty list."
  85. (when-let* ((eldoc-class-names (seq-remove #'null (mapcar (apply-partially cider-eldoc-ns-function) class-names)))
  86. (eldoc-class-names-length (length eldoc-class-names)))
  87. (cond
  88. ;; truncate class-names list and then format it
  89. ((and cider-eldoc-max-class-names-to-display
  90. (> eldoc-class-names-length cider-eldoc-max-class-names-to-display))
  91. (format "(%s & %s more)"
  92. (thread-first eldoc-class-names
  93. (seq-take cider-eldoc-max-class-names-to-display)
  94. (string-join " ")
  95. (cider-propertize 'ns))
  96. (- eldoc-class-names-length cider-eldoc-max-class-names-to-display)))
  97. ;; format the whole list but add surrounding parentheses
  98. ((> eldoc-class-names-length 1)
  99. (format "(%s)"
  100. (thread-first eldoc-class-names
  101. (string-join " ")
  102. (cider-propertize 'ns))))
  103. ;; don't add the parentheses
  104. (t (format "%s" (car eldoc-class-names))))))
  105. (defun cider-eldoc-format-thing (ns symbol thing type)
  106. "Format the eldoc subject defined by NS, SYMBOL, THING and TYPE.
  107. THING represents the thing at point which triggered eldoc. Normally NS and
  108. SYMBOL are used (they are derived from THING), but when empty we fallback to
  109. THING (e.g. for Java methods). Format it as a function, if FUNCTION-P
  110. is non-nil. Else format it as a variable."
  111. (if-let* ((method-name (if (and symbol (not (string= symbol "")))
  112. symbol
  113. thing))
  114. (propertized-method-name (cider-propertize method-name type))
  115. (ns-or-class (if (and ns (stringp ns))
  116. (funcall cider-eldoc-ns-function ns)
  117. (cider--eldoc-format-class-names ns))))
  118. (format "%s/%s"
  119. ;; we set font-lock properties of classes in `cider--eldoc-format-class-names'
  120. ;; to avoid font locking the parentheses and "& x more"
  121. ;; so we only propertize ns-or-class if not already done
  122. (if (get-text-property 1 'face ns-or-class)
  123. ;; it is already propertized
  124. ns-or-class
  125. (cider-propertize ns-or-class 'ns))
  126. propertized-method-name)
  127. ;; in case ns-or-class is nil
  128. propertized-method-name))
  129. (defun cider-eldoc-format-sym-doc (var ns docstring)
  130. "Return the formatted eldoc string for VAR and DOCSTRING.
  131. Consider the value of `eldoc-echo-area-use-multiline-p' while formatting.
  132. If the entire line cannot fit in the echo area, the var name may be
  133. truncated or eliminated entirely from the output to make room for the
  134. description.
  135. Try to truncate the var with various strategies, so that the var and
  136. the docstring can be displayed in the minibuffer without resizing the window.
  137. We start with `cider-abbreviate-ns' and `cider-last-ns-segment'.
  138. Next, if the var is in current namespace, we remove NS from the eldoc string.
  139. Otherwise, only the docstring is returned."
  140. (let* ((ea-multi eldoc-echo-area-use-multiline-p)
  141. ;; Subtract 1 from window width since emacs will not write
  142. ;; any chars to the last column, or in later versions, will
  143. ;; cause a wraparound and resize of the echo area.
  144. (ea-width (1- (window-width (minibuffer-window))))
  145. (strip (- (+ (length var) (length docstring)) ea-width))
  146. (newline (string-match-p "\n" docstring))
  147. ;; Truncated var can be ea-var long
  148. ;; Subtract 2 to account for the : and / added when including
  149. ;; the namespace prefixed form in eldoc string
  150. (ea-var (- (- ea-width (length docstring)) 2)))
  151. (cond
  152. ((or (eq ea-multi t)
  153. (and (<= strip 0) (null newline))
  154. (and ea-multi (or (> (length docstring) ea-width) newline)))
  155. (format "%s: %s" var docstring))
  156. ;; Now we have to truncate either the docstring or the var
  157. (newline (cider-eldoc-format-sym-doc var ns (substring docstring 0 newline)))
  158. ;; Only return the truncated docstring
  159. ((> (length docstring) ea-width)
  160. (substring docstring 0 ea-width))
  161. ;; Try to truncate the var with cider-abbreviate-ns
  162. ((<= (length (cider-abbreviate-ns var)) ea-var)
  163. (format "%s: %s" (cider-abbreviate-ns var) docstring))
  164. ;; Try to truncate var with cider-last-ns-segment
  165. ((<= (length (cider-last-ns-segment var)) ea-var)
  166. (format "%s: %s" (cider-last-ns-segment var) docstring))
  167. ;; If the var is in current namespace, we try to truncate the var by
  168. ;; skipping the namespace from the returned eldoc string
  169. ((and (string-equal ns (cider-current-ns))
  170. (<= (- (length var) (length ns)) ea-var))
  171. (format "%s: %s"
  172. (replace-regexp-in-string (format "%s/" ns) "" var)
  173. docstring))
  174. ;; We couldn't fit the var and docstring in the available space,
  175. ;; so we just display the docstring
  176. (t docstring))))
  177. (defun cider-eldoc-format-variable (thing eldoc-info)
  178. "Return the formatted eldoc string for a variable.
  179. THING is the variable name. ELDOC-INFO is a p-list containing the eldoc
  180. information."
  181. (let* ((ns (lax-plist-get eldoc-info "ns"))
  182. (symbol (lax-plist-get eldoc-info "symbol"))
  183. (docstring (lax-plist-get eldoc-info "docstring"))
  184. (formatted-var (cider-eldoc-format-thing ns symbol thing 'var)))
  185. (when docstring
  186. (cider-eldoc-format-sym-doc formatted-var ns docstring))))
  187. (defun cider-eldoc-format-function (thing pos eldoc-info)
  188. "Return the formatted eldoc string for a function.
  189. THING is the function name. POS is the argument-index of the functions
  190. arglists. ELDOC-INFO is a p-list containing the eldoc information."
  191. (let ((ns (lax-plist-get eldoc-info "ns"))
  192. (symbol (lax-plist-get eldoc-info "symbol"))
  193. (arglists (lax-plist-get eldoc-info "arglists")))
  194. (format "%s: %s"
  195. (cider-eldoc-format-thing ns symbol thing 'fn)
  196. (cider-eldoc-format-arglist arglists pos))))
  197. (defun cider-highlight-args (arglist pos)
  198. "Format the the function ARGLIST for eldoc.
  199. POS is the index of the currently highlighted argument."
  200. (let* ((rest-pos (cider--find-rest-args-position arglist))
  201. (i 0))
  202. (mapconcat
  203. (lambda (arg)
  204. (let ((argstr (format "%s" arg)))
  205. (if (string= arg "&")
  206. argstr
  207. (prog1
  208. (if (or (= (1+ i) pos)
  209. (and rest-pos
  210. (> (1+ i) rest-pos)
  211. (> pos rest-pos)))
  212. (propertize argstr 'face
  213. 'eldoc-highlight-function-argument)
  214. argstr)
  215. (setq i (1+ i)))))) arglist " ")))
  216. (defun cider--find-rest-args-position (arglist)
  217. "Find the position of & in the ARGLIST vector."
  218. (seq-position arglist "&"))
  219. (defun cider-highlight-arglist (arglist pos)
  220. "Format the ARGLIST for eldoc.
  221. POS is the index of the argument to highlight."
  222. (concat "[" (cider-highlight-args arglist pos) "]"))
  223. (defun cider-eldoc-format-arglist (arglist pos)
  224. "Format all the ARGLIST for eldoc.
  225. POS is the index of current argument."
  226. (concat "("
  227. (mapconcat (lambda (args) (cider-highlight-arglist args pos))
  228. arglist
  229. " ")
  230. ")"))
  231. (defun cider-eldoc-beginning-of-sexp ()
  232. "Move to the beginning of current sexp.
  233. Return the number of nested sexp the point was over or after. Return nil
  234. if the maximum number of sexps to skip is exceeded."
  235. (let ((parse-sexp-ignore-comments t)
  236. (num-skipped-sexps 0))
  237. (condition-case _
  238. (progn
  239. ;; First account for the case the point is directly over a
  240. ;; beginning of a nested sexp.
  241. (condition-case _
  242. (let ((p (point)))
  243. (forward-sexp -1)
  244. (forward-sexp 1)
  245. (when (< (point) p)
  246. (setq num-skipped-sexps 1)))
  247. (error))
  248. (while
  249. (let ((p (point)))
  250. (forward-sexp -1)
  251. (when (< (point) p)
  252. (setq num-skipped-sexps
  253. (unless (and cider-eldoc-max-num-sexps-to-skip
  254. (>= num-skipped-sexps
  255. cider-eldoc-max-num-sexps-to-skip))
  256. ;; Without the above guard,
  257. ;; `cider-eldoc-beginning-of-sexp' could traverse the
  258. ;; whole buffer when the point is not within a
  259. ;; list. This behavior is problematic especially with
  260. ;; a buffer containing a large number of
  261. ;; non-expressions like a REPL buffer.
  262. (1+ num-skipped-sexps)))))))
  263. (error))
  264. num-skipped-sexps))
  265. (defun cider-eldoc-thing-type (eldoc-info)
  266. "Return the type of the ELDOC-INFO being displayed by eldoc.
  267. It can be a function or var now."
  268. (pcase (lax-plist-get eldoc-info "type")
  269. ("function" 'fn)
  270. ("variable" 'var)))
  271. (defun cider-eldoc-info-at-point ()
  272. "Return eldoc info at point.
  273. First go to the beginning of the sexp and check if the eldoc is to be
  274. considered (i.e sexp is a method call) and not a map or vector literal.
  275. Then go back to the point and return its eldoc."
  276. (save-excursion
  277. (unless (cider-in-comment-p)
  278. (let* ((current-point (point)))
  279. (cider-eldoc-beginning-of-sexp)
  280. (unless (member (or (char-before (point)) 0) '(?\" ?\{ ?\[))
  281. (goto-char current-point)
  282. (when-let* ((eldoc-info (cider-eldoc-info
  283. (cider--eldoc-remove-dot (cider-symbol-at-point)))))
  284. `("eldoc-info" ,eldoc-info
  285. "thing" ,(cider-symbol-at-point)
  286. "pos" 0)))))))
  287. (defun cider-eldoc-info-at-sexp-beginning ()
  288. "Return eldoc info for first symbol in the sexp."
  289. (save-excursion
  290. (when-let* ((beginning-of-sexp (cider-eldoc-beginning-of-sexp))
  291. ;; If we are at the beginning of function name, this will be -1
  292. (argument-index (max 0 (1- beginning-of-sexp))))
  293. (unless (or (memq (or (char-before (point)) 0)
  294. '(?\" ?\{ ?\[))
  295. (cider-in-comment-p))
  296. (when-let* ((eldoc-info (cider-eldoc-info
  297. (cider--eldoc-remove-dot (cider-symbol-at-point)))))
  298. `("eldoc-info" ,eldoc-info
  299. "thing" ,(cider-symbol-at-point)
  300. "pos" ,argument-index))))))
  301. (defun cider-eldoc-info-in-current-sexp ()
  302. "Return eldoc information from the sexp.
  303. If `cider-eldoc-display-for-symbol-at-poin' is non-nil and
  304. the symbol at point has a valid eldoc available, return that.
  305. Otherwise return the eldoc of the first symbol of the sexp."
  306. (or (when cider-eldoc-display-for-symbol-at-point
  307. (cider-eldoc-info-at-point))
  308. (cider-eldoc-info-at-sexp-beginning)))
  309. (defun cider-eldoc--convert-ns-keywords (thing)
  310. "Convert THING values that match ns macro keywords to function names."
  311. (pcase thing
  312. (":import" "clojure.core/import")
  313. (":refer-clojure" "clojure.core/refer-clojure")
  314. (":use" "clojure.core/use")
  315. (":refer" "clojure.core/refer")
  316. (_ thing)))
  317. (defun cider-eldoc-info (thing)
  318. "Return the info for THING.
  319. This includes the arglist and ns and symbol name (if available)."
  320. (let ((thing (cider-eldoc--convert-ns-keywords thing)))
  321. (when (and (cider-nrepl-op-supported-p "eldoc")
  322. thing
  323. ;; ignore empty strings
  324. (not (string= thing ""))
  325. ;; ignore strings
  326. (not (string-prefix-p "\"" thing))
  327. ;; ignore regular expressions
  328. (not (string-prefix-p "#" thing))
  329. ;; ignore chars
  330. (not (string-prefix-p "\\" thing))
  331. ;; ignore numbers
  332. (not (string-match-p "^[0-9]" thing)))
  333. ;; check if we can used the cached eldoc info
  334. (cond
  335. ;; handle keywords for map access
  336. ((string-prefix-p ":" thing) (list "symbol" thing
  337. "type" "function"
  338. "arglists" '(("map") ("map" "not-found"))))
  339. ;; handle Classname. by displaying the eldoc for new
  340. ((string-match-p "^[A-Z].+\\.$" thing) (list "symbol" thing
  341. "type" "function"
  342. "arglists" '(("args*"))))
  343. ;; generic case
  344. (t (if (equal thing (car cider-eldoc-last-symbol))
  345. (cadr cider-eldoc-last-symbol)
  346. (when-let* ((eldoc-info (cider-sync-request:eldoc thing)))
  347. (let* ((arglists (nrepl-dict-get eldoc-info "eldoc"))
  348. (docstring (nrepl-dict-get eldoc-info "docstring"))
  349. (type (nrepl-dict-get eldoc-info "type"))
  350. (ns (nrepl-dict-get eldoc-info "ns"))
  351. (class (nrepl-dict-get eldoc-info "class"))
  352. (name (nrepl-dict-get eldoc-info "name"))
  353. (member (nrepl-dict-get eldoc-info "member"))
  354. (ns-or-class (if (and ns (not (string= ns "")))
  355. ns
  356. class))
  357. (name-or-member (if (and name (not (string= name "")))
  358. name
  359. (format ".%s" member)))
  360. (eldoc-plist (list "ns" ns-or-class
  361. "symbol" name-or-member
  362. "arglists" arglists
  363. "docstring" docstring
  364. "type" type)))
  365. ;; add context dependent args if requested by defcustom
  366. ;; do not cache this eldoc info to avoid showing info
  367. ;: of the previous context
  368. (if cider-eldoc-display-context-dependent-info
  369. (cond
  370. ;; add inputs of datomic query
  371. ((and (equal ns-or-class "datomic.api")
  372. (equal name-or-member "q"))
  373. (let ((arglists (lax-plist-get eldoc-plist "arglists")))
  374. (lax-plist-put eldoc-plist "arglists"
  375. (cider--eldoc-add-datomic-query-inputs-to-arglists arglists))))
  376. ;; if none of the clauses is successful, do cache the eldoc
  377. (t (setq cider-eldoc-last-symbol (list thing eldoc-plist))))
  378. ;; middleware eldoc lookups are expensive, so we
  379. ;; cache the last lookup. This eliminates the need
  380. ;; for extra middleware requests within the same sexp.
  381. (setq cider-eldoc-last-symbol (list thing eldoc-plist)))
  382. eldoc-plist))))))))
  383. (defun cider--eldoc-remove-dot (sym)
  384. "Remove the preceding \".\" from a namespace qualified SYM and return sym.
  385. Only useful for interop forms. Clojure forms would be returned unchanged."
  386. (when sym (replace-regexp-in-string "/\\." "/" sym)))
  387. (defun cider--eldoc-edn-file-p (file-name)
  388. "Check whether FILE-NAME is representing an EDN file."
  389. (and file-name (equal (file-name-extension file-name) "edn")))
  390. (defun cider--eldoc-add-datomic-query-inputs-to-arglists (arglists)
  391. "Add the expected inputs of the datomic query to the ARGLISTS."
  392. (if (cider-second-sexp-in-list)
  393. (let* ((query (cider-second-sexp-in-list))
  394. (query-inputs (nrepl-dict-get
  395. (cider-sync-request:eldoc-datomic-query query)
  396. "inputs")))
  397. (if query-inputs
  398. (thread-first
  399. (thread-last arglists
  400. (car)
  401. (remove "&")
  402. (remove "inputs"))
  403. (append (car query-inputs))
  404. (list))
  405. arglists))
  406. arglists))
  407. (defun cider-eldoc ()
  408. "Backend function for eldoc to show argument list in the echo area."
  409. (when (and (cider-connected-p)
  410. ;; don't clobber an error message in the minibuffer
  411. (not (member last-command '(next-error previous-error)))
  412. ;; don't try to provide eldoc in EDN buffers
  413. (not (cider--eldoc-edn-file-p buffer-file-name)))
  414. (let* ((sexp-eldoc-info (cider-eldoc-info-in-current-sexp))
  415. (eldoc-info (lax-plist-get sexp-eldoc-info "eldoc-info"))
  416. (pos (lax-plist-get sexp-eldoc-info "pos"))
  417. (thing (lax-plist-get sexp-eldoc-info "thing")))
  418. (when eldoc-info
  419. (if (equal (cider-eldoc-thing-type eldoc-info) 'fn)
  420. (cider-eldoc-format-function thing pos eldoc-info)
  421. (cider-eldoc-format-variable thing eldoc-info))))))
  422. (defun cider-eldoc-setup ()
  423. "Setup eldoc in the current buffer.
  424. eldoc mode has to be enabled for this to have any effect."
  425. (setq-local eldoc-documentation-function #'cider-eldoc)
  426. (apply #'eldoc-add-command cider-extra-eldoc-commands))
  427. (provide 'cider-eldoc)
  428. ;;; cider-eldoc.el ends here