Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

253 line
9.6 KiB

4 年之前
  1. ;;; cider-completion.el --- Smart REPL-powered code completion -*- lexical-binding: t -*-
  2. ;; Copyright © 2013-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors
  3. ;;
  4. ;; Author: Bozhidar Batsov <bozhidar@batsov.com>
  5. ;; Artur Malabarba <bruce.connor.am@gmail.com>
  6. ;; This program is free software: you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation, either version 3 of the License, or
  9. ;; (at your option) any later version.
  10. ;; This program is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  16. ;; This file is not part of GNU Emacs.
  17. ;;; Commentary:
  18. ;; Smart REPL-powered code completion and integration with company-mode.
  19. ;;; Code:
  20. (require 'subr-x)
  21. (require 'thingatpt)
  22. (require 'cider-client)
  23. (require 'cider-common)
  24. (require 'cider-eldoc)
  25. (require 'nrepl-dict)
  26. (defcustom cider-completion-use-context t
  27. "When true, uses context at point to improve completion suggestions."
  28. :type 'boolean
  29. :group 'cider
  30. :package-version '(cider . "0.7.0"))
  31. (defcustom cider-annotate-completion-candidates t
  32. "When true, annotate completion candidates with some extra information."
  33. :type 'boolean
  34. :group 'cider
  35. :package-version '(cider . "0.8.0"))
  36. (defcustom cider-annotate-completion-function
  37. #'cider-default-annotate-completion-function
  38. "Controls how the annotations for completion candidates are formatted.
  39. Must be a function that takes two arguments: the abbreviation of the
  40. candidate type according to `cider-completion-annotations-alist' and the
  41. candidate's namespace."
  42. :type 'function
  43. :group 'cider
  44. :package-version '(cider . "0.9.0"))
  45. (defcustom cider-completion-annotations-alist
  46. '(("class" "c")
  47. ("field" "fi")
  48. ("function" "f")
  49. ("import" "i")
  50. ("keyword" "k")
  51. ("local" "l")
  52. ("macro" "m")
  53. ("method" "me")
  54. ("namespace" "n")
  55. ("protocol" "p")
  56. ("protocol-function" "pf")
  57. ("record" "r")
  58. ("special-form" "s")
  59. ("static-field" "sf")
  60. ("static-method" "sm")
  61. ("type" "t")
  62. ("var" "v"))
  63. "Controls the abbreviations used when annotating completion candidates.
  64. Must be a list of elements with the form (TYPE . ABBREVIATION), where TYPE
  65. is a possible value of the candidate's type returned from the completion
  66. backend, and ABBREVIATION is a short form of that type."
  67. :type '(alist :key-type string :value-type string)
  68. :group 'cider
  69. :package-version '(cider . "0.9.0"))
  70. (defcustom cider-completion-annotations-include-ns 'unqualified
  71. "Controls passing of namespaces to `cider-annotate-completion-function'.
  72. When set to 'always, the candidate's namespace will always be passed if it
  73. is available. When set to 'unqualified, the namespace will only be passed
  74. if the candidate is not namespace-qualified."
  75. :type '(choice (const always)
  76. (const unqualified)
  77. (const :tag "never" nil))
  78. :group 'cider
  79. :package-version '(cider . "0.9.0"))
  80. (defvar cider-completion-last-context nil)
  81. (defun cider-completion-symbol-start-pos ()
  82. "Find the starting position of the symbol at point, unless inside a string."
  83. (let ((sap (symbol-at-point)))
  84. (when (and sap (not (nth 3 (syntax-ppss))))
  85. (car (bounds-of-thing-at-point 'symbol)))))
  86. (defun cider-completion-get-context-at-point ()
  87. "Extract the context at point.
  88. If point is not inside the list, returns nil; otherwise return \"top-level\"
  89. form, with symbol at point replaced by __prefix__."
  90. (when (save-excursion
  91. (condition-case _
  92. (progn
  93. (up-list)
  94. (check-parens)
  95. t)
  96. (scan-error nil)
  97. (user-error nil)))
  98. (save-excursion
  99. (let* ((pref-end (point))
  100. (pref-start (cider-completion-symbol-start-pos))
  101. (context (cider-defun-at-point))
  102. (_ (beginning-of-defun))
  103. (expr-start (point)))
  104. (concat (when pref-start (substring context 0 (- pref-start expr-start)))
  105. "__prefix__"
  106. (substring context (- pref-end expr-start)))))))
  107. (defun cider-completion-get-context ()
  108. "Extract context depending on `cider-completion-use-context' and major mode."
  109. (let ((context (if (and cider-completion-use-context
  110. ;; Important because `beginning-of-defun' and
  111. ;; `ending-of-defun' work incorrectly in the REPL
  112. ;; buffer, so context extraction fails there.
  113. (derived-mode-p 'clojure-mode))
  114. (or (cider-completion-get-context-at-point)
  115. "nil")
  116. "nil")))
  117. (if (string= cider-completion-last-context context)
  118. ":same"
  119. (setq cider-completion-last-context context)
  120. context)))
  121. (defun cider-completion--parse-candidate-map (candidate-map)
  122. "Get \"candidate\" from CANDIDATE-MAP.
  123. Put type and ns properties on the candidate"
  124. (let ((candidate (nrepl-dict-get candidate-map "candidate"))
  125. (type (nrepl-dict-get candidate-map "type"))
  126. (ns (nrepl-dict-get candidate-map "ns")))
  127. (put-text-property 0 1 'type type candidate)
  128. (put-text-property 0 1 'ns ns candidate)
  129. candidate))
  130. (defun cider-complete (str)
  131. "Complete STR with context at point."
  132. (let* ((context (cider-completion-get-context))
  133. (candidates (cider-sync-request:complete str context)))
  134. (mapcar #'cider-completion--parse-candidate-map candidates)))
  135. (defun cider-completion--get-candidate-type (symbol)
  136. "Get candidate type for SYMBOL."
  137. (let ((type (get-text-property 0 'type symbol)))
  138. (or (cadr (assoc type cider-completion-annotations-alist))
  139. type)))
  140. (defun cider-completion--get-candidate-ns (symbol)
  141. "Get candidate ns for SYMBOL."
  142. (when (or (eq 'always cider-completion-annotations-include-ns)
  143. (and (eq 'unqualified cider-completion-annotations-include-ns)
  144. (not (cider-namespace-qualified-p symbol))))
  145. (get-text-property 0 'ns symbol)))
  146. (defun cider-default-annotate-completion-function (type ns)
  147. "Get completion function based on TYPE and NS."
  148. (concat (when ns (format " (%s)" ns))
  149. (when type (format " <%s>" type))))
  150. (defun cider-annotate-symbol (symbol)
  151. "Return a string suitable for annotating SYMBOL.
  152. If SYMBOL has a text property `type` whose value is recognised, its
  153. abbreviation according to `cider-completion-annotations-alist' will be
  154. used. If `type` is present but not recognised, its value will be used
  155. unaltered. If SYMBOL has a text property `ns`, then its value will be used
  156. according to `cider-completion-annotations-include-ns'. The formatting is
  157. performed by `cider-annotate-completion-function'."
  158. (when cider-annotate-completion-candidates
  159. (let* ((type (cider-completion--get-candidate-type symbol))
  160. (ns (cider-completion--get-candidate-ns symbol)))
  161. (funcall cider-annotate-completion-function type ns))))
  162. (defun cider-complete-at-point ()
  163. "Complete the symbol at point."
  164. (when-let* ((bounds (bounds-of-thing-at-point 'symbol)))
  165. (when (and (cider-connected-p)
  166. (not (or (cider-in-string-p) (cider-in-comment-p))))
  167. (list (car bounds) (cdr bounds)
  168. (completion-table-dynamic #'cider-complete)
  169. :annotation-function #'cider-annotate-symbol
  170. :company-doc-buffer #'cider-create-doc-buffer
  171. :company-location #'cider-company-location
  172. :company-docsig #'cider-company-docsig))))
  173. (defun cider-completion-flush-caches ()
  174. "Force Compliment to refill its caches.
  175. This command should be used if Compliment fails to pick up new classnames
  176. and methods from dependencies that were loaded dynamically after the REPL
  177. has started."
  178. (interactive)
  179. (cider-sync-request:complete-flush-caches))
  180. (defun cider-company-location (var)
  181. "Open VAR's definition in a buffer.
  182. Returns the cons of the buffer itself and the location of VAR's definition
  183. in the buffer."
  184. (when-let* ((info (cider-var-info var))
  185. (file (nrepl-dict-get info "file"))
  186. (line (nrepl-dict-get info "line"))
  187. (buffer (cider-find-file file)))
  188. (with-current-buffer buffer
  189. (save-excursion
  190. (goto-char (point-min))
  191. (forward-line (1- line))
  192. (cons buffer (point))))))
  193. (defun cider-company-docsig (thing)
  194. "Return signature for THING."
  195. (let* ((eldoc-info (cider-eldoc-info thing))
  196. (ns (lax-plist-get eldoc-info "ns"))
  197. (symbol (lax-plist-get eldoc-info "symbol"))
  198. (arglists (lax-plist-get eldoc-info "arglists")))
  199. (when eldoc-info
  200. (format "%s: %s"
  201. (cider-eldoc-format-thing ns symbol thing
  202. (cider-eldoc-thing-type eldoc-info))
  203. (cider-eldoc-format-arglist arglists 0)))))
  204. ;; Fuzzy completion for company-mode
  205. (defun cider-company-unfiltered-candidates (string &rest _)
  206. "Return CIDER completion candidates for STRING as is, unfiltered."
  207. (cider-complete string))
  208. (add-to-list 'completion-styles-alist
  209. '(cider
  210. cider-company-unfiltered-candidates
  211. cider-company-unfiltered-candidates
  212. "CIDER backend-driven completion style."))
  213. (defun cider-company-enable-fuzzy-completion ()
  214. "Enable backend-driven fuzzy completion in the current buffer."
  215. (setq-local completion-styles '(cider)))
  216. (provide 'cider-completion)
  217. ;;; cider-completion.el ends here