/
cider-completion.el
301 lines (263 loc) · 12.5 KB
/
cider-completion.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
;;; cider-completion.el --- Smart REPL-powered code completion -*- lexical-binding: t -*-
;; Copyright © 2013-2024 Bozhidar Batsov, Artur Malabarba and CIDER contributors
;;
;; Author: Bozhidar Batsov <[email protected]>
;; Artur Malabarba <[email protected]>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Smart REPL-powered code completion and integration with company-mode.
;;; Code:
(require 'subr-x)
(require 'thingatpt)
(require 'cider-client)
(require 'cider-common)
(require 'cider-completion-context)
(require 'cider-doc)
(require 'cider-docstring)
(require 'cider-eldoc)
(require 'nrepl-dict)
(require 'seq)
(defcustom cider-annotate-completion-candidates t
"When true, annotate completion candidates with some extra information."
:type 'boolean
:group 'cider
:package-version '(cider . "0.8.0"))
(defcustom cider-annotate-completion-function
#'cider-default-annotate-completion-function
"Controls how the annotations for completion candidates are formatted.
Must be a function that takes two arguments: the abbreviation of the
candidate type according to `cider-completion-annotations-alist' and the
candidate's namespace."
:type 'function
:group 'cider
:package-version '(cider . "0.9.0"))
(defcustom cider-completion-annotations-alist
'(("class" "c")
("field" "fi")
("function" "f")
("import" "i")
("keyword" "k")
("local" "l")
("macro" "m")
("method" "me")
("namespace" "n")
("protocol" "p")
("protocol-function" "pf")
("record" "r")
("special-form" "s")
("static-field" "sf")
("static-method" "sm")
("type" "t")
("var" "v"))
"Controls the abbreviations used when annotating completion candidates.
Must be a list of elements with the form (TYPE . ABBREVIATION), where TYPE
is a possible value of the candidate's type returned from the completion
backend, and ABBREVIATION is a short form of that type."
:type '(alist :key-type string :value-type string)
:group 'cider
:package-version '(cider . "0.9.0"))
(defconst cider-completion-kind-alist
'(("class" class)
("field" field)
("function" function)
("import" class)
("keyword" keyword)
("local" variable)
("macro" macro)
("method" method)
("namespace" module)
("protocol" enum)
("protocol-function" enum-member)
("record" struct)
("special-form" keyword)
("static-field" field)
("static-method" interface)
("type" parameter)
("var" variable))
"Icon mapping for company-mode.")
(defcustom cider-completion-annotations-include-ns 'unqualified
"Controls passing of namespaces to `cider-annotate-completion-function'.
When set to 'always, the candidate's namespace will always be passed if it
is available. When set to 'unqualified, the namespace will only be passed
if the candidate is not namespace-qualified."
:type '(choice (const always)
(const unqualified)
(const :tag "never" nil))
:group 'cider
:package-version '(cider . "0.9.0"))
(defun cider-completion--parse-candidate-map (candidate-map)
"Get \"candidate\" from CANDIDATE-MAP.
Put type and ns properties on the candidate"
(let ((candidate (nrepl-dict-get candidate-map "candidate"))
(type (nrepl-dict-get candidate-map "type"))
(ns (nrepl-dict-get candidate-map "ns")))
(put-text-property 0 1 'type type candidate)
(put-text-property 0 1 'ns ns candidate)
candidate))
(defun cider-complete (prefix)
"Complete PREFIX with context at point.
Completion relies on nREPL middleware. First
we check if cider-nrepl's complete op is available
and afterward we fallback on nREPL's built-in
completion functionality."
(cond
;; if we don't have a connection, end early
((not (cider-connected-p)) nil)
;; next we try if cider-nrepl's completion is available
((cider-nrepl-op-supported-p "complete")
(let* ((context (cider-completion-get-context))
(candidates (cider-sync-request:complete prefix context)))
(mapcar #'cider-completion--parse-candidate-map candidates)))
;; then we fallback to nREPL's built-in op (available in nREPL 0.8+)
((cider-nrepl-op-supported-p "completions")
(mapcar #'cider-completion--parse-candidate-map (cider-sync-request:completion prefix)))
(t nil)))
(defun cider-completion--get-candidate-type (symbol)
"Get candidate type for SYMBOL."
(let ((type (get-text-property 0 'type symbol)))
(or (cadr (assoc type cider-completion-annotations-alist))
type)))
(defun cider-completion--get-candidate-ns (symbol)
"Get candidate ns for SYMBOL."
(when (or (eq 'always cider-completion-annotations-include-ns)
(and (eq 'unqualified cider-completion-annotations-include-ns)
(not (cider-namespace-qualified-p symbol))))
(get-text-property 0 'ns symbol)))
(defun cider-default-annotate-completion-function (type ns)
"Get completion function based on TYPE and NS."
(concat (when ns (format " (%s)" ns))
(when type (format " <%s>" type))))
(defun cider-company-symbol-kind (symbol)
"Get SYMBOL kind for company-mode."
(let ((type (get-text-property 0 'type symbol)))
(or (cadr (assoc type cider-completion-kind-alist))
type)))
(defun cider-annotate-symbol (symbol)
"Return a string suitable for annotating SYMBOL.
If SYMBOL has a text property `type` whose value is recognised, its
abbreviation according to `cider-completion-annotations-alist' will be
used. If `type` is present but not recognised, its value will be used
unaltered. If SYMBOL has a text property `ns`, then its value will be used
according to `cider-completion-annotations-include-ns'. The formatting is
performed by `cider-annotate-completion-function'."
(when cider-annotate-completion-candidates
(let* ((type (cider-completion--get-candidate-type symbol))
(ns (cider-completion--get-candidate-ns symbol)))
(funcall cider-annotate-completion-function type ns))))
(defun cider-complete-at-point ()
"Complete the symbol at point."
(when-let* ((bounds (bounds-of-thing-at-point 'symbol)))
(when (and (cider-connected-p)
(not (or (cider-in-string-p) (cider-in-comment-p))))
(let* (last-prefix
last-result
(complete
(lambda (prefix)
(unless (string-equal last-prefix prefix)
(setq last-prefix prefix)
(setq last-result (cider-complete prefix)))
last-result)))
(list (car bounds) (cdr bounds)
(lambda (prefix pred action)
;; When the 'action is 'metadata, this lambda returns metadata about this
;; capf, when action is (boundaries . suffix), it returns nil. With every
;; other value of 'action (t, nil, or lambda), 'action is forwarded to
;; (complete-with-action), together with (cider-complete), prefix and pred.
;; And that function performs the completion based on those arguments.
;;
;; This api is better described in the section
;; '21.6.7 Programmed Completion' of the elisp manual.
(cond ((eq action 'metadata) `(metadata (category . cider))) ;; defines a completion category named 'cider, used later in our `completion-category-overrides` logic.
((eq (car-safe action) 'boundaries) nil)
(t (with-current-buffer (current-buffer)
(complete-with-action action
(funcall complete prefix) prefix pred)))))
:annotation-function #'cider-annotate-symbol
:company-kind #'cider-company-symbol-kind
:company-doc-buffer #'cider-create-compact-doc-buffer
:company-location #'cider-company-location
:company-docsig #'cider-company-docsig)))))
(defun cider-completion-flush-caches ()
"Force Compliment to refill its caches.
This command should be used if Compliment fails to pick up new classnames
and methods from dependencies that were loaded dynamically after the REPL
has started."
(interactive)
(cider-sync-request:complete-flush-caches))
(defun cider-company-location (var)
"Open VAR's definition in a buffer.
Returns the cons of the buffer itself and the location of VAR's definition
in the buffer."
(when-let* ((info (cider-var-info var))
(file (nrepl-dict-get info "file"))
(line (nrepl-dict-get info "line"))
(buffer (cider-find-file file)))
(with-current-buffer buffer
(save-excursion
(goto-char (point-min))
(forward-line (1- line))
(cons buffer (point))))))
(defun cider-company-docsig (thing)
"Return signature for THING."
(when-let ((eldoc-info (cider-eldoc-info thing)))
(let* ((ns (lax-plist-get eldoc-info "ns"))
(symbol (lax-plist-get eldoc-info "symbol"))
(arglists (lax-plist-get eldoc-info "arglists")))
(format "%s: %s"
(cider-eldoc-format-thing ns symbol thing
(cider-eldoc-thing-type eldoc-info))
(cider-eldoc-format-arglist arglists 0)))))
;; Fuzzy completion for company-mode
(defun cider-company-unfiltered-candidates (string &rest _)
"Return CIDER completion candidates for STRING as is, unfiltered."
(cider-complete string))
;; defines a completion style named `cider' (which ideally would have been named `cider-fuzzy').
;; note that there's already a completion category named `cider' (grep for `(metadata (category . cider))` in this file),
;; which can be confusing given the identical name.
;; The `cider' completion style should be removed because the `flex' style is essentially equivalent.
;; (To be fair, `flex' was introduced in Emacs 27, 3 years in after our commit 04e428b
;; which introduced `cider-company-enable-fuzzy-completion')
(add-to-list 'completion-styles-alist
'(cider
cider-company-unfiltered-candidates
cider-company-unfiltered-candidates
"CIDER backend-driven completion style."))
;; Currently CIDER completions only work for `basic`, and not `initials`, `partial-completion`, `orderless`, etc.
;; So we ensure that those other styles aren't used with CIDER, otherwise one would see bad or no completions at all.
;; This `add-to-list` call can be removed once we implement the other completion styles.
;; (When doing that, please refactor `cider-enable-flex-completion' as well)
(add-to-list 'completion-category-overrides '(cider (styles basic)))
(defun cider-company-enable-fuzzy-completion ()
"Enable backend-driven fuzzy completion in the current buffer.
DEPRECATED: please use `cider-enable-flex-completion' instead."
(setq-local completion-styles '(cider)))
(make-obsolete 'cider-company-enable-fuzzy-completion 'cider-enable-flex-completion "1.8.0")
(defun cider-enable-flex-completion ()
"Enables `flex' (fuzzy) completion for CIDER in all buffers.
Only affects the `cider' completion category.`"
(interactive)
(when (< emacs-major-version 27)
(user-error "`cider-enable-flex-completion' requires Emacs 27 or later"))
(let ((found-styles (when-let ((cider (assq 'cider completion-category-overrides)))
(assq 'styles cider)))
(found-cycle (when-let ((cider (assq 'cider completion-category-overrides)))
(assq 'cycle cider))))
(setq completion-category-overrides (seq-remove (lambda (x)
(equal 'cider (car x)))
completion-category-overrides))
(unless (member 'flex found-styles)
(setq found-styles (append found-styles '(flex))))
(add-to-list 'completion-category-overrides (apply #'list 'cider found-styles (when found-cycle
(list found-cycle))))))
(provide 'cider-completion)
;;; cider-completion.el ends here