Create fix for Company bug
Just like with Company-fuzzy, this bug just popped up out of thin air on only one of my systems, and nobody seems to have this occur once, let alone know a good fix for it. Just replacing it with a useless string value did the job again.
- Author
- Maarten Vangeneugden
- Date
- Nov. 21, 2024, 10:11 a.m.
- Hash
- dc4f9ff3b05a165c503de2fb3a3892e844ab33b7
- Parent
- 226ba1eacdfb635e5235eb8141724d5cb1ce2045
- Modified files
- company.el
- init.el
company.el ¶
4709 additions and 0 deletions.
View changes Hide changes
+ |
1 |
|
+ |
2 |
;; Copyright (C) 2009-2024 Free Software Foundation, Inc. |
+ |
3 |
;; FIXED by Maarten Vangeneugden on 2024/11/21 (L2516) |
+ |
4 |
|
+ |
5 |
;; Author: Nikolaj Schumacher |
+ |
6 |
;; Maintainer: Dmitry Gutov <dmitry@gutov.dev> |
+ |
7 |
;; URL: http://company-mode.github.io/ |
+ |
8 |
;; Package-Version: 20241106.2000 |
+ |
9 |
;; Package-Revision: 0ae7c2931122 |
+ |
10 |
;; Keywords: abbrev, convenience, matching |
+ |
11 |
;; Package-Requires: ((emacs "26.1")) |
+ |
12 |
|
+ |
13 |
;; This file is part of GNU Emacs. |
+ |
14 |
|
+ |
15 |
;; GNU Emacs is free software: you can redistribute it and/or modify |
+ |
16 |
;; it under the terms of the GNU General Public License as published by |
+ |
17 |
;; the Free Software Foundation, either version 3 of the License, or |
+ |
18 |
;; (at your option) any later version. |
+ |
19 |
|
+ |
20 |
;; GNU Emacs is distributed in the hope that it will be useful, |
+ |
21 |
;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
+ |
22 |
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
+ |
23 |
;; GNU General Public License for more details. |
+ |
24 |
|
+ |
25 |
;; You should have received a copy of the GNU General Public License |
+ |
26 |
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. |
+ |
27 |
|
+ |
28 |
;;; Commentary: |
+ |
29 |
;; |
+ |
30 |
;; Company is a modular completion framework. Modules for retrieving completion |
+ |
31 |
;; candidates are called backends, modules for displaying them are frontends. |
+ |
32 |
;; |
+ |
33 |
;; Company comes with many backends, e.g. `company-etags'. These are |
+ |
34 |
;; distributed in separate files and can be used individually. |
+ |
35 |
;; |
+ |
36 |
;; Enable `company-mode' in all buffers with M-x global-company-mode. For |
+ |
37 |
;; further information look at the documentation for `company-mode' (C-h f |
+ |
38 |
;; company-mode RET). |
+ |
39 |
;; |
+ |
40 |
;; If you want to start a specific backend, call it interactively or use |
+ |
41 |
;; `company-begin-backend'. For example: |
+ |
42 |
;; M-x company-abbrev will prompt for and insert an abbrev. |
+ |
43 |
;; |
+ |
44 |
;; To write your own backend, look at the documentation for `company-backends'. |
+ |
45 |
;; Here is a simple example completing "foo": |
+ |
46 |
;; |
+ |
47 |
;; (defun company-my-backend (command &optional arg &rest ignored) |
+ |
48 |
;; (interactive (list 'interactive)) |
+ |
49 |
;; (pcase command |
+ |
50 |
;; (`interactive (company-begin-backend 'company-my-backend)) |
+ |
51 |
;; (`prefix (company-grab-symbol)) |
+ |
52 |
;; (`candidates (list "foobar" "foobaz" "foobarbaz")) |
+ |
53 |
;; (`meta (format "This value is named %s" arg)))) |
+ |
54 |
;; |
+ |
55 |
;; Sometimes it is a good idea to mix several backends together, for example to |
+ |
56 |
;; enrich gtags with dabbrev-code results (to emulate local variables). To do |
+ |
57 |
;; this, add a list with both backends as an element in `company-backends'. |
+ |
58 |
;; |
+ |
59 |
;;; Change Log: |
+ |
60 |
;; |
+ |
61 |
;; See NEWS.md in the repository. |
+ |
62 |
|
+ |
63 |
;;; Code: |
+ |
64 |
|
+ |
65 |
(require 'cl-lib) |
+ |
66 |
(require 'subr-x) |
+ |
67 |
(require 'pcase) |
+ |
68 |
|
+ |
69 |
(defgroup company nil |
+ |
70 |
"Extensible inline text completion mechanism." |
+ |
71 |
:group 'abbrev |
+ |
72 |
:group 'convenience |
+ |
73 |
:group 'matching |
+ |
74 |
:link '(custom-manual "(company) Top")) |
+ |
75 |
|
+ |
76 |
(defgroup company-faces nil |
+ |
77 |
"Faces used by Company." |
+ |
78 |
:group 'company |
+ |
79 |
:group 'faces) |
+ |
80 |
|
+ |
81 |
(defface company-tooltip |
+ |
82 |
'((((class color) (min-colors 88) (background light)) |
+ |
83 |
(:foreground "black" :background "cornsilk")) |
+ |
84 |
(((class color) (min-colors 88) (background dark)) |
+ |
85 |
(:background "gray26")) |
+ |
86 |
(t (:foreground "black" :background "yellow"))) |
+ |
87 |
"Face used for the tooltip.") |
+ |
88 |
|
+ |
89 |
(defface company-tooltip-selection |
+ |
90 |
'((((class color) (min-colors 88) (background light)) |
+ |
91 |
(:background "light blue")) |
+ |
92 |
(((class color) (min-colors 88) (background dark)) |
+ |
93 |
(:background "gray31")) |
+ |
94 |
(t (:background "green"))) |
+ |
95 |
"Face used for the selection in the tooltip.") |
+ |
96 |
|
+ |
97 |
(defface company-tooltip-deprecated |
+ |
98 |
'((t (:strike-through t))) |
+ |
99 |
"Face used for the deprecated items.") |
+ |
100 |
|
+ |
101 |
(defface company-tooltip-search |
+ |
102 |
'((default :inherit highlight)) |
+ |
103 |
"Face used for the search string in the tooltip.") |
+ |
104 |
|
+ |
105 |
(defface company-tooltip-search-selection |
+ |
106 |
'((default :inherit highlight)) |
+ |
107 |
"Face used for the search string inside the selection in the tooltip.") |
+ |
108 |
|
+ |
109 |
(defface company-tooltip-mouse |
+ |
110 |
'((default :inherit highlight)) |
+ |
111 |
"Face used for the tooltip item under the mouse.") |
+ |
112 |
|
+ |
113 |
(defface company-tooltip-common |
+ |
114 |
'((((background light)) |
+ |
115 |
:foreground "darkred") |
+ |
116 |
(((background dark)) |
+ |
117 |
:foreground "pale turquoise")) |
+ |
118 |
"Face used for the common completion in the tooltip.") |
+ |
119 |
|
+ |
120 |
(defface company-tooltip-common-selection |
+ |
121 |
'((default :inherit company-tooltip-common)) |
+ |
122 |
"Face used for the selected common completion in the tooltip.") |
+ |
123 |
|
+ |
124 |
(defface company-tooltip-annotation |
+ |
125 |
'((((background light)) |
+ |
126 |
:foreground "firebrick4") |
+ |
127 |
(((background dark)) |
+ |
128 |
:foreground "LightCyan3")) |
+ |
129 |
"Face used for the completion annotation in the tooltip.") |
+ |
130 |
|
+ |
131 |
(defface company-tooltip-annotation-selection |
+ |
132 |
'((default :inherit company-tooltip-annotation)) |
+ |
133 |
"Face used for the selected completion annotation in the tooltip.") |
+ |
134 |
|
+ |
135 |
(defface company-tooltip-quick-access |
+ |
136 |
'((default :inherit company-tooltip-annotation)) |
+ |
137 |
"Face used for the quick-access hints shown in the tooltip." |
+ |
138 |
:package-version '(company . "0.10.0")) |
+ |
139 |
|
+ |
140 |
(defface company-tooltip-quick-access-selection |
+ |
141 |
'((default :inherit company-tooltip-annotation-selection)) |
+ |
142 |
"Face used for the selected quick-access hints shown in the tooltip." |
+ |
143 |
:package-version '(company . "0.10.0")) |
+ |
144 |
|
+ |
145 |
(define-obsolete-face-alias |
+ |
146 |
'company-scrollbar-fg |
+ |
147 |
'company-tooltip-scrollbar-thumb |
+ |
148 |
"0.10.0") |
+ |
149 |
|
+ |
150 |
(defface company-tooltip-scrollbar-thumb |
+ |
151 |
'((((background light)) |
+ |
152 |
:background "indian red") |
+ |
153 |
(((background dark)) |
+ |
154 |
:background "gray33")) |
+ |
155 |
"Face used for the tooltip scrollbar thumb (bar).") |
+ |
156 |
|
+ |
157 |
(define-obsolete-face-alias |
+ |
158 |
'company-scrollbar-bg |
+ |
159 |
'company-tooltip-scrollbar-track |
+ |
160 |
"0.10.0") |
+ |
161 |
|
+ |
162 |
(defface company-tooltip-scrollbar-track |
+ |
163 |
'((((background light)) |
+ |
164 |
:background "wheat") |
+ |
165 |
(((background dark)) |
+ |
166 |
:background "gray28")) |
+ |
167 |
"Face used for the tooltip scrollbar track (trough).") |
+ |
168 |
|
+ |
169 |
(defface company-preview |
+ |
170 |
'((default :inherit (company-tooltip-selection company-tooltip))) |
+ |
171 |
"Face used for the completion preview.") |
+ |
172 |
|
+ |
173 |
(defface company-preview-common |
+ |
174 |
'((default :inherit company-tooltip-common-selection)) |
+ |
175 |
"Face used for the common part of the completion preview.") |
+ |
176 |
|
+ |
177 |
(defface company-preview-search |
+ |
178 |
'((default :inherit company-tooltip-common-selection)) |
+ |
179 |
"Face used for the search string in the completion preview.") |
+ |
180 |
|
+ |
181 |
(defface company-echo nil |
+ |
182 |
"Face used for completions in the echo area.") |
+ |
183 |
|
+ |
184 |
(defface company-echo-common |
+ |
185 |
'((((background light)) (:foreground "firebrick4")) |
+ |
186 |
(((background dark)) (:foreground "firebrick1"))) |
+ |
187 |
"Face used for the common part of completions in the echo area.") |
+ |
188 |
|
+ |
189 |
;; Too lazy to re-add :group to all defcustoms down below. |
+ |
190 |
(setcdr (assoc load-file-name custom-current-group-alist) |
+ |
191 |
'company) |
+ |
192 |
|
+ |
193 |
(defun company-frontends-set (variable value) |
+ |
194 |
;; Uniquify. |
+ |
195 |
(let ((value (delete-dups (copy-sequence value)))) |
+ |
196 |
(and (or (and (memq 'company-pseudo-tooltip-unless-just-one-frontend value) |
+ |
197 |
(memq 'company-pseudo-tooltip-frontend value)) |
+ |
198 |
(and (memq 'company-pseudo-tooltip-unless-just-one-frontend-with-delay value) |
+ |
199 |
(memq 'company-pseudo-tooltip-frontend value)) |
+ |
200 |
(and (memq 'company-pseudo-tooltip-unless-just-one-frontend-with-delay value) |
+ |
201 |
(memq 'company-pseudo-tooltip-unless-just-one-frontend value))) |
+ |
202 |
(user-error "Pseudo tooltip frontend cannot be used more than once")) |
+ |
203 |
(and (or (and (memq 'company-preview-if-just-one-frontend value) |
+ |
204 |
(memq 'company-preview-frontend value)) |
+ |
205 |
(and (memq 'company-preview-if-just-one-frontend value) |
+ |
206 |
(memq 'company-preview-common-frontend value)) |
+ |
207 |
(and (memq 'company-preview-frontend value) |
+ |
208 |
(memq 'company-preview-common-frontend value)) |
+ |
209 |
) |
+ |
210 |
(user-error "Preview frontend cannot be used twice")) |
+ |
211 |
(and (memq 'company-echo value) |
+ |
212 |
(memq 'company-echo-metadata-frontend value) |
+ |
213 |
(user-error "Echo area cannot be used twice")) |
+ |
214 |
;; Preview must come last. |
+ |
215 |
(dolist (f '(company-preview-if-just-one-frontend company-preview-frontend company-preview-common-frontend)) |
+ |
216 |
(when (cdr (memq f value)) |
+ |
217 |
(setq value (append (delq f value) (list f))))) |
+ |
218 |
(set variable value))) |
+ |
219 |
|
+ |
220 |
(defcustom company-frontends '(company-pseudo-tooltip-unless-just-one-frontend |
+ |
221 |
company-preview-if-just-one-frontend |
+ |
222 |
company-echo-metadata-frontend) |
+ |
223 |
"The list of active frontends (visualizations). |
+ |
224 |
Each frontend is a function that takes one argument. It is called with |
+ |
225 |
one of the following arguments: |
+ |
226 |
|
+ |
227 |
`show': When the visualization should start. |
+ |
228 |
|
+ |
229 |
`hide': When the visualization should end. |
+ |
230 |
|
+ |
231 |
`update': When the data has been updated. |
+ |
232 |
|
+ |
233 |
`pre-command': Before every command that is executed while the |
+ |
234 |
visualization is active. |
+ |
235 |
|
+ |
236 |
`post-command': After every command that is executed while the |
+ |
237 |
visualization is active. |
+ |
238 |
|
+ |
239 |
`unhide': When an asynchronous backend is waiting for its completions. |
+ |
240 |
Only needed in frontends which hide their visualizations in `pre-command' |
+ |
241 |
for technical reasons. |
+ |
242 |
|
+ |
243 |
The visualized data is stored in `company-prefix', `company-candidates', |
+ |
244 |
`company-common', `company-selection', `company-point' and |
+ |
245 |
`company-search-string'." |
+ |
246 |
:set 'company-frontends-set |
+ |
247 |
:type '(repeat (choice (const :tag "echo" company-echo-frontend) |
+ |
248 |
(const :tag "echo, strip common" |
+ |
249 |
company-echo-strip-common-frontend) |
+ |
250 |
(const :tag "show echo meta-data in echo" |
+ |
251 |
company-echo-metadata-frontend) |
+ |
252 |
(const :tag "pseudo tooltip" |
+ |
253 |
company-pseudo-tooltip-frontend) |
+ |
254 |
(const :tag "pseudo tooltip, multiple only" |
+ |
255 |
company-pseudo-tooltip-unless-just-one-frontend) |
+ |
256 |
(const :tag "pseudo tooltip, multiple only, delayed" |
+ |
257 |
company-pseudo-tooltip-unless-just-one-frontend-with-delay) |
+ |
258 |
(const :tag "preview" company-preview-frontend) |
+ |
259 |
(const :tag "preview, unique only" |
+ |
260 |
company-preview-if-just-one-frontend) |
+ |
261 |
(const :tag "preview, common" |
+ |
262 |
company-preview-common-frontend) |
+ |
263 |
(function :tag "custom function" nil)))) |
+ |
264 |
|
+ |
265 |
(defcustom company-tooltip-limit 10 |
+ |
266 |
"The maximum number of candidates in the tooltip." |
+ |
267 |
:type 'integer) |
+ |
268 |
|
+ |
269 |
(defcustom company-tooltip-minimum 6 |
+ |
270 |
"Ensure visibility of this number of candidates. |
+ |
271 |
When that many lines are not available between point and the bottom of the |
+ |
272 |
window, display the tooltip above point." |
+ |
273 |
:type 'integer) |
+ |
274 |
|
+ |
275 |
(defcustom company-tooltip-minimum-width 0 |
+ |
276 |
"The minimum width of the tooltip's inner area. |
+ |
277 |
This doesn't include the margins and the scroll bar." |
+ |
278 |
:type 'integer |
+ |
279 |
:package-version '(company . "0.8.0")) |
+ |
280 |
|
+ |
281 |
(defcustom company-tooltip-maximum-width most-positive-fixnum |
+ |
282 |
"The maximum width of the tooltip's inner area. |
+ |
283 |
This doesn't include the margins and the scroll bar." |
+ |
284 |
:type 'integer |
+ |
285 |
:package-version '(company . "0.9.5")) |
+ |
286 |
|
+ |
287 |
(defcustom company-tooltip-width-grow-only nil |
+ |
288 |
"When non-nil, the tooltip width is not allowed to decrease." |
+ |
289 |
:type 'boolean |
+ |
290 |
:package-version '(company . "0.10.0")) |
+ |
291 |
|
+ |
292 |
(defcustom company-tooltip-margin 1 |
+ |
293 |
"Width of margin columns to show around the toolip." |
+ |
294 |
:type 'integer) |
+ |
295 |
|
+ |
296 |
(defcustom company-tooltip-offset-display 'scrollbar |
+ |
297 |
"Method using which the tooltip displays scrolling position. |
+ |
298 |
`scrollbar' means draw a scrollbar to the right of the items. |
+ |
299 |
`lines' means wrap items in lines with \"before\" and \"after\" counters." |
+ |
300 |
:type '(choice (const :tag "Scrollbar" scrollbar) |
+ |
301 |
(const :tag "Two lines" lines))) |
+ |
302 |
|
+ |
303 |
(defcustom company-tooltip-scrollbar-width 0.4 |
+ |
304 |
"Width of the scrollbar thumb, in columns." |
+ |
305 |
:type 'number |
+ |
306 |
:package-version '(company . "1.0.0")) |
+ |
307 |
|
+ |
308 |
(defcustom company-tooltip-align-annotations nil |
+ |
309 |
"When non-nil, align annotations to the right tooltip border." |
+ |
310 |
:type 'boolean |
+ |
311 |
:package-version '(company . "0.7.1")) |
+ |
312 |
|
+ |
313 |
(defcustom company-tooltip-flip-when-above nil |
+ |
314 |
"Whether to flip the tooltip when it's above the current line." |
+ |
315 |
:type 'boolean |
+ |
316 |
:package-version '(company . "0.8.1")) |
+ |
317 |
|
+ |
318 |
(defcustom company-tooltip-annotation-padding nil |
+ |
319 |
"Non-nil to specify the padding before annotation. |
+ |
320 |
|
+ |
321 |
Depending on the value of `company-tooltip-align-annotations', the default |
+ |
322 |
padding is either 0 or 1 space. This variable allows to override that |
+ |
323 |
value to increase the padding. When annotations are right-aligned, it sets |
+ |
324 |
the minimum padding, and otherwise just the constant one." |
+ |
325 |
:type 'number |
+ |
326 |
:package-version '(company "0.10.0")) |
+ |
327 |
|
+ |
328 |
(defvar company-safe-backends |
+ |
329 |
'((company-abbrev . "Abbrev") |
+ |
330 |
(company-bbdb . "BBDB") |
+ |
331 |
(company-capf . "completion-at-point-functions") |
+ |
332 |
(company-clang . "Clang") |
+ |
333 |
(company-cmake . "CMake") |
+ |
334 |
(company-css . "CSS (obsolete backend)") |
+ |
335 |
(company-dabbrev . "dabbrev for plain text") |
+ |
336 |
(company-dabbrev-code . "dabbrev for code") |
+ |
337 |
(company-elisp . "Emacs Lisp (obsolete backend)") |
+ |
338 |
(company-etags . "etags") |
+ |
339 |
(company-files . "Files") |
+ |
340 |
(company-gtags . "GNU Global") |
+ |
341 |
(company-ispell . "Ispell") |
+ |
342 |
(company-keywords . "Programming language keywords") |
+ |
343 |
(company-nxml . "nxml (obsolete backend)") |
+ |
344 |
(company-oddmuse . "Oddmuse") |
+ |
345 |
(company-semantic . "Semantic") |
+ |
346 |
(company-tempo . "Tempo templates"))) |
+ |
347 |
(put 'company-safe-backends 'risky-local-variable t) |
+ |
348 |
|
+ |
349 |
(defun company-safe-backends-p (backends) |
+ |
350 |
(and (consp backends) |
+ |
351 |
(not (cl-dolist (backend backends) |
+ |
352 |
(unless (if (consp backend) |
+ |
353 |
(company-safe-backends-p backend) |
+ |
354 |
(assq backend company-safe-backends)) |
+ |
355 |
(cl-return t)))))) |
+ |
356 |
|
+ |
357 |
(defcustom company-backends `(company-bbdb |
+ |
358 |
,@(unless (version<= "26" emacs-version) |
+ |
359 |
(list 'company-nxml)) |
+ |
360 |
,@(unless (version<= "26" emacs-version) |
+ |
361 |
(list 'company-css)) |
+ |
362 |
company-semantic |
+ |
363 |
company-cmake |
+ |
364 |
company-capf |
+ |
365 |
company-clang |
+ |
366 |
company-files |
+ |
367 |
(company-dabbrev-code company-gtags company-etags |
+ |
368 |
company-keywords) |
+ |
369 |
company-oddmuse company-dabbrev) |
+ |
370 |
"The list of active backends (completion engines). |
+ |
371 |
|
+ |
372 |
Only one backend is used at a time. The choice depends on the order of |
+ |
373 |
the items in this list, and on the values they return in response to the |
+ |
374 |
`prefix' command (see below). But a backend can also be a \"grouped\" |
+ |
375 |
one (see below). |
+ |
376 |
|
+ |
377 |
`company-begin-backend' can be used to start a specific backend, |
+ |
378 |
`company-other-backend' will skip to the next matching backend in the list. |
+ |
379 |
|
+ |
380 |
To debug which backend is currently in use, try `M-x company-diag'. |
+ |
381 |
|
+ |
382 |
Each backend is a function that takes a variable number of arguments. |
+ |
383 |
The first argument is the command requested from the backend. It is one |
+ |
384 |
of the following: |
+ |
385 |
|
+ |
386 |
`prefix': The backend should return the text to be completed. Returning |
+ |
387 |
nil from this command passes control to the next backend. |
+ |
388 |
|
+ |
389 |
The expected return value looks like (PREFIX SUFFIX &optional PREFIX-LEN). |
+ |
390 |
Where PREFIX is the text to be completed before point, SUFFIX - the |
+ |
391 |
remainder after point (when e.g. inside a symbol), and PREFIX-LEN, when |
+ |
392 |
non-nil, is the number to use in place of PREFIX's length when comparing |
+ |
393 |
against `company-minimum-prefix-length'. PREFIX-LEN can also be just t, |
+ |
394 |
and in the latter case the test automatically succeeds. |
+ |
395 |
|
+ |
396 |
The return value can also be just PREFIX, in which case SUFFIX is taken to |
+ |
397 |
be an empty string. |
+ |
398 |
|
+ |
399 |
`candidates': The second argument is the prefix to be completed. The |
+ |
400 |
return value should be a list of candidates that match the prefix. |
+ |
401 |
|
+ |
402 |
Non-prefix matches are also supported (candidates that don't start with the |
+ |
403 |
prefix, but match it in some backend-defined way). Backends that use this |
+ |
404 |
feature must disable cache (return t in response to `no-cache') and might |
+ |
405 |
also want to handle `match'. |
+ |
406 |
|
+ |
407 |
Optional commands |
+ |
408 |
================= |
+ |
409 |
|
+ |
410 |
`sorted': Return t here to indicate that the candidates are sorted and will |
+ |
411 |
not need to be sorted again. |
+ |
412 |
|
+ |
413 |
`duplicates': If non-nil, company will take care of removing duplicates |
+ |
414 |
from the list. |
+ |
415 |
|
+ |
416 |
`no-cache': Usually company doesn't ask for candidates again as completion |
+ |
417 |
progresses, unless the backend returns t for this command. The second |
+ |
418 |
argument is the latest prefix. |
+ |
419 |
|
+ |
420 |
`ignore-case': Return t here if the backend returns case-insensitive |
+ |
421 |
matches. This value is used to determine the longest common prefix (as |
+ |
422 |
used in `company-complete-common'), and to filter completions when fetching |
+ |
423 |
them from cache. |
+ |
424 |
|
+ |
425 |
`meta': The second argument is a completion candidate. Return a (short) |
+ |
426 |
documentation string for it. |
+ |
427 |
|
+ |
428 |
`doc-buffer': The second argument is a completion candidate. Return a |
+ |
429 |
buffer with documentation for it. Preferably use `company-doc-buffer'. If |
+ |
430 |
not all buffer contents pertain to this candidate, return a cons of buffer |
+ |
431 |
and window start position. |
+ |
432 |
|
+ |
433 |
`location': The second argument is a completion candidate. Return a cons |
+ |
434 |
of buffer and buffer location, or of file and line number where the |
+ |
435 |
completion candidate was defined. |
+ |
436 |
|
+ |
437 |
`annotation': The second argument is a completion candidate. Return a |
+ |
438 |
string to be displayed inline with the candidate in the popup. If |
+ |
439 |
duplicates are removed by company, candidates with equal string values will |
+ |
440 |
be kept if they have different annotations. For that to work properly, |
+ |
441 |
backends should store the related information on candidates using text |
+ |
442 |
properties. |
+ |
443 |
|
+ |
444 |
`deprecated': The second argument is a completion candidate. Return |
+ |
445 |
non-nil if the completion candidate is deprecated. |
+ |
446 |
|
+ |
447 |
`match': The second argument is a completion candidate. Return a positive |
+ |
448 |
integer, the index after the end of text matching `prefix' within the |
+ |
449 |
candidate string. Alternatively, return a list of (CHUNK-START |
+ |
450 |
. CHUNK-END) elements, where CHUNK-START and CHUNK-END are indexes within |
+ |
451 |
the candidate string. The corresponding regions are be used when rendering |
+ |
452 |
the popup. This command only makes sense for backends that provide |
+ |
453 |
non-prefix completion. |
+ |
454 |
|
+ |
455 |
`require-match': If this returns t, the user is not allowed to enter |
+ |
456 |
anything not offered as a candidate. Please don't use that value in normal |
+ |
457 |
backends. The default value nil gives the user that choice with |
+ |
458 |
`company-require-match'. Return value `never' overrides that option the |
+ |
459 |
other way around (using that value will indicate that the returned set of |
+ |
460 |
completions is often incomplete, so this behavior will not be useful). |
+ |
461 |
|
+ |
462 |
`init': Called once for each buffer. The backend can check for external |
+ |
463 |
programs and files and load any required libraries. Raising an error here |
+ |
464 |
will show up in message log once, and the backend will not be used for |
+ |
465 |
completion. |
+ |
466 |
|
+ |
467 |
`post-completion': Called after a completion candidate has been inserted |
+ |
468 |
into the buffer. The second argument is the candidate. Can be used to |
+ |
469 |
modify it, e.g. to expand a snippet. |
+ |
470 |
|
+ |
471 |
`kind': The second argument is a completion candidate. Return a symbol |
+ |
472 |
describing the kind of the candidate. Refer to `company-vscode-icons-mapping' |
+ |
473 |
for the possible values. |
+ |
474 |
|
+ |
475 |
`adjust-boundaries': The second argument is prefix and the third argument |
+ |
476 |
is suffix (previously returned by the `prefix' command). Return a |
+ |
477 |
cons (NEW-PREFIX . NEW-SUFFIX) where both parts correspond to the |
+ |
478 |
completion candidate. |
+ |
479 |
|
+ |
480 |
`expand-common': The first argument is prefix and the second argument is |
+ |
481 |
suffix. Return a cons (NEW-PREFIX . NEW-SUFFIX) that denote an edit in the |
+ |
482 |
current buffer which would be performed by `company-complete-common'. It |
+ |
483 |
should try to make the combined length of the prefix and suffix longer, |
+ |
484 |
while ensuring that the completions for the new inputs are the same. |
+ |
485 |
Othewise return the original inputs. If there are no matching completions, |
+ |
486 |
return the symbol `no-match'. |
+ |
487 |
|
+ |
488 |
The backend should return nil for all commands it does not support or |
+ |
489 |
does not know about. It should also be callable interactively and use |
+ |
490 |
`company-begin-backend' to start itself in that case. |
+ |
491 |
|
+ |
492 |
Grouped backends |
+ |
493 |
================ |
+ |
494 |
|
+ |
495 |
An element of `company-backends' can also be a list of backends. The |
+ |
496 |
completions from backends in such groups are merged, but only from those |
+ |
497 |
backends which return the same `prefix'. |
+ |
498 |
|
+ |
499 |
If a backend command takes a candidate as an argument (e.g. `meta'), the |
+ |
500 |
call is dispatched to the backend the candidate came from. In other |
+ |
501 |
cases (except for `duplicates' and `sorted'), the first non-nil value among |
+ |
502 |
all the backends is returned. |
+ |
503 |
|
+ |
504 |
The group can also contain keywords. Currently, `:with' and `:separate' |
+ |
505 |
keywords are defined. If the group contains keyword `:with', the backends |
+ |
506 |
listed after this keyword are ignored for the purpose of the `prefix' |
+ |
507 |
command. If the group contains keyword `:separate', the candidates that |
+ |
508 |
come from different backends are sorted separately in the combined list. |
+ |
509 |
|
+ |
510 |
Asynchronous backends |
+ |
511 |
===================== |
+ |
512 |
|
+ |
513 |
The return value of each command can also be a cons (:async . FETCHER) |
+ |
514 |
where FETCHER is a function of one argument, CALLBACK. When the data |
+ |
515 |
arrives, FETCHER must call CALLBACK and pass it the appropriate return |
+ |
516 |
value, as described above. That call must happen in the same buffer as |
+ |
517 |
where completion was initiated. |
+ |
518 |
|
+ |
519 |
True asynchronous operation is only supported for command `candidates', and |
+ |
520 |
only during idle completion. Other commands will block the user interface, |
+ |
521 |
even if the backend uses the asynchronous calling convention." |
+ |
522 |
:type `(repeat |
+ |
523 |
(choice |
+ |
524 |
:tag "backend" |
+ |
525 |
,@(mapcar (lambda (b) `(const :tag ,(cdr b) ,(car b))) |
+ |
526 |
company-safe-backends) |
+ |
527 |
(symbol :tag "User defined") |
+ |
528 |
(repeat :tag "Merged backends" |
+ |
529 |
(choice :tag "backend" |
+ |
530 |
,@(mapcar (lambda (b) |
+ |
531 |
`(const :tag ,(cdr b) ,(car b))) |
+ |
532 |
company-safe-backends) |
+ |
533 |
(const :tag "With" :with) |
+ |
534 |
(symbol :tag "User defined")))))) |
+ |
535 |
|
+ |
536 |
(put 'company-backends 'safe-local-variable 'company-safe-backends-p) |
+ |
537 |
|
+ |
538 |
(defcustom company-transformers nil |
+ |
539 |
"Functions to change the list of candidates received from backends. |
+ |
540 |
|
+ |
541 |
Each function gets called with the return value of the previous one. |
+ |
542 |
The first one gets passed the list of candidates, already sorted and |
+ |
543 |
without duplicates." |
+ |
544 |
:type '(choice |
+ |
545 |
(const :tag "None" nil) |
+ |
546 |
(const :tag "Sort by occurrence" (company-sort-by-occurrence)) |
+ |
547 |
(const :tag "Sort by backend importance" |
+ |
548 |
(company-sort-by-backend-importance)) |
+ |
549 |
(const :tag "Prefer case sensitive prefix" |
+ |
550 |
(company-sort-prefer-same-case-prefix)) |
+ |
551 |
(repeat :tag "User defined" function))) |
+ |
552 |
|
+ |
553 |
(defcustom company-completion-started-hook nil |
+ |
554 |
"Hook run when company starts completing. |
+ |
555 |
The hook is called with one argument that is non-nil if the completion was |
+ |
556 |
started manually." |
+ |
557 |
:type 'hook) |
+ |
558 |
|
+ |
559 |
(defcustom company-completion-cancelled-hook nil |
+ |
560 |
"Hook run when company cancels completing. |
+ |
561 |
The hook is called with one argument that is non-nil if the completion was |
+ |
562 |
aborted manually." |
+ |
563 |
:type 'hook) |
+ |
564 |
|
+ |
565 |
(defcustom company-completion-finished-hook nil |
+ |
566 |
"Hook run when company successfully completes. |
+ |
567 |
The hook is called with the selected candidate as an argument. |
+ |
568 |
|
+ |
569 |
If you indend to use it to post-process candidates from a specific |
+ |
570 |
backend, consider using the `post-completion' command instead." |
+ |
571 |
:type 'hook) |
+ |
572 |
|
+ |
573 |
(defcustom company-after-completion-hook nil |
+ |
574 |
"Hook run at the end of completion, successful or not. |
+ |
575 |
The hook is called with one argument which is either a string or a symbol." |
+ |
576 |
:type 'hook) |
+ |
577 |
|
+ |
578 |
(defcustom company-minimum-prefix-length 3 |
+ |
579 |
"The minimum prefix length for idle completion." |
+ |
580 |
:type '(integer :tag "prefix length")) |
+ |
581 |
|
+ |
582 |
(defcustom company-abort-manual-when-too-short nil |
+ |
583 |
"If enabled, cancel a manually started completion when the prefix gets |
+ |
584 |
shorter than both `company-minimum-prefix-length' and the length of the |
+ |
585 |
prefix it was started from." |
+ |
586 |
:type 'boolean |
+ |
587 |
:package-version '(company . "0.8.0")) |
+ |
588 |
|
+ |
589 |
(defcustom company-abort-on-unique-match t |
+ |
590 |
"If non-nil, typing a full unique match aborts completion. |
+ |
591 |
|
+ |
592 |
You can still invoke `company-complete' manually to run the |
+ |
593 |
`post-completion' handler, though. |
+ |
594 |
|
+ |
595 |
If it's nil, completion will remain active until you type a prefix that |
+ |
596 |
doesn't match anything or finish it manually, e.g. with RET." |
+ |
597 |
:type 'boolean) |
+ |
598 |
|
+ |
599 |
(defcustom company-require-match 'company-explicit-action-p |
+ |
600 |
"If enabled, disallow non-matching input. |
+ |
601 |
This can be a function do determine if a match is required. |
+ |
602 |
|
+ |
603 |
This can be overridden by the backend, if it returns t or `never' to |
+ |
604 |
`require-match'. `company-insertion-on-trigger' also takes precedence over |
+ |
605 |
this." |
+ |
606 |
:type '(choice (const :tag "Off" nil) |
+ |
607 |
(function :tag "Predicate function") |
+ |
608 |
(const :tag "On, if user interaction took place" |
+ |
609 |
company-explicit-action-p) |
+ |
610 |
(const :tag "On" t))) |
+ |
611 |
|
+ |
612 |
(define-obsolete-variable-alias |
+ |
613 |
'company-auto-complete |
+ |
614 |
'company-insertion-on-trigger |
+ |
615 |
"0.10.0") |
+ |
616 |
|
+ |
617 |
(define-obsolete-variable-alias |
+ |
618 |
'company-auto-commit |
+ |
619 |
'company-insertion-on-trigger |
+ |
620 |
"0.10.0") |
+ |
621 |
|
+ |
622 |
(defcustom company-insertion-on-trigger nil |
+ |
623 |
"If enabled, allow triggering insertion of the selected candidate. |
+ |
624 |
This can also be a predicate function, for example, |
+ |
625 |
`company-explicit-action-p'. |
+ |
626 |
|
+ |
627 |
See `company-insertion-triggers' for more details on how to define |
+ |
628 |
triggers." |
+ |
629 |
:type '(choice (const :tag "Off" nil) |
+ |
630 |
(function :tag "Predicate function") |
+ |
631 |
(const :tag "On, if user interaction took place" |
+ |
632 |
company-explicit-action-p) |
+ |
633 |
(const :tag "On" t)) |
+ |
634 |
:package-version '(company . "0.10.0")) |
+ |
635 |
|
+ |
636 |
(define-obsolete-variable-alias |
+ |
637 |
'company-auto-complete-chars |
+ |
638 |
'company-insertion-triggers |
+ |
639 |
"0.10.0") |
+ |
640 |
|
+ |
641 |
(define-obsolete-variable-alias |
+ |
642 |
'company-auto-commit-chars |
+ |
643 |
'company-insertion-triggers |
+ |
644 |
"0.10.0") |
+ |
645 |
|
+ |
646 |
(defcustom company-insertion-triggers '(?\ ?\) ?.) |
+ |
647 |
"Determine triggers for `company-insertion-on-trigger'. |
+ |
648 |
|
+ |
649 |
If this is a string, then each character in it can trigger insertion of the |
+ |
650 |
selected candidate. If it is a list of syntax description characters (see |
+ |
651 |
`modify-syntax-entry'), then characters with any of those syntaxes can act |
+ |
652 |
as triggers. |
+ |
653 |
|
+ |
654 |
This can also be a function, which is called with the new input. To |
+ |
655 |
trigger insertion, the function should return a non-nil value. |
+ |
656 |
|
+ |
657 |
Note that a character that is part of a valid completion never triggers |
+ |
658 |
insertion." |
+ |
659 |
:type '(choice (string :tag "Characters") |
+ |
660 |
(set :tag "Syntax" |
+ |
661 |
(const :tag "Whitespace" ?\ ) |
+ |
662 |
(const :tag "Symbol" ?_) |
+ |
663 |
(const :tag "Opening parentheses" ?\() |
+ |
664 |
(const :tag "Closing parentheses" ?\)) |
+ |
665 |
(const :tag "Word constituent" ?w) |
+ |
666 |
(const :tag "Punctuation." ?.) |
+ |
667 |
(const :tag "String quote." ?\") |
+ |
668 |
(const :tag "Paired delimiter." ?$) |
+ |
669 |
(const :tag "Expression quote or prefix operator." ?\') |
+ |
670 |
(const :tag "Comment starter." ?<) |
+ |
671 |
(const :tag "Comment ender." ?>) |
+ |
672 |
(const :tag "Character-quote." ?/) |
+ |
673 |
(const :tag "Generic string fence." ?|) |
+ |
674 |
(const :tag "Generic comment fence." ?!)) |
+ |
675 |
(function :tag "Predicate function")) |
+ |
676 |
:package-version '(company . "0.10.0")) |
+ |
677 |
|
+ |
678 |
(defcustom company-idle-delay .2 |
+ |
679 |
"The idle delay in seconds until completion starts automatically. |
+ |
680 |
The prefix still has to satisfy `company-minimum-prefix-length' before that |
+ |
681 |
happens. The value of nil means no idle completion." |
+ |
682 |
:type '(choice (const :tag "never (nil)" nil) |
+ |
683 |
(const :tag "immediate (0)" 0) |
+ |
684 |
(function :tag "Predicate function") |
+ |
685 |
(number :tag "seconds"))) |
+ |
686 |
|
+ |
687 |
(defcustom company-tooltip-idle-delay .5 |
+ |
688 |
"The idle delay in seconds until tooltip is shown when using |
+ |
689 |
`company-pseudo-tooltip-unless-just-one-frontend-with-delay'." |
+ |
690 |
:type '(choice (const :tag "never (nil)" nil) |
+ |
691 |
(const :tag "immediate (0)" 0) |
+ |
692 |
(number :tag "seconds"))) |
+ |
693 |
|
+ |
694 |
(defcustom company-inhibit-inside-symbols nil |
+ |
695 |
"Non-nil to inhibit idle completion when typing in the middle of a symbol. |
+ |
696 |
The symbol is in a generalized sense, indicated by the `prefix' backend |
+ |
697 |
action returning a non-empty SUFFIX element. When this variable is |
+ |
698 |
non-nil, completion inside symbol will onlytriggered by an explicit command |
+ |
699 |
invocation, such as \\[company-complete-common]." |
+ |
700 |
:type 'boolean |
+ |
701 |
:package-version '(company . "1.0.0")) |
+ |
702 |
|
+ |
703 |
(defcustom company-begin-commands '(self-insert-command |
+ |
704 |
org-self-insert-command |
+ |
705 |
orgtbl-self-insert-command |
+ |
706 |
c-scope-operator |
+ |
707 |
c-electric-colon |
+ |
708 |
c-electric-lt-gt |
+ |
709 |
c-electric-slash) |
+ |
710 |
"A list of commands after which idle completion is allowed. |
+ |
711 |
If this is t, it can show completions after any command except a few from a |
+ |
712 |
pre-defined list. See `company-idle-delay'. |
+ |
713 |
|
+ |
714 |
Alternatively, any command with a non-nil `company-begin' property is |
+ |
715 |
treated as if it was on this list." |
+ |
716 |
:type '(choice (const :tag "Any command" t) |
+ |
717 |
(const :tag "Self insert command" (self-insert-command)) |
+ |
718 |
(repeat :tag "Commands" function)) |
+ |
719 |
:package-version '(company . "0.8.4")) |
+ |
720 |
|
+ |
721 |
(defcustom company-continue-commands '(not save-buffer save-some-buffers |
+ |
722 |
save-buffers-kill-terminal |
+ |
723 |
save-buffers-kill-emacs |
+ |
724 |
completion-at-point |
+ |
725 |
complete-symbol |
+ |
726 |
completion-help-at-point) |
+ |
727 |
"A list of commands that are allowed during completion. |
+ |
728 |
If this is t, or if `company-begin-commands' is t, any command is allowed. |
+ |
729 |
Otherwise, the value must be a list of symbols. If it starts with `not', |
+ |
730 |
the cdr is the list of commands that abort completion. Otherwise, all |
+ |
731 |
commands except those in that list, or in `company-begin-commands', or |
+ |
732 |
commands in the `company-' namespace, abort completion." |
+ |
733 |
:type '(choice (const :tag "Any command" t) |
+ |
734 |
(cons :tag "Any except" |
+ |
735 |
(const not) |
+ |
736 |
(repeat :tag "Commands" function)) |
+ |
737 |
(repeat :tag "Commands" function))) |
+ |
738 |
|
+ |
739 |
(defun company-custom--set-quick-access (option value) |
+ |
740 |
"Re-bind quick-access key sequences on OPTION VALUE change." |
+ |
741 |
;; When upgrading from an earlier version of company, might not be. |
+ |
742 |
(when (fboundp #'company-keymap--unbind-quick-access) |
+ |
743 |
(when (boundp 'company-active-map) |
+ |
744 |
(company-keymap--unbind-quick-access company-active-map)) |
+ |
745 |
(when (boundp 'company-search-map) |
+ |
746 |
(company-keymap--unbind-quick-access company-search-map))) |
+ |
747 |
(custom-set-default option value) |
+ |
748 |
(when (fboundp #'company-keymap--bind-quick-access) |
+ |
749 |
(when (boundp 'company-active-map) |
+ |
750 |
(company-keymap--bind-quick-access company-active-map)) |
+ |
751 |
(when (boundp 'company-search-map) |
+ |
752 |
(company-keymap--bind-quick-access company-search-map)))) |
+ |
753 |
|
+ |
754 |
(defcustom company-quick-access-keys '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0") |
+ |
755 |
"Character strings used as a part of quick-access key sequences. |
+ |
756 |
To change this value without Customize interface, use `customize-set-variable'. |
+ |
757 |
|
+ |
758 |
To change the quick-access key sequences modifier, customize |
+ |
759 |
`company-quick-access-modifier'. |
+ |
760 |
|
+ |
761 |
If `company-show-quick-access' is non-nil, show quick-access hints |
+ |
762 |
beside the candidates." |
+ |
763 |
:set #'company-custom--set-quick-access |
+ |
764 |
:type '(choice |
+ |
765 |
(const :tag "Digits" ("1" "2" "3" "4" "5" "6" "7" "8" "9" "0")) |
+ |
766 |
(const :tag "QWERTY home row" ("a" "s" "d" "f" "g" "h" "j" "k" "l" ";")) |
+ |
767 |
;; TODO un-comment on removal of `M-n' `company--select-next-and-warn'. |
+ |
768 |
;; (const :tag "Dvorak home row" ("a" "o" "e" "u" "i" "d" "h" "t" "n" "s")) |
+ |
769 |
(repeat :tag "User defined" string)) |
+ |
770 |
:package-version '(company . "0.10.0")) |
+ |
771 |
|
+ |
772 |
(defcustom company-quick-access-modifier 'meta |
+ |
773 |
"Modifier key used for quick-access keys sequences. |
+ |
774 |
To change this value without Customize interface, use `customize-set-variable'. |
+ |
775 |
See `company-quick-access-keys' for more details." |
+ |
776 |
:set #'company-custom--set-quick-access |
+ |
777 |
:type '(choice (const :tag "Meta key" meta) |
+ |
778 |
(const :tag "Super key" super) |
+ |
779 |
(const :tag "Hyper key" hyper) |
+ |
780 |
(const :tag "Control key" control)) |
+ |
781 |
:package-version '(company . "0.10.0")) |
+ |
782 |
|
+ |
783 |
(defun company-keymap--quick-access-modifier () |
+ |
784 |
"Return string representation of the `company-quick-access-modifier'." |
+ |
785 |
(if-let* ((modifier (assoc-default company-quick-access-modifier |
+ |
786 |
'((meta . "M") |
+ |
787 |
(super . "s") |
+ |
788 |
(hyper . "H") |
+ |
789 |
(control . "C"))))) |
+ |
790 |
modifier |
+ |
791 |
(warn "company-quick-access-modifier value unknown: %S" |
+ |
792 |
company-quick-access-modifier) |
+ |
793 |
"M")) |
+ |
794 |
|
+ |
795 |
(defun company-keymap--unbind-quick-access (keymap) |
+ |
796 |
(let ((modifier (company-keymap--quick-access-modifier))) |
+ |
797 |
(dolist (key company-quick-access-keys) |
+ |
798 |
(let ((key-seq (company-keymap--kbd-quick-access modifier key))) |
+ |
799 |
(when (equal (lookup-key keymap key-seq) 'company-complete-quick-access) |
+ |
800 |
(define-key keymap key-seq nil)))))) |
+ |
801 |
|
+ |
802 |
(defun company-keymap--bind-quick-access (keymap) |
+ |
803 |
(let ((modifier (company-keymap--quick-access-modifier))) |
+ |
804 |
(dolist (key company-quick-access-keys) |
+ |
805 |
(let ((key-seq (company-keymap--kbd-quick-access modifier key))) |
+ |
806 |
(if (lookup-key keymap key-seq) |
+ |
807 |
(warn "Key sequence %s already bound" (key-description key-seq)) |
+ |
808 |
(define-key keymap key-seq #'company-complete-quick-access)))))) |
+ |
809 |
|
+ |
810 |
(defun company-keymap--kbd-quick-access (modifier key) |
+ |
811 |
(kbd (format "%s-%s" modifier key))) |
+ |
812 |
|
+ |
813 |
(define-obsolete-variable-alias |
+ |
814 |
'company-show-numbers |
+ |
815 |
'company-show-quick-access |
+ |
816 |
"0.10.0") |
+ |
817 |
|
+ |
818 |
(defcustom company-show-quick-access nil |
+ |
819 |
"If non-nil, show quick-access hints beside the candidates. |
+ |
820 |
|
+ |
821 |
For a tooltip frontend, non-nil value enables a column with the hints |
+ |
822 |
on the right side of the tooltip, unless the configured value is `left'. |
+ |
823 |
|
+ |
824 |
To change the quick-access key bindings, customize `company-quick-access-keys' |
+ |
825 |
and `company-quick-access-modifier'. |
+ |
826 |
|
+ |
827 |
To change the shown quick-access hints, customize |
+ |
828 |
`company-quick-access-hint-function'." |
+ |
829 |
:type '(choice (const :tag "off" nil) |
+ |
830 |
(const :tag "left" left) |
+ |
831 |
(const :tag "on" t))) |
+ |
832 |
|
+ |
833 |
(defcustom company-show-numbers-function nil |
+ |
834 |
"Function called to get quick-access numbers for the first ten candidates. |
+ |
835 |
|
+ |
836 |
The function receives the candidate number (starting from 1) and should |
+ |
837 |
return a string prefixed with one space." |
+ |
838 |
:type 'function) |
+ |
839 |
(make-obsolete-variable |
+ |
840 |
'company-show-numbers-function |
+ |
841 |
"use `company-quick-access-hint-function' instead, |
+ |
842 |
but adjust the expected values appropriately." |
+ |
843 |
"0.10.0") |
+ |
844 |
|
+ |
845 |
(defcustom company-quick-access-hint-function #'company-quick-access-hint-key |
+ |
846 |
"Function called to get quick-access hints for the candidates. |
+ |
847 |
|
+ |
848 |
The function receives a candidate's 0-based number |
+ |
849 |
and should return a string. |
+ |
850 |
See `company-show-quick-access' for more details." |
+ |
851 |
:type 'function) |
+ |
852 |
|
+ |
853 |
(defun company-quick-access-hint-key (candidate) |
+ |
854 |
"Return a quick-access key for the CANDIDATE number. |
+ |
855 |
This is a default value of `company-quick-access-hint-function'." |
+ |
856 |
(if company-show-numbers-function |
+ |
857 |
(funcall company-show-numbers-function (1+ candidate)) |
+ |
858 |
(format "%s" |
+ |
859 |
(if (< candidate (length company-quick-access-keys)) |
+ |
860 |
(nth candidate company-quick-access-keys) |
+ |
861 |
"")))) |
+ |
862 |
|
+ |
863 |
(defcustom company-selection-wrap-around nil |
+ |
864 |
"If enabled, selecting item before first or after last wraps around." |
+ |
865 |
:type '(choice (const :tag "off" nil) |
+ |
866 |
(const :tag "on" t))) |
+ |
867 |
|
+ |
868 |
(defcustom company-async-redisplay-delay 0.005 |
+ |
869 |
"Delay before redisplay when fetching candidates asynchronously. |
+ |
870 |
|
+ |
871 |
You might want to set this to a higher value if your backends respond |
+ |
872 |
quickly, to avoid redisplaying twice per each typed character." |
+ |
873 |
:type 'number) |
+ |
874 |
|
+ |
875 |
(defvar company-async-wait 0.03 |
+ |
876 |
"Pause between checks to see if the value's been set when turning an |
+ |
877 |
asynchronous call into synchronous.") |
+ |
878 |
|
+ |
879 |
(defvar company-async-timeout 2 |
+ |
880 |
"Maximum wait time for a value to be set during asynchronous call.") |
+ |
881 |
|
+ |
882 |
;;; mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
+ |
883 |
|
+ |
884 |
(defvar company-mode-map (make-sparse-keymap) |
+ |
885 |
"Keymap used by `company-mode'.") |
+ |
886 |
|
+ |
887 |
(defvar company-active-map |
+ |
888 |
(let ((keymap (make-sparse-keymap))) |
+ |
889 |
(define-key keymap "\e\e\e" 'company-abort) |
+ |
890 |
(define-key keymap "\C-g" 'company-abort) |
+ |
891 |
(define-key keymap (kbd "M-n") 'company--select-next-and-warn) |
+ |
892 |
(define-key keymap (kbd "M-p") 'company--select-previous-and-warn) |
+ |
893 |
(define-key keymap (kbd "C-n") 'company-select-next-or-abort) |
+ |
894 |
(define-key keymap (kbd "C-p") 'company-select-previous-or-abort) |
+ |
895 |
(define-key keymap (kbd "<down>") 'company-select-next-or-abort) |
+ |
896 |
(define-key keymap (kbd "<up>") 'company-select-previous-or-abort) |
+ |
897 |
(define-key keymap [remap scroll-up-command] 'company-next-page) |
+ |
898 |
(define-key keymap [remap scroll-down-command] 'company-previous-page) |
+ |
899 |
(define-key keymap [down-mouse-1] 'ignore) |
+ |
900 |
(define-key keymap [down-mouse-3] 'ignore) |
+ |
901 |
(define-key keymap [mouse-1] 'company-complete-mouse) |
+ |
902 |
(define-key keymap [mouse-3] 'company-select-mouse) |
+ |
903 |
(define-key keymap [up-mouse-1] 'ignore) |
+ |
904 |
(define-key keymap [up-mouse-3] 'ignore) |
+ |
905 |
(define-key keymap [return] 'company-complete-selection) |
+ |
906 |
(define-key keymap (kbd "RET") 'company-complete-selection) |
+ |
907 |
(define-key keymap [tab] 'company-complete-common-or-cycle) |
+ |
908 |
(define-key keymap (kbd "TAB") 'company-complete-common-or-cycle) |
+ |
909 |
(define-key keymap [backtab] 'company-cycle-backward) |
+ |
910 |
(define-key keymap (kbd "<f1>") 'company-show-doc-buffer) |
+ |
911 |
(define-key keymap (kbd "C-h") 'company-show-doc-buffer) |
+ |
912 |
(define-key keymap "\C-w" 'company-show-location) |
+ |
913 |
(define-key keymap "\C-s" 'company-search-candidates) |
+ |
914 |
(define-key keymap "\C-\M-s" 'company-filter-candidates) |
+ |
915 |
(company-keymap--bind-quick-access keymap) |
+ |
916 |
keymap) |
+ |
917 |
"Keymap that is enabled during an active completion.") |
+ |
918 |
|
+ |
919 |
(defvar company--disabled-backends nil) |
+ |
920 |
|
+ |
921 |
(defun company--select-next-and-warn (&optional arg) |
+ |
922 |
(interactive "p") |
+ |
923 |
(company--warn-changed-binding) |
+ |
924 |
(company-select-next arg)) |
+ |
925 |
|
+ |
926 |
(defun company--select-previous-and-warn (&optional arg) |
+ |
927 |
(interactive "p") |
+ |
928 |
(company--warn-changed-binding) |
+ |
929 |
(company-select-previous arg)) |
+ |
930 |
|
+ |
931 |
(defun company--warn-changed-binding () |
+ |
932 |
(interactive) |
+ |
933 |
(run-with-idle-timer |
+ |
934 |
0.01 nil |
+ |
935 |
(lambda () |
+ |
936 |
(message "Warning: default bindings are being changed to C-n and C-p")))) |
+ |
937 |
|
+ |
938 |
(defun company-init-backend (backend) |
+ |
939 |
(and (symbolp backend) |
+ |
940 |
(not (fboundp backend)) |
+ |
941 |
(ignore-errors (require backend nil t))) |
+ |
942 |
(cond |
+ |
943 |
((symbolp backend) |
+ |
944 |
(condition-case err |
+ |
945 |
(progn |
+ |
946 |
(funcall backend 'init) |
+ |
947 |
(put backend 'company-init t)) |
+ |
948 |
(error |
+ |
949 |
(put backend 'company-init 'failed) |
+ |
950 |
(unless (memq backend company--disabled-backends) |
+ |
951 |
(message "Company backend '%s' could not be initialized:\n%s" |
+ |
952 |
backend (error-message-string err))) |
+ |
953 |
(cl-pushnew backend company--disabled-backends) |
+ |
954 |
nil))) |
+ |
955 |
;; No initialization for lambdas. |
+ |
956 |
((functionp backend) t) |
+ |
957 |
(t ;; Must be a list. |
+ |
958 |
(cl-dolist (b backend) |
+ |
959 |
(unless (keywordp b) |
+ |
960 |
(company-init-backend b)))))) |
+ |
961 |
|
+ |
962 |
(defun company--maybe-init-backend (backend) |
+ |
963 |
(or (not (symbolp backend)) |
+ |
964 |
(eq t (get backend 'company-init)) |
+ |
965 |
(unless (get backend 'company-init) |
+ |
966 |
(company-init-backend backend)))) |
+ |
967 |
|
+ |
968 |
(defcustom company-lighter-base "company" |
+ |
969 |
"Base string to use for the `company-mode' lighter." |
+ |
970 |
:type 'string |
+ |
971 |
:package-version '(company . "0.8.10")) |
+ |
972 |
|
+ |
973 |
(defvar company-lighter '(" " |
+ |
974 |
(company-candidates |
+ |
975 |
(:eval |
+ |
976 |
(if (consp company-backend) |
+ |
977 |
(when company-selection |
+ |
978 |
(company--group-lighter (nth company-selection |
+ |
979 |
company-candidates) |
+ |
980 |
company-lighter-base)) |
+ |
981 |
(symbol-name company-backend))) |
+ |
982 |
company-lighter-base)) |
+ |
983 |
"Mode line lighter for Company. |
+ |
984 |
|
+ |
985 |
The value of this variable is a mode line template as in |
+ |
986 |
`mode-line-format'.") |
+ |
987 |
|
+ |
988 |
(put 'company-lighter 'risky-local-variable t) |
+ |
989 |
|
+ |
990 |
;;;###autoload |
+ |
991 |
(define-minor-mode company-mode |
+ |
992 |
"\"complete anything\"; is an in-buffer completion framework. |
+ |
993 |
Completion starts automatically, depending on the values |
+ |
994 |
`company-idle-delay' and `company-minimum-prefix-length'. |
+ |
995 |
|
+ |
996 |
Completion can be controlled with the commands: |
+ |
997 |
`company-complete-common', `company-complete-selection', `company-complete', |
+ |
998 |
`company-select-next', `company-select-previous'. If these commands are |
+ |
999 |
called before `company-idle-delay', completion will also start. |
+ |
1000 |
|
+ |
1001 |
Completions can be searched with `company-search-candidates' or |
+ |
1002 |
`company-filter-candidates'. These can be used while completion is |
+ |
1003 |
inactive, as well. |
+ |
1004 |
|
+ |
1005 |
The completion data is retrieved using `company-backends' and displayed |
+ |
1006 |
using `company-frontends'. If you want to start a specific backend, call |
+ |
1007 |
it interactively or use `company-begin-backend'. |
+ |
1008 |
|
+ |
1009 |
By default, the completions list is sorted alphabetically, unless the |
+ |
1010 |
backend chooses otherwise, or `company-transformers' changes it later. |
+ |
1011 |
|
+ |
1012 |
regular keymap (`company-mode-map'): |
+ |
1013 |
|
+ |
1014 |
\\{company-mode-map} |
+ |
1015 |
keymap during active completions (`company-active-map'): |
+ |
1016 |
|
+ |
1017 |
\\{company-active-map}" |
+ |
1018 |
:lighter company-lighter |
+ |
1019 |
(if company-mode |
+ |
1020 |
(progn |
+ |
1021 |
(add-hook 'pre-command-hook 'company-pre-command nil t) |
+ |
1022 |
(add-hook 'post-command-hook 'company-post-command nil t) |
+ |
1023 |
(add-hook 'yas-keymap-disable-hook 'company--active-p nil t) |
+ |
1024 |
(mapc 'company-init-backend company-backends)) |
+ |
1025 |
(remove-hook 'pre-command-hook 'company-pre-command t) |
+ |
1026 |
(remove-hook 'post-command-hook 'company-post-command t) |
+ |
1027 |
(remove-hook 'yas-keymap-disable-hook 'company--active-p t) |
+ |
1028 |
(company-cancel))) |
+ |
1029 |
|
+ |
1030 |
(defcustom company-global-modes t |
+ |
1031 |
"Modes for which `company-mode' mode is turned on by `global-company-mode'. |
+ |
1032 |
If nil, means no modes. If t, then all major modes have it turned on. |
+ |
1033 |
If a list, it should be a list of `major-mode' symbol names for which |
+ |
1034 |
`company-mode' should be automatically turned on. The sense of the list is |
+ |
1035 |
negated if it begins with `not'. For example: |
+ |
1036 |
(c-mode c++-mode) |
+ |
1037 |
means that `company-mode' is turned on for buffers in C and C++ modes only. |
+ |
1038 |
(not message-mode) |
+ |
1039 |
means that `company-mode' is always turned on except in `message-mode' buffers." |
+ |
1040 |
:type '(choice (const :tag "none" nil) |
+ |
1041 |
(const :tag "all" t) |
+ |
1042 |
(set :menu-tag "mode specific" :tag "modes" |
+ |
1043 |
:value (not) |
+ |
1044 |
(const :tag "Except" not) |
+ |
1045 |
(repeat :inline t (symbol :tag "mode"))))) |
+ |
1046 |
|
+ |
1047 |
;;;###autoload |
+ |
1048 |
(define-globalized-minor-mode global-company-mode company-mode company-mode-on) |
+ |
1049 |
|
+ |
1050 |
(defun company-mode-on () |
+ |
1051 |
(when (and (not (or noninteractive (eq (aref (buffer-name) 0) ?\s))) |
+ |
1052 |
(cond ((eq company-global-modes t) |
+ |
1053 |
t) |
+ |
1054 |
((eq (car-safe company-global-modes) 'not) |
+ |
1055 |
(not (memq major-mode (cdr company-global-modes)))) |
+ |
1056 |
(t (memq major-mode company-global-modes)))) |
+ |
1057 |
(company-mode 1))) |
+ |
1058 |
|
+ |
1059 |
(defsubst company-assert-enabled () |
+ |
1060 |
(unless company-mode |
+ |
1061 |
(company-uninstall-map) |
+ |
1062 |
(user-error "Company not enabled"))) |
+ |
1063 |
|
+ |
1064 |
;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
+ |
1065 |
|
+ |
1066 |
(defvar-local company-my-keymap nil) |
+ |
1067 |
|
+ |
1068 |
(defvar company-emulation-alist '((t . nil))) |
+ |
1069 |
|
+ |
1070 |
(defun company-enable-overriding-keymap (keymap) |
+ |
1071 |
(company-uninstall-map) |
+ |
1072 |
(setq company-my-keymap keymap)) |
+ |
1073 |
|
+ |
1074 |
(defun company-ensure-emulation-alist () |
+ |
1075 |
(unless (eq 'company-emulation-alist (car emulation-mode-map-alists)) |
+ |
1076 |
(setq emulation-mode-map-alists |
+ |
1077 |
(cons 'company-emulation-alist |
+ |
1078 |
(delq 'company-emulation-alist emulation-mode-map-alists))))) |
+ |
1079 |
|
+ |
1080 |
(defun company-install-map () |
+ |
1081 |
(unless (or (cdar company-emulation-alist) |
+ |
1082 |
(null company-my-keymap)) |
+ |
1083 |
(setq-local company-emulation-alist `((t . ,company-my-keymap))))) |
+ |
1084 |
|
+ |
1085 |
(defun company-uninstall-map () |
+ |
1086 |
(kill-local-variable 'company-emulation-alist)) |
+ |
1087 |
|
+ |
1088 |
(defun company--company-command-p (keys) |
+ |
1089 |
"Checks if the keys are part of company's overriding keymap" |
+ |
1090 |
(or (equal [company-dummy-event] keys) |
+ |
1091 |
(commandp (lookup-key company-my-keymap keys)))) |
+ |
1092 |
|
+ |
1093 |
;; To avoid warnings in Emacs < 26. |
+ |
1094 |
(declare-function line-number-display-width "indent.c") |
+ |
1095 |
|
+ |
1096 |
(defun company--posn-col-row (posn) |
+ |
1097 |
(let* ((col-row (if (>= emacs-major-version 29) |
+ |
1098 |
(with-no-warnings ;with 2 arguments, but accepts only 1 |
+ |
1099 |
(posn-col-row posn t)) |
+ |
1100 |
(posn-col-row posn))) |
+ |
1101 |
(col (car col-row)) |
+ |
1102 |
;; `posn-col-row' doesn't work well with lines of different height. |
+ |
1103 |
;; `posn-actual-col-row' doesn't handle multiple-width characters. |
+ |
1104 |
(row (cdr (or (posn-actual-col-row posn) |
+ |
1105 |
;; When position is non-visible for some reason. |
+ |
1106 |
col-row)))) |
+ |
1107 |
;; posn-col-row return value relative to the left |
+ |
1108 |
(when (eq (current-bidi-paragraph-direction) 'right-to-left) |
+ |
1109 |
;; `remap' as 3rd argument to window-body-width is E30+ only :-( |
+ |
1110 |
(let ((ww (window-body-width))) |
+ |
1111 |
(setq col (- ww col)))) |
+ |
1112 |
(when (bound-and-true-p display-line-numbers) |
+ |
1113 |
(cl-decf col (+ 2 (line-number-display-width)))) |
+ |
1114 |
(cons (+ col (window-hscroll)) row))) |
+ |
1115 |
|
+ |
1116 |
(defun company--col-row (&optional pos) |
+ |
1117 |
(company--posn-col-row (posn-at-point pos))) |
+ |
1118 |
|
+ |
1119 |
(defun company--row (&optional pos) |
+ |
1120 |
(cdr (company--col-row pos))) |
+ |
1121 |
|
+ |
1122 |
;;; backends ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
+ |
1123 |
|
+ |
1124 |
(defvar-local company-backend nil) |
+ |
1125 |
|
+ |
1126 |
(defun company-grab (regexp &optional expression limit) |
+ |
1127 |
(when (looking-back regexp limit) |
+ |
1128 |
(or (match-string-no-properties (or expression 0)) ""))) |
+ |
1129 |
|
+ |
1130 |
(defun company-grab-suffix (regexp &optional expression) |
+ |
1131 |
(when (looking-at regexp) |
+ |
1132 |
(or (match-string-no-properties (or expression 0)) ""))) |
+ |
1133 |
|
+ |
1134 |
(defun company-grab-line (regexp &optional expression) |
+ |
1135 |
"Return a match string for REGEXP if it matches text before point. |
+ |
1136 |
If EXPRESSION is non-nil, return the match string for the respective |
+ |
1137 |
parenthesized expression in REGEXP. |
+ |
1138 |
Matching is limited to the current line." |
+ |
1139 |
(let ((inhibit-field-text-motion t)) |
+ |
1140 |
(company-grab regexp expression (line-beginning-position)))) |
+ |
1141 |
|
+ |
1142 |
(defun company-grab-symbol () |
+ |
1143 |
"Return buffer substring from the beginning of the symbol until point." |
+ |
1144 |
(buffer-substring (point) (save-excursion (skip-syntax-backward "w_") |
+ |
1145 |
(point)))) |
+ |
1146 |
|
+ |
1147 |
(defun company-grab-symbol-suffix () |
+ |
1148 |
"Return buffer substring from point until the end of the symbol." |
+ |
1149 |
(buffer-substring (point) (save-excursion (skip-syntax-forward "w_") |
+ |
1150 |
(point)))) |
+ |
1151 |
|
+ |
1152 |
(defun company-grab-word () |
+ |
1153 |
"Return buffer substring from the beginning of the word until point." |
+ |
1154 |
(buffer-substring (point) (save-excursion (skip-syntax-backward "w") |
+ |
1155 |
(point)))) |
+ |
1156 |
|
+ |
1157 |
(defun company-grab-word-suffix () |
+ |
1158 |
"Return buffer substring from the beginning of the word until point." |
+ |
1159 |
(buffer-substring (point) (save-excursion (skip-syntax-forward "w") |
+ |
1160 |
(point)))) |
+ |
1161 |
|
+ |
1162 |
(defun company-grab-symbol-parts (&optional idle-begin-after-re max-len) |
+ |
1163 |
"Return a list (PREFIX SUFFIX &optional OVERRIDE). |
+ |
1164 |
|
+ |
1165 |
IDLE-BEGIN-AFTER-RE, if non-nil, must be a regexp. |
+ |
1166 |
|
+ |
1167 |
Where OVERRIDE might be t is IDLE-BEGIN-AFTER-RE is non-nil and the text |
+ |
1168 |
before prefix matches it. PREFIX and SUFFIX are as returned by |
+ |
1169 |
`company-grab-symbol' and `company-grab-symbol-suffix'. |
+ |
1170 |
MAX-LEN is how far back to try to match the IDLE-BEGIN-AFTER-RE regexp." |
+ |
1171 |
(let ((prefix (company-grab-symbol)) |
+ |
1172 |
suffix override) |
+ |
1173 |
(setq suffix (company-grab-symbol-suffix)) |
+ |
1174 |
(when idle-begin-after-re |
+ |
1175 |
(save-excursion |
+ |
1176 |
(forward-char (- (length prefix))) |
+ |
1177 |
(when (looking-back idle-begin-after-re (if max-len |
+ |
1178 |
(- (point) max-len) |
+ |
1179 |
(line-beginning-position))) |
+ |
1180 |
(setq override t)))) |
+ |
1181 |
(list prefix suffix override))) |
+ |
1182 |
|
+ |
1183 |
(define-obsolete-function-alias |
+ |
1184 |
'company-grab-symbol-cons |
+ |
1185 |
'company-grab-symbol-parts "1.0") |
+ |
1186 |
|
+ |
1187 |
(defun company-in-string-or-comment () |
+ |
1188 |
"Return non-nil if point is within a string or comment." |
+ |
1189 |
(let ((ppss (syntax-ppss))) |
+ |
1190 |
(or (car (setq ppss (nthcdr 3 ppss))) |
+ |
1191 |
(car (setq ppss (cdr ppss))) |
+ |
1192 |
(nth 3 ppss)))) |
+ |
1193 |
|
+ |
1194 |
(defun company-substitute-prefix (prefix strings) |
+ |
1195 |
(let ((len (length prefix))) |
+ |
1196 |
(mapcar |
+ |
1197 |
(lambda (s) |
+ |
1198 |
(if (eq t (compare-strings prefix 0 len s 0 len)) |
+ |
1199 |
s |
+ |
1200 |
(concat prefix (substring s len)))) |
+ |
1201 |
strings))) |
+ |
1202 |
|
+ |
1203 |
(defun company--match-from-capf-face (str) |
+ |
1204 |
"Compute `match' result from a CAPF's completion fontification." |
+ |
1205 |
(let* ((match-start nil) (pos -1) |
+ |
1206 |
(prop-value nil) (faces nil) |
+ |
1207 |
(has-face-p nil) chunks |
+ |
1208 |
(limit (length str))) |
+ |
1209 |
(while (< pos limit) |
+ |
1210 |
(setq pos |
+ |
1211 |
(if (< pos 0) 0 (next-property-change pos str limit))) |
+ |
1212 |
(setq prop-value (or (get-text-property pos 'face str) |
+ |
1213 |
(get-text-property pos 'font-lock-face str)) |
+ |
1214 |
faces (if (listp prop-value) prop-value (list prop-value)) |
+ |
1215 |
has-face-p (memq 'completions-common-part faces)) |
+ |
1216 |
(cond ((and (not match-start) has-face-p) |
+ |
1217 |
(setq match-start pos)) |
+ |
1218 |
((and match-start (not has-face-p)) |
+ |
1219 |
(push (cons match-start pos) chunks) |
+ |
1220 |
(setq match-start nil)))) |
+ |
1221 |
(nreverse chunks))) |
+ |
1222 |
|
+ |
1223 |
(defun company--capf-completions (prefix suffix table &optional pred meta) |
+ |
1224 |
(cl-letf* ((keep-suffix t) |
+ |
1225 |
(wrapper |
+ |
1226 |
(lambda (&rest args) |
+ |
1227 |
;; If emacs22 style is used, suffix is ignored. |
+ |
1228 |
;; That's the only popular completion style that does this. |
+ |
1229 |
(let ((res (apply #'completion-emacs22-all-completions args))) |
+ |
1230 |
(when res (setq keep-suffix nil)) |
+ |
1231 |
res))) |
+ |
1232 |
(completion-styles-alist (copy-tree completion-styles-alist)) |
+ |
1233 |
((nth 2 (assoc 'emacs22 completion-styles-alist)) |
+ |
1234 |
wrapper) |
+ |
1235 |
(all (completion-all-completions (concat prefix suffix) |
+ |
1236 |
table pred |
+ |
1237 |
(length prefix) |
+ |
1238 |
meta)) |
+ |
1239 |
(last (last all)) |
+ |
1240 |
(base-size (or (cdr last) 0)) |
+ |
1241 |
;; base-suffix-size is not available, but it's usually simple. |
+ |
1242 |
(bounds (completion-boundaries prefix table pred suffix))) |
+ |
1243 |
(when last |
+ |
1244 |
(setcdr last nil)) |
+ |
1245 |
(unless keep-suffix |
+ |
1246 |
(setcdr bounds 0)) |
+ |
1247 |
`((:completions . ,all) |
+ |
1248 |
(:boundaries . ,(cons (substring prefix base-size) |
+ |
1249 |
(substring suffix 0 (cdr bounds))))))) |
+ |
1250 |
|
+ |
1251 |
(defun company--capf-expand-common (prefix suffix table &optional pred metadata) |
+ |
1252 |
(let* ((res |
+ |
1253 |
(completion-try-completion (concat prefix suffix) |
+ |
1254 |
table pred (length prefix) metadata))) |
+ |
1255 |
(cond |
+ |
1256 |
((null res) |
+ |
1257 |
'no-match) |
+ |
1258 |
((memq res '(t nil)) |
+ |
1259 |
(cons prefix suffix)) |
+ |
1260 |
(t |
+ |
1261 |
(cons |
+ |
1262 |
(substring (car res) 0 (cdr res)) |
+ |
1263 |
(substring (car res) (cdr res))))))) |
+ |
1264 |
|
+ |
1265 |
;; We store boundaries as markers because when the `unhide' frontend action is |
+ |
1266 |
;; called, the completions are still being fetched. So the capf boundaries info |
+ |
1267 |
;; can't be relied to be fresh by other means. |
+ |
1268 |
(defun company--capf-boundaries-markers (string-pair &optional markers) |
+ |
1269 |
"STRING-PAIR is (PREFIX . SUFFIX) and MARKERS is a pair to reuse." |
+ |
1270 |
(when (or (not markers) |
+ |
1271 |
(stringp (car markers))) |
+ |
1272 |
(setq markers (cons (make-marker) |
+ |
1273 |
(make-marker)))) |
+ |
1274 |
(move-marker (car markers) (- (point) (length (car string-pair)))) |
+ |
1275 |
(move-marker (cdr markers) (+ (point) (length (cdr string-pair)))) |
+ |
1276 |
markers) |
+ |
1277 |
|
+ |
1278 |
(defun company--capf-boundaries (markers) |
+ |
1279 |
(let* ((beg (car markers)) |
+ |
1280 |
(end (cdr markers)) |
+ |
1281 |
res) |
+ |
1282 |
(when (> (point) end) (setq end (point))) |
+ |
1283 |
(setq res (cons (buffer-substring beg (point)) |
+ |
1284 |
(buffer-substring (point) end))) |
+ |
1285 |
res)) |
+ |
1286 |
|
+ |
1287 |
(defvar company--cache (make-hash-table :test #'equal :size 10)) |
+ |
1288 |
|
+ |
1289 |
(cl-defun company-cache-fetch (key |
+ |
1290 |
fetcher |
+ |
1291 |
&key expire check-tag) |
+ |
1292 |
"Fetch the value assigned to KEY in the cache. |
+ |
1293 |
When not found, or when found to be stale, calls FETCHER to compute the |
+ |
1294 |
result. When EXPIRE is non-nil, the value will be deleted at the end of |
+ |
1295 |
completion. CHECK-TAG, when present, is saved as well, and the entry will |
+ |
1296 |
be recomputed when this value changes." |
+ |
1297 |
;; We could make EXPIRE accept a time value as well. |
+ |
1298 |
(let ((res (gethash key company--cache 'none)) |
+ |
1299 |
value) |
+ |
1300 |
(if (and (not (eq res 'none)) |
+ |
1301 |
(or (not check-tag) |
+ |
1302 |
(equal check-tag (assoc-default :check-tag res)))) |
+ |
1303 |
(assoc-default :value res) |
+ |
1304 |
(setq res (list (cons :value (setq value (funcall fetcher))))) |
+ |
1305 |
(if expire (push '(:expire . t) res)) |
+ |
1306 |
(if check-tag (push `(:check-tag . ,check-tag) res)) |
+ |
1307 |
(puthash key res company--cache) |
+ |
1308 |
value))) |
+ |
1309 |
|
+ |
1310 |
(defun company-cache-delete (key) |
+ |
1311 |
"Delete KEY from cache." |
+ |
1312 |
(remhash key company--cache)) |
+ |
1313 |
|
+ |
1314 |
(defun company-cache-expire () |
+ |
1315 |
"Delete all keys from the cache that are set to be expired." |
+ |
1316 |
(maphash (lambda (k v) |
+ |
1317 |
(when (assoc-default :expire v) |
+ |
1318 |
(remhash k company--cache))) |
+ |
1319 |
company--cache)) |
+ |
1320 |
|
+ |
1321 |
(defun company-call-backend (&rest args) |
+ |
1322 |
(company--force-sync #'company-call-backend-raw args company-backend)) |
+ |
1323 |
|
+ |
1324 |
(defun company--force-sync (fun args backend) |
+ |
1325 |
(let ((value (apply fun args))) |
+ |
1326 |
(if (not (eq (car-safe value) :async)) |
+ |
1327 |
value |
+ |
1328 |
(let ((res 'trash) |
+ |
1329 |
(start (time-to-seconds))) |
+ |
1330 |
(funcall (cdr value) |
+ |
1331 |
(lambda (result) (setq res result))) |
+ |
1332 |
(while (eq res 'trash) |
+ |
1333 |
(if (> (- (time-to-seconds) start) company-async-timeout) |
+ |
1334 |
(error "Company: backend %s async timeout with args %s" |
+ |
1335 |
backend args) |
+ |
1336 |
;; XXX: Reusing the trick from company--fetch-candidates here |
+ |
1337 |
;; doesn't work well: sit-for isn't a good fit when we want to |
+ |
1338 |
;; ignore pending input (results in too many calls). |
+ |
1339 |
;; FIXME: We should deal with this by standardizing on a kind of |
+ |
1340 |
;; Future object that knows how to sync itself. In most cases (but |
+ |
1341 |
;; not all), by calling accept-process-output, probably. |
+ |
1342 |
(sleep-for company-async-wait))) |
+ |
1343 |
res)))) |
+ |
1344 |
|
+ |
1345 |
(defun company-call-backend-raw (&rest args) |
+ |
1346 |
(condition-case-unless-debug err |
+ |
1347 |
(if (functionp company-backend) |
+ |
1348 |
(apply company-backend args) |
+ |
1349 |
(apply #'company--multi-backend-adapter company-backend args)) |
+ |
1350 |
(user-error (user-error |
+ |
1351 |
"Company: backend %s user-error: %s" |
+ |
1352 |
company-backend (error-message-string err))) |
+ |
1353 |
(error (error "Company: backend %s error \"%s\" with args %s" |
+ |
1354 |
company-backend (error-message-string err) args)))) |
+ |
1355 |
|
+ |
1356 |
(defvar-local company--multi-uncached-backends nil) |
+ |
1357 |
(defvar-local company--multi-min-prefix nil) |
+ |
1358 |
|
+ |
1359 |
(defun company--multi-backend-adapter (backends command &rest args) |
+ |
1360 |
(let ((backends (cl-loop for b in backends |
+ |
1361 |
when (or (keywordp b) |
+ |
1362 |
(company--maybe-init-backend b)) |
+ |
1363 |
collect b)) |
+ |
1364 |
(separate (memq :separate backends))) |
+ |
1365 |
|
+ |
1366 |
(unless (eq command 'prefix) |
+ |
1367 |
(setq backends (cl-delete-if #'keywordp backends))) |
+ |
1368 |
|
+ |
1369 |
(pcase command |
+ |
1370 |
(`candidates |
+ |
1371 |
(company--multi-backend-adapter-candidates backends |
+ |
1372 |
(or company--multi-min-prefix 0) |
+ |
1373 |
separate)) |
+ |
1374 |
(`set-min-prefix (setq company--multi-min-prefix (car args))) |
+ |
1375 |
(`sorted separate) |
+ |
1376 |
(`duplicates (not separate)) |
+ |
1377 |
((and `no-cache |
+ |
1378 |
(pred (lambda (_) |
+ |
1379 |
(let* (found |
+ |
1380 |
(uncached company--multi-uncached-backends)) |
+ |
1381 |
(dolist (backend backends) |
+ |
1382 |
(when |
+ |
1383 |
(and (member backend uncached) |
+ |
1384 |
(company--good-prefix-p |
+ |
1385 |
(let ((company-backend backend)) |
+ |
1386 |
(company-call-backend 'prefix)) |
+ |
1387 |
(or company--multi-min-prefix 0))) |
+ |
1388 |
(setq found t |
+ |
1389 |
company--multi-uncached-backends |
+ |
1390 |
(delete backend |
+ |
1391 |
company--multi-uncached-backends)))) |
+ |
1392 |
found)))) |
+ |
1393 |
t) |
+ |
1394 |
((or `ignore-case `no-cache `require-match) |
+ |
1395 |
(let (value) |
+ |
1396 |
(cl-dolist (backend backends) |
+ |
1397 |
(when (setq value (company--force-sync |
+ |
1398 |
backend (cons command args) backend)) |
+ |
1399 |
(when (and (eq command 'ignore-case) |
+ |
1400 |
(eq value 'keep-prefix)) |
+ |
1401 |
(setq value t)) |
+ |
1402 |
(cl-return value))))) |
+ |
1403 |
(`prefix (company--multi-prefix backends)) |
+ |
1404 |
(`adjust-boundaries |
+ |
1405 |
(let ((arg (car args))) |
+ |
1406 |
(when (> (length arg) 0) |
+ |
1407 |
(let* ((backend (or (get-text-property 0 'company-backend arg) |
+ |
1408 |
(car backends))) |
+ |
1409 |
(entity (company--force-sync backend '(prefix) backend)) |
+ |
1410 |
(prefix (company--prefix-str entity)) |
+ |
1411 |
(suffix (company--suffix-str entity))) |
+ |
1412 |
(setq args (list arg prefix suffix)) |
+ |
1413 |
(or |
+ |
1414 |
(apply backend command args) |
+ |
1415 |
(cons prefix suffix)))))) |
+ |
1416 |
(`expand-common |
+ |
1417 |
(apply #'company--multi-expand-common |
+ |
1418 |
backends |
+ |
1419 |
(or company--multi-min-prefix 0) |
+ |
1420 |
args)) |
+ |
1421 |
(_ |
+ |
1422 |
(let ((arg (car args))) |
+ |
1423 |
(when (> (length arg) 0) |
+ |
1424 |
(let ((backend (or (get-text-property 0 'company-backend arg) |
+ |
1425 |
(car backends)))) |
+ |
1426 |
(apply backend command args)))))))) |
+ |
1427 |
|
+ |
1428 |
(defun company--multi-prefix (backends) |
+ |
1429 |
(let* ((backends-after-with (cdr (member :with backends))) |
+ |
1430 |
prefix suffix len) |
+ |
1431 |
|
+ |
1432 |
(dolist (backend backends) |
+ |
1433 |
(let* ((entity (and |
+ |
1434 |
(not (keywordp backend)) |
+ |
1435 |
(company--force-sync backend '(prefix) backend))) |
+ |
1436 |
(new-len (company--prefix-len entity))) |
+ |
1437 |
(when (stringp (company--prefix-str entity)) |
+ |
1438 |
(or (not backends-after-with) |
+ |
1439 |
(unless (memq backend backends-after-with) |
+ |
1440 |
(setq backends-after-with nil))) |
+ |
1441 |
(when (or |
+ |
1442 |
(null prefix) |
+ |
1443 |
(> (length (company--prefix-str entity)) |
+ |
1444 |
(length prefix))) |
+ |
1445 |
(setq prefix (company--prefix-str entity))) |
+ |
1446 |
(when (> (length (company--suffix-str entity)) |
+ |
1447 |
(length suffix)) |
+ |
1448 |
(setq suffix (company--suffix-str entity))) |
+ |
1449 |
(when (or (eq t new-len) |
+ |
1450 |
(and new-len |
+ |
1451 |
(not (eq t len)) |
+ |
1452 |
(or (not len) (> new-len len)))) |
+ |
1453 |
(setq len new-len))))) |
+ |
1454 |
(when (and prefix |
+ |
1455 |
(not backends-after-with)) |
+ |
1456 |
(list prefix suffix len)))) |
+ |
1457 |
|
+ |
1458 |
(defun company--multi-expand-common (backends min-length prefix suffix) |
+ |
1459 |
(let ((tuples |
+ |
1460 |
(cl-loop for backend in backends |
+ |
1461 |
for bp = (let ((company-backend backend)) |
+ |
1462 |
(company-call-backend 'prefix)) |
+ |
1463 |
for expansion = |
+ |
1464 |
(when (company--good-prefix-p bp min-length) |
+ |
1465 |
(let ((inhibit-redisplay t) |
+ |
1466 |
(company-backend backend)) |
+ |
1467 |
(company--expand-common (company--prefix-str bp) |
+ |
1468 |
(company--suffix-str bp)))) |
+ |
1469 |
when (consp expansion) |
+ |
1470 |
collect |
+ |
1471 |
(list backend bp expansion))) |
+ |
1472 |
replacements) |
+ |
1473 |
(dolist (tuple tuples) |
+ |
1474 |
(cl-assert (string-suffix-p (company--prefix-str (nth 1 tuple)) |
+ |
1475 |
prefix)) |
+ |
1476 |
(cl-assert (string-prefix-p (company--suffix-str (nth 1 tuple)) |
+ |
1477 |
suffix))) |
+ |
1478 |
;; We try to find the smallest possible edit for each backend's expansion |
+ |
1479 |
;; (minimum prefix and suffix, beyond which the area is unchanged). |
+ |
1480 |
(setq replacements |
+ |
1481 |
(mapcar |
+ |
1482 |
(lambda (tuple) |
+ |
1483 |
(let* ((backend-prefix (company--prefix-str (nth 1 tuple))) |
+ |
1484 |
(backend-suffix (company--suffix-str (nth 1 tuple))) |
+ |
1485 |
(bplen (length backend-prefix)) |
+ |
1486 |
(bslen (length backend-suffix)) |
+ |
1487 |
(beg 0) |
+ |
1488 |
(end 0) |
+ |
1489 |
(rep-suffix-len (length (cdr (nth 2 tuple)))) |
+ |
1490 |
(max-beg (min bplen (length (car (nth 2 tuple))))) |
+ |
1491 |
(max-end (min bslen rep-suffix-len))) |
+ |
1492 |
(while (and (< beg max-beg) |
+ |
1493 |
(= (aref backend-prefix beg) |
+ |
1494 |
(aref (car (nth 2 tuple)) beg))) |
+ |
1495 |
(cl-incf beg)) |
+ |
1496 |
(while (and (< end max-end) |
+ |
1497 |
(= (aref suffix (- bslen end 1)) |
+ |
1498 |
(aref (cdr (nth 2 tuple)) |
+ |
1499 |
(- rep-suffix-len end 1)))) |
+ |
1500 |
(cl-incf end)) |
+ |
1501 |
(list (- bplen beg) |
+ |
1502 |
(substring (car (nth 2 tuple)) beg) |
+ |
1503 |
(- bslen end) |
+ |
1504 |
(substring (cdr (nth 2 tuple)) 0 (- rep-suffix-len end)) |
+ |
1505 |
(nth 0 tuple)))) |
+ |
1506 |
tuples)) |
+ |
1507 |
(setq replacements (sort replacements |
+ |
1508 |
(lambda (t1 t2) (< (- (length (nth 1 t1)) (nth 0 t1)) |
+ |
1509 |
(- (length (nth 1 t2)) (nth 0 t2)))))) |
+ |
1510 |
(or |
+ |
1511 |
(let ((choice (car replacements))) |
+ |
1512 |
;; See if every replacement is similar enough to the one we selected: |
+ |
1513 |
;; same suffix and beg/end and a prefix that starts with the proposed. |
+ |
1514 |
;; |
+ |
1515 |
;; More advanced checks seem possible, but with some backends reacting to |
+ |
1516 |
;; buffer contents (not just string arguments) it seems we'd need to |
+ |
1517 |
;; change the buffer contents first, then fetch `candidates' for each, |
+ |
1518 |
;; and revert at the end. Might be error-prone. |
+ |
1519 |
(and |
+ |
1520 |
choice |
+ |
1521 |
(cl-every |
+ |
1522 |
(lambda (replacement) |
+ |
1523 |
(and |
+ |
1524 |
(= (car replacement) (car choice)) |
+ |
1525 |
(= (nth 2 replacement) (nth 2 choice)) |
+ |
1526 |
(equal (nth 3 replacement) (nth 3 choice)) |
+ |
1527 |
(string-prefix-p (nth 1 choice) (nth 1 replacement)))) |
+ |
1528 |
(cdr replacements)) |
+ |
1529 |
;; Proposed edit applied to the group's prefix and suffix. |
+ |
1530 |
(cons (concat (substring prefix 0 (- (length prefix) (nth 0 choice))) |
+ |
1531 |
(nth 1 choice)) |
+ |
1532 |
(concat (nth 3 choice) |
+ |
1533 |
(substring suffix (nth 2 choice)))))) |
+ |
1534 |
(and (null replacements) 'no-match) |
+ |
1535 |
;; Didn't find anything suitable - return entity parts unchanged. |
+ |
1536 |
(cons prefix suffix)))) |
+ |
1537 |
|
+ |
1538 |
(defun company--multi-backend-adapter-candidates (backends min-length separate) |
+ |
1539 |
(let* (backend-prefix suffix |
+ |
1540 |
(pairs (cl-loop for backend in backends |
+ |
1541 |
when (let ((bp (let ((company-backend backend)) |
+ |
1542 |
(company-call-backend 'prefix)))) |
+ |
1543 |
;; One might override min-length, another not. |
+ |
1544 |
(if (company--good-prefix-p bp min-length) |
+ |
1545 |
(setq backend-prefix (company--prefix-str bp) |
+ |
1546 |
suffix (company--suffix-str bp)) |
+ |
1547 |
(push backend company--multi-uncached-backends) |
+ |
1548 |
nil)) |
+ |
1549 |
collect (cons (funcall backend 'candidates backend-prefix suffix) |
+ |
1550 |
(company--multi-candidates-mapper |
+ |
1551 |
backend |
+ |
1552 |
separate |
+ |
1553 |
;; Small perf optimization: don't tag the |
+ |
1554 |
;; candidates received from the first |
+ |
1555 |
;; backend in the group. |
+ |
1556 |
(not (eq backend (car backends)))))))) |
+ |
1557 |
(company--merge-async pairs (lambda (values) (apply #'append values))))) |
+ |
1558 |
|
+ |
1559 |
(defun company--multi-candidates-mapper (backend separate tag) |
+ |
1560 |
(lambda (candidates) |
+ |
1561 |
(when separate |
+ |
1562 |
(let ((company-backend backend)) |
+ |
1563 |
(setq candidates |
+ |
1564 |
(company--preprocess-candidates candidates)))) |
+ |
1565 |
(when tag |
+ |
1566 |
(setq candidates |
+ |
1567 |
(mapcar |
+ |
1568 |
(lambda (str) |
+ |
1569 |
(propertize str 'company-backend backend)) |
+ |
1570 |
candidates))) |
+ |
1571 |
candidates)) |
+ |
1572 |
|
+ |
1573 |
(defun company--merge-async (pairs merger) |
+ |
1574 |
(let ((async (cl-loop for pair in pairs |
+ |
1575 |
thereis |
+ |
1576 |
(eq :async (car-safe (car pair)))))) |
+ |
1577 |
(if (not async) |
+ |
1578 |
(funcall merger (cl-loop for (val . mapper) in pairs |
+ |
1579 |
collect (funcall mapper val))) |
+ |
1580 |
(cons |
+ |
1581 |
:async |
+ |
1582 |
(lambda (callback) |
+ |
1583 |
(let* (lst |
+ |
1584 |
(pending (mapcar #'car pairs)) |
+ |
1585 |
(finisher (lambda () |
+ |
1586 |
(unless pending |
+ |
1587 |
(funcall callback |
+ |
1588 |
(funcall merger |
+ |
1589 |
(nreverse lst))))))) |
+ |
1590 |
(dolist (pair pairs) |
+ |
1591 |
(push nil lst) |
+ |
1592 |
(let* ((cell lst) |
+ |
1593 |
(val (car pair)) |
+ |
1594 |
(mapper (cdr pair)) |
+ |
1595 |
(this-finisher (lambda (res) |
+ |
1596 |
(setq pending (delq val pending)) |
+ |
1597 |
(setcar cell (funcall mapper res)) |
+ |
1598 |
(funcall-interactively finisher)))) |
+ |
1599 |
(if (not (eq :async (car-safe val))) |
+ |
1600 |
(funcall this-finisher val) |
+ |
1601 |
(let ((fetcher (cdr val))) |
+ |
1602 |
(funcall fetcher this-finisher))))))))))) |
+ |
1603 |
|
+ |
1604 |
(defun company--prefix-str (entity) |
+ |
1605 |
(or (car-safe entity) entity)) |
+ |
1606 |
|
+ |
1607 |
(defun company--prefix-len (entity) |
+ |
1608 |
(let ((cdr (cdr-safe entity)) |
+ |
1609 |
override) |
+ |
1610 |
(cond |
+ |
1611 |
((consp cdr) |
+ |
1612 |
(setq override (cadr cdr))) |
+ |
1613 |
((or (numberp cdr) (eq t cdr)) |
+ |
1614 |
(setq override cdr))) |
+ |
1615 |
(or override |
+ |
1616 |
(length |
+ |
1617 |
(if (stringp entity) |
+ |
1618 |
entity |
+ |
1619 |
(car entity)))))) |
+ |
1620 |
|
+ |
1621 |
(defun company--suffix-str (entity) |
+ |
1622 |
(if (stringp (car-safe (cdr-safe entity))) |
+ |
1623 |
(car-safe (cdr-safe entity)) |
+ |
1624 |
"")) |
+ |
1625 |
|
+ |
1626 |
;;; completion mechanism ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
+ |
1627 |
|
+ |
1628 |
(defvar-local company-prefix nil) |
+ |
1629 |
|
+ |
1630 |
(defvar-local company-suffix nil) |
+ |
1631 |
|
+ |
1632 |
(defvar-local company-candidates nil) |
+ |
1633 |
|
+ |
1634 |
(defvar-local company-candidates-length nil) |
+ |
1635 |
|
+ |
1636 |
(defvar-local company-candidates-cache nil) |
+ |
1637 |
|
+ |
1638 |
(defvar-local company-candidates-predicate nil) |
+ |
1639 |
|
+ |
1640 |
(defvar-local company-common nil) |
+ |
1641 |
|
+ |
1642 |
(defvar company-selection-default 0 |
+ |
1643 |
"The default value for `company-selection'.") |
+ |
1644 |
(defvar-local company-selection company-selection-default) |
+ |
1645 |
|
+ |
1646 |
(defvar-local company-selection-changed nil) |
+ |
1647 |
|
+ |
1648 |
(defvar-local company--manual-action nil |
+ |
1649 |
"Non-nil if manual completion was performed by the user.") |
+ |
1650 |
|
+ |
1651 |
(defvar-local company--manual-now nil |
+ |
1652 |
"Non-nil if manual completion is being performed now.") |
+ |
1653 |
|
+ |
1654 |
(defvar-local company--manual-prefix nil) |
+ |
1655 |
|
+ |
1656 |
(defvar-local company--point-max nil) |
+ |
1657 |
|
+ |
1658 |
(defvar-local company-point nil) |
+ |
1659 |
|
+ |
1660 |
(defvar-local company-valid-point nil) |
+ |
1661 |
|
+ |
1662 |
(defvar company-timer nil) |
+ |
1663 |
(defvar company-tooltip-timer nil) |
+ |
1664 |
|
+ |
1665 |
(defun company-strip-prefix (str prefix) |
+ |
1666 |
(substring str (length prefix))) |
+ |
1667 |
|
+ |
1668 |
(defun company--insert-candidate (candidate prefix) |
+ |
1669 |
(when (> (length candidate) 0) |
+ |
1670 |
(setq candidate (substring-no-properties candidate)) |
+ |
1671 |
;; XXX: Return value we check here is subject to change. |
+ |
1672 |
(if (eq (company-call-backend 'ignore-case) 'keep-prefix) |
+ |
1673 |
(insert (company-strip-prefix candidate prefix)) |
+ |
1674 |
(unless (equal prefix candidate) |
+ |
1675 |
(delete-region (- (point) (length prefix)) (point)) |
+ |
1676 |
(insert candidate))))) |
+ |
1677 |
|
+ |
1678 |
(defmacro company-with-candidate-inserted (candidate &rest body) |
+ |
1679 |
"Evaluate BODY with CANDIDATE temporarily inserted. |
+ |
1680 |
This is a tool for backends that need candidates inserted before they |
+ |
1681 |
can retrieve meta-data for them." |
+ |
1682 |
(declare (indent 1)) |
+ |
1683 |
`(let ((inhibit-modification-hooks t) |
+ |
1684 |
(inhibit-point-motion-hooks t) |
+ |
1685 |
(modified-p (buffer-modified-p))) |
+ |
1686 |
(company--insert-candidate ,candidate company-prefix) |
+ |
1687 |
(unwind-protect |
+ |
1688 |
(progn ,@body) |
+ |
1689 |
(delete-region company-point (point)) |
+ |
1690 |
(set-buffer-modified-p modified-p)))) |
+ |
1691 |
|
+ |
1692 |
(defun company-explicit-action-p () |
+ |
1693 |
"Return whether explicit completion action was taken by the user." |
+ |
1694 |
(or company--manual-action |
+ |
1695 |
company-selection-changed)) |
+ |
1696 |
|
+ |
1697 |
(defun company-reformat (candidate) |
+ |
1698 |
;; company-ispell needs this, because the results are always lower-case |
+ |
1699 |
;; It's mory efficient to fix it only when they are displayed. |
+ |
1700 |
;; FIXME: Adopt the current text's capitalization instead? |
+ |
1701 |
(if (eq (company-call-backend 'ignore-case) 'keep-prefix) |
+ |
1702 |
(concat company-prefix (substring candidate (length company-prefix))) |
+ |
1703 |
candidate)) |
+ |
1704 |
|
+ |
1705 |
(defun company--should-complete () |
+ |
1706 |
(and (eq company-idle-delay 'now) |
+ |
1707 |
(not (or buffer-read-only |
+ |
1708 |
overriding-local-map)) |
+ |
1709 |
;; Check if in the middle of entering a key combination. |
+ |
1710 |
(or (equal (this-command-keys-vector) []) |
+ |
1711 |
(not (keymapp (key-binding (this-command-keys-vector))))) |
+ |
1712 |
(not (and transient-mark-mode mark-active)))) |
+ |
1713 |
|
+ |
1714 |
(defun company--should-continue () |
+ |
1715 |
(or (eq t company-begin-commands) |
+ |
1716 |
(eq t company-continue-commands) |
+ |
1717 |
(if (eq 'not (car company-continue-commands)) |
+ |
1718 |
(not (memq this-command (cdr company-continue-commands))) |
+ |
1719 |
(or (memq this-command company-begin-commands) |
+ |
1720 |
(memq this-command company-continue-commands) |
+ |
1721 |
(and (symbolp this-command) |
+ |
1722 |
(string-match-p "\\`company-" (symbol-name this-command))))))) |
+ |
1723 |
|
+ |
1724 |
(defvar company-auto-update-doc nil |
+ |
1725 |
"If non-nil, update the documentation buffer on each selection change. |
+ |
1726 |
To toggle the value of this variable, call `company-show-doc-buffer' with a |
+ |
1727 |
prefix argument.") |
+ |
1728 |
|
+ |
1729 |
(defun company-call-frontends (command) |
+ |
1730 |
(cl-loop for frontend in company-frontends collect |
+ |
1731 |
(condition-case-unless-debug err |
+ |
1732 |
(funcall frontend command) |
+ |
1733 |
(error (error "Company: frontend %s error \"%s\" on command %s" |
+ |
1734 |
frontend (error-message-string err) command))))) |
+ |
1735 |
|
+ |
1736 |
(defun company-set-selection (selection &optional force-update) |
+ |
1737 |
"Set SELECTION for company candidates. |
+ |
1738 |
This will update `company-selection' and related variable. |
+ |
1739 |
Only update when the current selection is changed, but optionally always |
+ |
1740 |
update if FORCE-UPDATE." |
+ |
1741 |
(when selection |
+ |
1742 |
(let* ((offset (if company-selection-default 0 1)) |
+ |
1743 |
(company-candidates-length |
+ |
1744 |
(+ company-candidates-length offset))) |
+ |
1745 |
(setq selection (+ selection offset)) |
+ |
1746 |
(setq selection |
+ |
1747 |
(if company-selection-wrap-around |
+ |
1748 |
(mod selection company-candidates-length) |
+ |
1749 |
(max 0 (min (1- company-candidates-length) selection)))) |
+ |
1750 |
(setq selection (unless (< selection offset) |
+ |
1751 |
(- selection offset))))) |
+ |
1752 |
(when (or force-update (not (equal selection company-selection))) |
+ |
1753 |
(setq company-selection selection |
+ |
1754 |
company-selection-changed t) |
+ |
1755 |
(company-call-frontends 'update))) |
+ |
1756 |
|
+ |
1757 |
(defun company--group-lighter (candidate base) |
+ |
1758 |
(let ((backend (or (get-text-property 0 'company-backend candidate) |
+ |
1759 |
(cl-some (lambda (x) (and (not (keywordp x)) x)) |
+ |
1760 |
company-backend)))) |
+ |
1761 |
(when (and backend (symbolp backend)) |
+ |
1762 |
(let ((name (replace-regexp-in-string "company-\\|-company" "" |
+ |
1763 |
(symbol-name backend)))) |
+ |
1764 |
(format "%s-<%s>" base name))))) |
+ |
1765 |
|
+ |
1766 |
(defun company-update-candidates (candidates) |
+ |
1767 |
(setq company-candidates-length (length candidates) |
+ |
1768 |
company-valid-point company-point) |
+ |
1769 |
(if company-selection-changed |
+ |
1770 |
;; Try to restore the selection |
+ |
1771 |
(let ((selected (and company-selection |
+ |
1772 |
(nth company-selection company-candidates)))) |
+ |
1773 |
(setq company-candidates candidates) |
+ |
1774 |
(when selected |
+ |
1775 |
(setq company-selection 0) |
+ |
1776 |
(catch 'found |
+ |
1777 |
(while candidates |
+ |
1778 |
(let ((candidate (pop candidates))) |
+ |
1779 |
(when (and (string= candidate selected) |
+ |
1780 |
(equal (company-call-backend 'annotation candidate) |
+ |
1781 |
(company-call-backend 'annotation selected))) |
+ |
1782 |
(throw 'found t))) |
+ |
1783 |
(cl-incf company-selection)) |
+ |
1784 |
(setq company-selection company-selection-default |
+ |
1785 |
company-selection-changed nil)))) |
+ |
1786 |
(setq company-selection company-selection-default |
+ |
1787 |
company-candidates candidates)) |
+ |
1788 |
;; Calculate common. |
+ |
1789 |
(let ((completion-ignore-case (company-call-backend 'ignore-case))) |
+ |
1790 |
;; We want to support non-prefix completion, so filtering is the |
+ |
1791 |
;; responsibility of each respective backend, not ours. |
+ |
1792 |
;; On the other hand, we don't want to replace non-prefix input in |
+ |
1793 |
;; `company-complete-common', unless there's only one candidate. |
+ |
1794 |
(setq company-common |
+ |
1795 |
(if (cdr company-candidates) |
+ |
1796 |
(let ((common (try-completion "" company-candidates))) |
+ |
1797 |
(and (stringp common) |
+ |
1798 |
common)) |
+ |
1799 |
(car company-candidates))))) |
+ |
1800 |
|
+ |
1801 |
(defun company-calculate-candidates (prefix ignore-case suffix) |
+ |
1802 |
(let ((candidates (cdr (assoc prefix company-candidates-cache)))) |
+ |
1803 |
(or candidates |
+ |
1804 |
(when company-candidates-cache |
+ |
1805 |
(let ((len (length prefix)) |
+ |
1806 |
(completion-ignore-case ignore-case) |
+ |
1807 |
prev) |
+ |
1808 |
(cl-dotimes (i (1+ len)) |
+ |
1809 |
(when (setq prev (cdr (assoc (substring prefix 0 (- len i)) |
+ |
1810 |
company-candidates-cache))) |
+ |
1811 |
(setq candidates (all-completions prefix prev)) |
+ |
1812 |
(cl-return t))))) |
+ |
1813 |
;; No cache match, call the backend. |
+ |
1814 |
(let ((refresh-timer (run-with-timer company-async-redisplay-delay |
+ |
1815 |
nil |
+ |
1816 |
#'company--sneaky-refresh |
+ |
1817 |
prefix suffix))) |
+ |
1818 |
(unwind-protect |
+ |
1819 |
(setq candidates (company--preprocess-candidates |
+ |
1820 |
(company--fetch-candidates prefix suffix))) |
+ |
1821 |
;; If the backend is synchronous, no chance for the timer to run. |
+ |
1822 |
(cancel-timer refresh-timer)) |
+ |
1823 |
;; Save in cache. |
+ |
1824 |
(push (cons prefix candidates) company-candidates-cache))) |
+ |
1825 |
;; Only now apply the predicate and transformers. |
+ |
1826 |
(company--postprocess-candidates candidates))) |
+ |
1827 |
|
+ |
1828 |
(defun company--unique-match-p (candidates prefix suffix ignore-case) |
+ |
1829 |
(and candidates |
+ |
1830 |
(not (cdr candidates)) |
+ |
1831 |
(eq t (compare-strings (car candidates) nil nil |
+ |
1832 |
(concat prefix suffix) nil nil ignore-case)) |
+ |
1833 |
(not (eq (company-call-backend 'kind (car candidates)) |
+ |
1834 |
'snippet)))) |
+ |
1835 |
|
+ |
1836 |
(defun company--fetch-candidates (prefix suffix) |
+ |
1837 |
(let* ((non-essential (not company--manual-now)) |
+ |
1838 |
(inhibit-redisplay t) |
+ |
1839 |
;; At least we need "fresh" completions if the current command will |
+ |
1840 |
;; rely on the result (e.g. insert common, or finish completion). |
+ |
1841 |
(c (if company--manual-now |
+ |
1842 |
(company-call-backend 'candidates prefix suffix) |
+ |
1843 |
(company-call-backend-raw 'candidates prefix suffix)))) |
+ |
1844 |
(if (not (eq (car c) :async)) |
+ |
1845 |
c |
+ |
1846 |
(let ((res 'none)) |
+ |
1847 |
(funcall |
+ |
1848 |
(cdr c) |
+ |
1849 |
(lambda (candidates) |
+ |
1850 |
(when (eq res 'none) |
+ |
1851 |
(push 'company-foo unread-command-events)) |
+ |
1852 |
(setq res candidates))) |
+ |
1853 |
(if (company--flyspell-workaround-p) |
+ |
1854 |
(while (and (eq res 'none) |
+ |
1855 |
(not (input-pending-p))) |
+ |
1856 |
(sleep-for company-async-wait)) |
+ |
1857 |
(while (and (eq res 'none) |
+ |
1858 |
(sit-for 0.5 t)))) |
+ |
1859 |
(while (member (car unread-command-events) |
+ |
1860 |
'(company-foo (t . company-foo))) |
+ |
1861 |
(pop unread-command-events)) |
+ |
1862 |
(let ((res-was res)) |
+ |
1863 |
(setq res 'exited) |
+ |
1864 |
(if (eq 'none res-was) |
+ |
1865 |
(throw 'interrupted 'new-input) |
+ |
1866 |
res-was)))))) |
+ |
1867 |
|
+ |
1868 |
(defun company--sneaky-refresh (prefix suffix) |
+ |
1869 |
(when company-candidates |
+ |
1870 |
(let* ((company-prefix prefix) |
+ |
1871 |
(company-suffix suffix)) |
+ |
1872 |
(and prefix |
+ |
1873 |
(company-call-frontends 'unhide)))) |
+ |
1874 |
(let (inhibit-redisplay) |
+ |
1875 |
(redisplay)) |
+ |
1876 |
(when company-candidates (company-call-frontends 'pre-command))) |
+ |
1877 |
|
+ |
1878 |
(defun company--flyspell-workaround-p () |
+ |
1879 |
;; https://debbugs.gnu.org/23980 |
+ |
1880 |
(and (bound-and-true-p flyspell-mode) |
+ |
1881 |
(version< emacs-version "27"))) |
+ |
1882 |
|
+ |
1883 |
(defun company--preprocess-candidates (candidates) |
+ |
1884 |
(cl-assert (cl-every #'stringp candidates)) |
+ |
1885 |
(unless (company-call-backend 'sorted) |
+ |
1886 |
(setq candidates (sort candidates 'string<))) |
+ |
1887 |
(when (company-call-backend 'duplicates) |
+ |
1888 |
(company--strip-duplicates candidates)) |
+ |
1889 |
candidates) |
+ |
1890 |
|
+ |
1891 |
(defun company--postprocess-candidates (candidates) |
+ |
1892 |
(when (or company-candidates-predicate company-transformers) |
+ |
1893 |
(setq candidates (copy-sequence candidates))) |
+ |
1894 |
(when company-candidates-predicate |
+ |
1895 |
(setq candidates (cl-delete-if-not company-candidates-predicate candidates))) |
+ |
1896 |
(company--transform-candidates candidates)) |
+ |
1897 |
|
+ |
1898 |
(defun company--strip-duplicates (candidates) |
+ |
1899 |
(let ((c2 candidates) |
+ |
1900 |
(extras 'unk)) |
+ |
1901 |
(while c2 |
+ |
1902 |
(setcdr c2 |
+ |
1903 |
(let ((str (pop c2))) |
+ |
1904 |
(while (let ((str2 (car c2))) |
+ |
1905 |
(if (not (equal str str2)) |
+ |
1906 |
(progn |
+ |
1907 |
(setq extras 'unk) |
+ |
1908 |
nil) |
+ |
1909 |
(when (eq extras 'unk) |
+ |
1910 |
(setq extras (list (cons (company-call-backend |
+ |
1911 |
'annotation str) |
+ |
1912 |
(company-call-backend |
+ |
1913 |
'kind str))))) |
+ |
1914 |
(let ((extra2 (cons (company-call-backend |
+ |
1915 |
'annotation str2) |
+ |
1916 |
(company-call-backend |
+ |
1917 |
'kind str2)))) |
+ |
1918 |
(if (member extra2 extras) |
+ |
1919 |
t |
+ |
1920 |
(push extra2 extras) |
+ |
1921 |
nil)))) |
+ |
1922 |
(pop c2)) |
+ |
1923 |
c2))))) |
+ |
1924 |
|
+ |
1925 |
(defun company--transform-candidates (candidates) |
+ |
1926 |
(let ((c candidates)) |
+ |
1927 |
(dolist (tr company-transformers) |
+ |
1928 |
(setq c (funcall tr c))) |
+ |
1929 |
c)) |
+ |
1930 |
|
+ |
1931 |
(defcustom company-occurrence-weight-function |
+ |
1932 |
#'company-occurrence-prefer-closest-above |
+ |
1933 |
"Function to weigh matches in `company-sort-by-occurrence'. |
+ |
1934 |
It's called with three arguments: cursor position, the beginning and the |
+ |
1935 |
end of the match." |
+ |
1936 |
:type '(choice |
+ |
1937 |
(const :tag "First above point, then below point" |
+ |
1938 |
company-occurrence-prefer-closest-above) |
+ |
1939 |
(const :tag "Prefer closest in any direction" |
+ |
1940 |
company-occurrence-prefer-any-closest))) |
+ |
1941 |
|
+ |
1942 |
(defvar company-vscode-icons-mapping |
+ |
1943 |
'((array . "symbol-array.svg") |
+ |
1944 |
(boolean . "symbol-boolean.svg") |
+ |
1945 |
(class . "symbol-class.svg") |
+ |
1946 |
(color . "symbol-color.svg") |
+ |
1947 |
(constant . "symbol-constant.svg") |
+ |
1948 |
(constructor . "symbol-method.svg") |
+ |
1949 |
(enum-member . "symbol-enumerator-member.svg") |
+ |
1950 |
(enum . "symbol-enumerator.svg") |
+ |
1951 |
(event . "symbol-event.svg") |
+ |
1952 |
(field . "symbol-field.svg") |
+ |
1953 |
(file . "symbol-file.svg") |
+ |
1954 |
(folder . "folder.svg") |
+ |
1955 |
(interface . "symbol-interface.svg") |
+ |
1956 |
(keyword . "symbol-keyword.svg") |
+ |
1957 |
(method . "symbol-method.svg") |
+ |
1958 |
(function . "symbol-method.svg") |
+ |
1959 |
(module . "symbol-namespace.svg") |
+ |
1960 |
(numeric . "symbol-numeric.svg") |
+ |
1961 |
(operator . "symbol-operator.svg") |
+ |
1962 |
(property . "symbol-property.svg") |
+ |
1963 |
(reference . "references.svg") |
+ |
1964 |
(snippet . "symbol-snippet.svg") |
+ |
1965 |
(string . "symbol-string.svg") |
+ |
1966 |
(struct . "symbol-structure.svg") |
+ |
1967 |
(text . "symbol-key.svg") |
+ |
1968 |
(type-parameter . "symbol-parameter.svg") |
+ |
1969 |
(unit . "symbol-ruler.svg") |
+ |
1970 |
(value . "symbol-enumerator.svg") |
+ |
1971 |
(variable . "symbol-variable.svg") |
+ |
1972 |
(t . "symbol-misc.svg"))) |
+ |
1973 |
|
+ |
1974 |
(defconst company-icons-root |
+ |
1975 |
(file-name-as-directory |
+ |
1976 |
(expand-file-name "icons" |
+ |
1977 |
(file-name-directory (or load-file-name buffer-file-name))))) |
+ |
1978 |
|
+ |
1979 |
(defcustom company-icon-size '(auto-scale . 16) |
+ |
1980 |
"Size of icons indicating completion kind in the popup." |
+ |
1981 |
:type '(choice (integer :tag "Size in pixels" :value 16) |
+ |
1982 |
(cons :tag "Size in pixels, scaled 2x on HiDPI screens" |
+ |
1983 |
(const auto-scale) |
+ |
1984 |
(integer :value 16)))) |
+ |
1985 |
|
+ |
1986 |
(defcustom company-icon-margin 2 |
+ |
1987 |
"Width of the margin that shows the icons, in characters." |
+ |
1988 |
:type 'integer) |
+ |
1989 |
|
+ |
1990 |
(defun company--render-icons-margin (icon-mapping root-dir candidate selected) |
+ |
1991 |
(if-let* ((ws (window-system)) |
+ |
1992 |
(candidate candidate) |
+ |
1993 |
(kind (company-call-backend 'kind candidate)) |
+ |
1994 |
(icon-file (or (alist-get kind icon-mapping) |
+ |
1995 |
(alist-get t icon-mapping)))) |
+ |
1996 |
(let* ((bkg (face-attribute (if selected |
+ |
1997 |
'company-tooltip-selection |
+ |
1998 |
'company-tooltip) |
+ |
1999 |
:background)) |
+ |
2000 |
(dfw (default-font-width)) |
+ |
2001 |
(icon-size (cond |
+ |
2002 |
((integerp company-icon-size) |
+ |
2003 |
company-icon-size) |
+ |
2004 |
;; XXX: Also consider smooth scaling, e.g. using |
+ |
2005 |
;; (aref (font-info (face-font 'default)) 2) |
+ |
2006 |
((and (consp company-icon-size) |
+ |
2007 |
(eq 'auto-scale (car company-icon-size))) |
+ |
2008 |
(let ((base-size (cdr company-icon-size)) |
+ |
2009 |
(dfh (default-font-height))) |
+ |
2010 |
(min |
+ |
2011 |
(if (>= dfh (* 2 base-size)) |
+ |
2012 |
(* 2 base-size) |
+ |
2013 |
base-size) |
+ |
2014 |
(* company-icon-margin dfw)))))) |
+ |
2015 |
(spec (list 'image |
+ |
2016 |
:file (expand-file-name icon-file root-dir) |
+ |
2017 |
:type 'svg |
+ |
2018 |
:width icon-size |
+ |
2019 |
:height icon-size |
+ |
2020 |
:ascent 'center |
+ |
2021 |
;; Transparency requires Emacs 28+. |
+ |
2022 |
:background (unless (eq bkg 'unspecified) |
+ |
2023 |
bkg))) |
+ |
2024 |
(spacer-px-width (- (* company-icon-margin dfw) icon-size))) |
+ |
2025 |
(cond |
+ |
2026 |
((<= company-icon-margin 2) |
+ |
2027 |
(concat |
+ |
2028 |
(propertize " " 'display spec) |
+ |
2029 |
(propertize (company-space-string (1- company-icon-margin)) |
+ |
2030 |
'display `(space . (:width (,spacer-px-width)))))) |
+ |
2031 |
(t |
+ |
2032 |
(let* ((spacer-left (/ spacer-px-width 2)) |
+ |
2033 |
(spacer-right (- spacer-px-width spacer-left))) |
+ |
2034 |
(concat |
+ |
2035 |
(propertize (company-space-string 1) |
+ |
2036 |
'display `(space . (:width (,spacer-left)))) |
+ |
2037 |
(propertize " " 'display spec) |
+ |
2038 |
(propertize (company-space-string (- company-icon-margin 2)) |
+ |
2039 |
'display `(space . (:width (,spacer-right))))))))) |
+ |
2040 |
nil)) |
+ |
2041 |
|
+ |
2042 |
(defun company-vscode-dark-icons-margin (candidate selected) |
+ |
2043 |
"Margin function which returns icons from vscode's dark theme." |
+ |
2044 |
(company--render-icons-margin company-vscode-icons-mapping |
+ |
2045 |
(expand-file-name "vscode-dark" company-icons-root) |
+ |
2046 |
candidate |
+ |
2047 |
selected)) |
+ |
2048 |
|
+ |
2049 |
(defun company-vscode-light-icons-margin (candidate selected) |
+ |
2050 |
"Margin function which returns icons from vscode's light theme." |
+ |
2051 |
(company--render-icons-margin company-vscode-icons-mapping |
+ |
2052 |
(expand-file-name "vscode-light" company-icons-root) |
+ |
2053 |
candidate |
+ |
2054 |
selected)) |
+ |
2055 |
|
+ |
2056 |
(defcustom company-text-icons-mapping |
+ |
2057 |
'((array "a" font-lock-type-face) |
+ |
2058 |
(boolean "b" font-lock-builtin-face) |
+ |
2059 |
(class "c" font-lock-type-face) |
+ |
2060 |
(color "#" success) |
+ |
2061 |
(constant "c" font-lock-constant-face) |
+ |
2062 |
(constructor "c" font-lock-function-name-face) |
+ |
2063 |
(enum-member "e" font-lock-builtin-face) |
+ |
2064 |
(enum "e" font-lock-builtin-face) |
+ |
2065 |
(field "f" font-lock-variable-name-face) |
+ |
2066 |
(file "f" font-lock-string-face) |
+ |
2067 |
(folder "d" font-lock-doc-face) |
+ |
2068 |
(interface "i" font-lock-type-face) |
+ |
2069 |
(keyword "k" font-lock-keyword-face) |
+ |
2070 |
(method "m" font-lock-function-name-face) |
+ |
2071 |
(function "f" font-lock-function-name-face) |
+ |
2072 |
(module "{" font-lock-type-face) |
+ |
2073 |
(numeric "n" font-lock-builtin-face) |
+ |
2074 |
(operator "o" font-lock-comment-delimiter-face) |
+ |
2075 |
(property "p" font-lock-variable-name-face) |
+ |
2076 |
(reference "r" font-lock-doc-face) |
+ |
2077 |
(snippet "S" font-lock-string-face) |
+ |
2078 |
(string "s" font-lock-string-face) |
+ |
2079 |
(struct "%" font-lock-variable-name-face) |
+ |
2080 |
(text "w" shadow) |
+ |
2081 |
(type-parameter "p" font-lock-type-face) |
+ |
2082 |
(unit "u" shadow) |
+ |
2083 |
(value "v" font-lock-builtin-face) |
+ |
2084 |
(variable "v" font-lock-variable-name-face) |
+ |
2085 |
(t "." shadow)) |
+ |
2086 |
"Mapping of the text icons. |
+ |
2087 |
The format should be an alist of (KIND . CONF) where CONF is a list of the |
+ |
2088 |
form (ICON FG BG) which is used to propertize the icon to be shown for a |
+ |
2089 |
candidate of kind KIND. FG can either be color string or a face from which |
+ |
2090 |
we can get a color string (using the :foreground face-property). BG must be |
+ |
2091 |
of the same form as FG or a cons cell of (BG . BG-WHEN-SELECTED) which each |
+ |
2092 |
should be of the same form as FG. |
+ |
2093 |
|
+ |
2094 |
The only mandatory element in CONF is ICON, you can omit both the FG and BG |
+ |
2095 |
fields without issue. |
+ |
2096 |
|
+ |
2097 |
When BG is omitted and `company-text-icons-add-background' is non-nil, a BG |
+ |
2098 |
color is generated using a gradient between the active tooltip color and |
+ |
2099 |
the FG color." |
+ |
2100 |
:type '(repeat sexp)) |
+ |
2101 |
|
+ |
2102 |
(defcustom company-text-face-extra-attributes '(:weight bold) |
+ |
2103 |
"Additional attributes to add to text/dot icons faces. |
+ |
2104 |
If non-nil, an anonymous face is generated. |
+ |
2105 |
|
+ |
2106 |
Affects `company-text-icons-margin' and `company-dot-icons-margin'." |
+ |
2107 |
:type '(plist :tag "Face property list")) |
+ |
2108 |
|
+ |
2109 |
(defcustom company-text-icons-format " %s " |
+ |
2110 |
"Format string for printing the text icons." |
+ |
2111 |
:type 'string) |
+ |
2112 |
|
+ |
2113 |
(defcustom company-text-icons-add-background nil |
+ |
2114 |
"Generate a background color for text/dot icons when none is given. |
+ |
2115 |
See `company-text-icons-mapping'." |
+ |
2116 |
:type 'boolean) |
+ |
2117 |
|
+ |
2118 |
(defun company-text-icons-margin (candidate selected) |
+ |
2119 |
"Margin function which returns unicode icons." |
+ |
2120 |
(when-let* ((candidate candidate) |
+ |
2121 |
(kind (company-call-backend 'kind candidate)) |
+ |
2122 |
(conf (or (alist-get kind company-text-icons-mapping) |
+ |
2123 |
(alist-get t company-text-icons-mapping)))) |
+ |
2124 |
(cl-destructuring-bind (icon &optional fg bg) conf |
+ |
2125 |
(propertize |
+ |
2126 |
(format company-text-icons-format icon) |
+ |
2127 |
'face |
+ |
2128 |
(company-text-icons--face fg bg selected))))) |
+ |
2129 |
|
+ |
2130 |
(declare-function color-rgb-to-hex "color") |
+ |
2131 |
(declare-function color-gradient "color") |
+ |
2132 |
|
+ |
2133 |
(defun company-text-icons--extract-property (face property) |
+ |
2134 |
"Try to extract PROPERTY from FACE. |
+ |
2135 |
If FACE isn't a valid face return FACE as is. If FACE doesn't have |
+ |
2136 |
PROPERTY return nil." |
+ |
2137 |
(if (facep face) |
+ |
2138 |
(let ((value (face-attribute face property))) |
+ |
2139 |
(unless (eq value 'unspecified) |
+ |
2140 |
value)) |
+ |
2141 |
face)) |
+ |
2142 |
|
+ |
2143 |
(defun company-text-icons--face (fg bg selected) |
+ |
2144 |
(let ((fg-color (company-text-icons--extract-property fg :foreground))) |
+ |
2145 |
`(,@company-text-face-extra-attributes |
+ |
2146 |
,@(and fg-color |
+ |
2147 |
(list :foreground fg-color)) |
+ |
2148 |
,@(let* ((bg-is-cons (consp bg)) |
+ |
2149 |
(bg (if bg-is-cons (if selected (cdr bg) (car bg)) bg)) |
+ |
2150 |
(bg-color (company-text-icons--extract-property bg :background)) |
+ |
2151 |
(tooltip-bg-color (company-text-icons--extract-property |
+ |
2152 |
(if selected |
+ |
2153 |
'company-tooltip-selection |
+ |
2154 |
'company-tooltip) |
+ |
2155 |
:background))) |
+ |
2156 |
(cond |
+ |
2157 |
((and company-text-icons-add-background selected |
+ |
2158 |
(not bg-is-cons) bg-color tooltip-bg-color) |
+ |
2159 |
;; Adjust the coloring of the background when *selected* but user hasn't |
+ |
2160 |
;; specified an alternate background color for selected item icons. |
+ |
2161 |
(list :background |
+ |
2162 |
(apply #'color-rgb-to-hex |
+ |
2163 |
(nth 0 (color-gradient (color-name-to-rgb tooltip-bg-color) |
+ |
2164 |
(color-name-to-rgb bg-color) |
+ |
2165 |
2))))) |
+ |
2166 |
(bg |
+ |
2167 |
;; When background is configured we use it as is, even if it doesn't |
+ |
2168 |
;; constrast well with other candidates when selected. |
+ |
2169 |
(and bg-color |
+ |
2170 |
(list :background bg-color))) |
+ |
2171 |
((and company-text-icons-add-background fg-color tooltip-bg-color) |
+ |
2172 |
;; Lastly attempt to generate a background from the foreground. |
+ |
2173 |
(list :background |
+ |
2174 |
(apply #'color-rgb-to-hex |
+ |
2175 |
(nth 0 (color-gradient (color-name-to-rgb tooltip-bg-color) |
+ |
2176 |
(color-name-to-rgb fg-color) |
+ |
2177 |
10)))))))))) |
+ |
2178 |
|
+ |
2179 |
(defcustom company-dot-icons-format "● " |
+ |
2180 |
"Format string for `company-dot-icons-margin'." |
+ |
2181 |
:type 'string) |
+ |
2182 |
|
+ |
2183 |
(defun company-dot-icons-margin (candidate selected) |
+ |
2184 |
"Margin function that uses a colored dot to display completion kind." |
+ |
2185 |
(when-let* ((kind (company-call-backend 'kind candidate)) |
+ |
2186 |
(conf (or (assoc-default kind company-text-icons-mapping) |
+ |
2187 |
(assoc-default t company-text-icons-mapping)))) |
+ |
2188 |
(cl-destructuring-bind (_icon &optional fg bg) conf |
+ |
2189 |
(propertize company-dot-icons-format |
+ |
2190 |
'face |
+ |
2191 |
(company-text-icons--face fg bg selected))))) |
+ |
2192 |
|
+ |
2193 |
(defun company-detect-icons-margin (candidate selected) |
+ |
2194 |
"Margin function which picks the appropriate icon set automatically." |
+ |
2195 |
(if (and (display-graphic-p) |
+ |
2196 |
(image-type-available-p 'svg)) |
+ |
2197 |
(cl-case (frame-parameter nil 'background-mode) |
+ |
2198 |
(light (company-vscode-light-icons-margin candidate selected)) |
+ |
2199 |
(t (company-vscode-dark-icons-margin candidate selected))) |
+ |
2200 |
(company-text-icons-margin candidate selected))) |
+ |
2201 |
|
+ |
2202 |
(defcustom company-format-margin-function #'company-detect-icons-margin |
+ |
2203 |
"Function to format the margin. |
+ |
2204 |
It accepts 2 params `candidate' and `selected' and can be used for |
+ |
2205 |
inserting prefix/image before the completion items. Typically, the |
+ |
2206 |
functions call the backends with `kind' and then insert the appropriate |
+ |
2207 |
image for the returned kind image. Function is called with (nil nil) to get |
+ |
2208 |
the default margin." |
+ |
2209 |
:type '(choice |
+ |
2210 |
(const :tag "Disabled" nil) |
+ |
2211 |
(const :tag "Detect icons theme base on conditions" company-detect-icons-margin) |
+ |
2212 |
(const :tag "Text characters as icons" company-text-icons-margin) |
+ |
2213 |
(const :tag "Colored dots as icons" company-dot-icons-margin) |
+ |
2214 |
(const :tag "VScode dark icons theme" company-vscode-dark-icons-margin) |
+ |
2215 |
(const :tag "VScode light icons theme" company-vscode-light-icons-margin) |
+ |
2216 |
(function :tag "Custom icon function."))) |
+ |
2217 |
|
+ |
2218 |
(defun company-occurrence-prefer-closest-above (pos match-beg match-end) |
+ |
2219 |
"Give priority to the matches above point, then those below point." |
+ |
2220 |
(if (< match-beg pos) |
+ |
2221 |
(- pos match-end) |
+ |
2222 |
(- match-beg (window-start)))) |
+ |
2223 |
|
+ |
2224 |
(defun company-occurrence-prefer-any-closest (pos _match-beg match-end) |
+ |
2225 |
"Give priority to the matches closest to the point." |
+ |
2226 |
(abs (- pos match-end))) |
+ |
2227 |
|
+ |
2228 |
(defun company-sort-by-occurrence (candidates) |
+ |
2229 |
"Sort CANDIDATES according to their occurrences. |
+ |
2230 |
Searches for each in the currently visible part of the current buffer and |
+ |
2231 |
prioritizes the matches according to `company-occurrence-weight-function'. |
+ |
2232 |
The rest of the list is appended unchanged. |
+ |
2233 |
Keywords and function definition names are ignored." |
+ |
2234 |
(let* ((w-start (window-start)) |
+ |
2235 |
(w-end (window-end)) |
+ |
2236 |
(start-point (point)) |
+ |
2237 |
occurs |
+ |
2238 |
(noccurs |
+ |
2239 |
(save-excursion |
+ |
2240 |
(cl-delete-if |
+ |
2241 |
(lambda (candidate) |
+ |
2242 |
(goto-char w-start) |
+ |
2243 |
(when (and (not (string-empty-p candidate)) |
+ |
2244 |
(search-forward candidate w-end t) |
+ |
2245 |
;; ^^^ optimize for large lists where most elements |
+ |
2246 |
;; won't have a match. |
+ |
2247 |
(catch 'done |
+ |
2248 |
(goto-char (1- start-point)) |
+ |
2249 |
(while (search-backward candidate w-start t) |
+ |
2250 |
(when (save-match-data |
+ |
2251 |
(company--occurrence-predicate)) |
+ |
2252 |
(throw 'done t))) |
+ |
2253 |
(goto-char start-point) |
+ |
2254 |
(while (search-forward candidate w-end t) |
+ |
2255 |
(when (save-match-data |
+ |
2256 |
(company--occurrence-predicate)) |
+ |
2257 |
(throw 'done t))))) |
+ |
2258 |
(push |
+ |
2259 |
(cons candidate |
+ |
2260 |
(funcall company-occurrence-weight-function |
+ |
2261 |
start-point |
+ |
2262 |
(match-beginning 0) |
+ |
2263 |
(match-end 0))) |
+ |
2264 |
occurs) |
+ |
2265 |
t)) |
+ |
2266 |
candidates)))) |
+ |
2267 |
(nconc |
+ |
2268 |
(mapcar #'car (sort occurs (lambda (e1 e2) (<= (cdr e1) (cdr e2))))) |
+ |
2269 |
noccurs))) |
+ |
2270 |
|
+ |
2271 |
(defun company--occurrence-predicate () |
+ |
2272 |
(defvar comint-last-prompt) |
+ |
2273 |
(let ((beg (match-beginning 0)) |
+ |
2274 |
(end (match-end 0)) |
+ |
2275 |
(comint-last-prompt (bound-and-true-p comint-last-prompt))) |
+ |
2276 |
(save-excursion |
+ |
2277 |
(goto-char end) |
+ |
2278 |
;; Workaround for python-shell-completion-at-point's behavior: |
+ |
2279 |
;; https://github.com/company-mode/company-mode/issues/759 |
+ |
2280 |
;; https://github.com/company-mode/company-mode/issues/549 |
+ |
2281 |
(when (derived-mode-p 'inferior-python-mode) |
+ |
2282 |
(let ((lbp (line-beginning-position))) |
+ |
2283 |
(setq comint-last-prompt (cons lbp lbp)))) |
+ |
2284 |
(and (not (memq (get-text-property (1- (point)) 'face) |
+ |
2285 |
'(font-lock-function-name-face |
+ |
2286 |
font-lock-keyword-face))) |
+ |
2287 |
(let ((prefix (company--prefix-str |
+ |
2288 |
(company-call-backend 'prefix)))) |
+ |
2289 |
(and (stringp prefix) |
+ |
2290 |
(= (length prefix) (- end beg)))))))) |
+ |
2291 |
|
+ |
2292 |
(defun company-sort-by-backend-importance (candidates) |
+ |
2293 |
"Sort CANDIDATES as two priority groups. |
+ |
2294 |
If `company-backend' is a function, do nothing. If it's a list, move |
+ |
2295 |
candidates from backends before keyword `:with' to the front. Candidates |
+ |
2296 |
from the rest of the backends in the group, if any, will be left at the end." |
+ |
2297 |
(if (functionp company-backend) |
+ |
2298 |
candidates |
+ |
2299 |
(let ((low-priority (cdr (memq :with company-backend)))) |
+ |
2300 |
(if (null low-priority) |
+ |
2301 |
candidates |
+ |
2302 |
(sort candidates |
+ |
2303 |
(lambda (c1 c2) |
+ |
2304 |
(and |
+ |
2305 |
(let ((b2 (get-text-property 0 'company-backend c2))) |
+ |
2306 |
(and b2 (memq b2 low-priority))) |
+ |
2307 |
(let ((b1 (get-text-property 0 'company-backend c1))) |
+ |
2308 |
(or (not b1) (not (memq b1 low-priority))))))))))) |
+ |
2309 |
|
+ |
2310 |
(defun company-sort-prefer-same-case-prefix (candidates) |
+ |
2311 |
"Prefer CANDIDATES with the exact same prefix. |
+ |
2312 |
If a backend returns case insensitive matches, candidates with the an exact |
+ |
2313 |
prefix match (same case) will be prioritized." |
+ |
2314 |
(cl-loop for candidate in candidates |
+ |
2315 |
if (string-prefix-p company-prefix candidate) |
+ |
2316 |
collect candidate into same-case |
+ |
2317 |
else collect candidate into other-case |
+ |
2318 |
finally return (append same-case other-case))) |
+ |
2319 |
|
+ |
2320 |
(defun company-idle-begin (buf win tick pos) |
+ |
2321 |
(and (eq buf (current-buffer)) |
+ |
2322 |
(eq win (selected-window)) |
+ |
2323 |
(eq tick (buffer-chars-modified-tick)) |
+ |
2324 |
(eq pos (point)) |
+ |
2325 |
(let ((non-essential t)) |
+ |
2326 |
(when (company-auto-begin) |
+ |
2327 |
(let ((this-command 'company-idle-begin)) |
+ |
2328 |
(company-post-command)))))) |
+ |
2329 |
|
+ |
2330 |
(defun company-auto-begin () |
+ |
2331 |
(and company-mode |
+ |
2332 |
(not company-candidates) |
+ |
2333 |
(let ((company-idle-delay 'now)) |
+ |
2334 |
(condition-case-unless-debug err |
+ |
2335 |
(let ((inhibit-quit nil)) |
+ |
2336 |
(company--perform) |
+ |
2337 |
;; Return non-nil if active. |
+ |
2338 |
company-candidates) |
+ |
2339 |
(error (message "Company: An error occurred in auto-begin") |
+ |
2340 |
(message "%s" (error-message-string err)) |
+ |
2341 |
(company-cancel)) |
+ |
2342 |
(quit (company-cancel)))))) |
+ |
2343 |
|
+ |
2344 |
;;;###autoload |
+ |
2345 |
(defun company-manual-begin () |
+ |
2346 |
"Start the completion interface. |
+ |
2347 |
|
+ |
2348 |
Unlike `company-complete-selection' or `company-complete', this command |
+ |
2349 |
doesn't cause any immediate changes to the buffer text." |
+ |
2350 |
(interactive) |
+ |
2351 |
(company-assert-enabled) |
+ |
2352 |
(setq company--manual-action t) |
+ |
2353 |
(unwind-protect |
+ |
2354 |
(let ((company-minimum-prefix-length 0) |
+ |
2355 |
(company--manual-now t)) |
+ |
2356 |
(or (and company-candidates |
+ |
2357 |
(= company-valid-point (point))) |
+ |
2358 |
(company-auto-begin))) |
+ |
2359 |
(unless company-candidates |
+ |
2360 |
(setq company--manual-action nil)))) |
+ |
2361 |
|
+ |
2362 |
(defun company-other-backend (&optional backward) |
+ |
2363 |
(interactive (list current-prefix-arg)) |
+ |
2364 |
(company-assert-enabled) |
+ |
2365 |
(let* ((after (if company-backend |
+ |
2366 |
(cdr (member company-backend company-backends)) |
+ |
2367 |
company-backends)) |
+ |
2368 |
(before (cdr (member company-backend (reverse company-backends)))) |
+ |
2369 |
(next (if backward |
+ |
2370 |
(append before (reverse after)) |
+ |
2371 |
(append after (reverse before))))) |
+ |
2372 |
(company-cancel) |
+ |
2373 |
(cl-dolist (backend next) |
+ |
2374 |
(when (ignore-errors (company-begin-backend backend)) |
+ |
2375 |
(cl-return t)))) |
+ |
2376 |
(unless company-candidates |
+ |
2377 |
(user-error "No other backend"))) |
+ |
2378 |
|
+ |
2379 |
(defun company-require-match-p () |
+ |
2380 |
(let ((backend-value (company-call-backend 'require-match))) |
+ |
2381 |
(or (eq backend-value t) |
+ |
2382 |
(and (not (eq backend-value 'never)) |
+ |
2383 |
(if (functionp company-require-match) |
+ |
2384 |
(funcall company-require-match) |
+ |
2385 |
(eq company-require-match t)))))) |
+ |
2386 |
|
+ |
2387 |
(defun company-insertion-on-trigger-p (input) |
+ |
2388 |
"Return non-nil if INPUT should trigger insertion. |
+ |
2389 |
For more details see `company-insertion-on-trigger' and |
+ |
2390 |
`company-insertion-triggers'." |
+ |
2391 |
(and (if (functionp company-insertion-on-trigger) |
+ |
2392 |
(funcall company-insertion-on-trigger) |
+ |
2393 |
company-insertion-on-trigger) |
+ |
2394 |
(if (functionp company-insertion-triggers) |
+ |
2395 |
(funcall company-insertion-triggers input) |
+ |
2396 |
(if (consp company-insertion-triggers) |
+ |
2397 |
(memq (char-syntax (string-to-char input)) |
+ |
2398 |
company-insertion-triggers) |
+ |
2399 |
(string-match-p (regexp-quote (substring input 0 1)) |
+ |
2400 |
company-insertion-triggers))))) |
+ |
2401 |
|
+ |
2402 |
(defun company--incremental-p () |
+ |
2403 |
(and (> (point) company-point) |
+ |
2404 |
(> (point-max) company--point-max) |
+ |
2405 |
(not (eq this-command 'backward-delete-char-untabify)) |
+ |
2406 |
(equal (buffer-substring (- company-point (length company-prefix)) |
+ |
2407 |
company-point) |
+ |
2408 |
company-prefix))) |
+ |
2409 |
|
+ |
2410 |
(defun company--continue-failed (new-prefix) |
+ |
2411 |
(cond |
+ |
2412 |
((and (or (not (company-require-match-p)) |
+ |
2413 |
;; Don't require match if the new prefix |
+ |
2414 |
;; doesn't continue the old one, and the latter was a match. |
+ |
2415 |
(not (stringp new-prefix)) |
+ |
2416 |
(<= (length new-prefix) (length company-prefix))) |
+ |
2417 |
(member company-prefix company-candidates)) |
+ |
2418 |
;; Last input was a success, |
+ |
2419 |
;; but we're treating it as an abort + input anyway, |
+ |
2420 |
;; like the `unique' case below. |
+ |
2421 |
(company-cancel 'non-unique)) |
+ |
2422 |
((company-require-match-p) |
+ |
2423 |
;; Wrong incremental input, but required match. |
+ |
2424 |
(delete-char (- company-valid-point (point))) |
+ |
2425 |
(ding) |
+ |
2426 |
(message "Matching input is required") |
+ |
2427 |
company-candidates) |
+ |
2428 |
(t (company-cancel)))) |
+ |
2429 |
|
+ |
2430 |
(defun company--good-prefix-p (prefix min-length) |
+ |
2431 |
(and (stringp (company--prefix-str prefix)) ;excludes 'stop |
+ |
2432 |
(or (eq (company--prefix-len prefix) t) |
+ |
2433 |
(>= (company--prefix-len prefix) |
+ |
2434 |
min-length)))) |
+ |
2435 |
|
+ |
2436 |
(defun company--prefix-min-length () |
+ |
2437 |
(if company--manual-prefix |
+ |
2438 |
(if company-abort-manual-when-too-short |
+ |
2439 |
;; Must not be less than minimum or initial length. |
+ |
2440 |
(min company-minimum-prefix-length |
+ |
2441 |
(if-let* ((mp-len-override (cdr-safe company--manual-prefix))) |
+ |
2442 |
(if (numberp mp-len-override) |
+ |
2443 |
mp-len-override |
+ |
2444 |
(length (car-safe company--manual-prefix))) |
+ |
2445 |
(length company--manual-prefix))) |
+ |
2446 |
0) |
+ |
2447 |
company-minimum-prefix-length)) |
+ |
2448 |
|
+ |
2449 |
(defun company--continue () |
+ |
2450 |
(when (company-call-backend 'no-cache company-prefix) |
+ |
2451 |
;; Don't complete existing candidates, fetch new ones. |
+ |
2452 |
(setq company-candidates-cache nil)) |
+ |
2453 |
(let* ((new-prefix (company-call-backend 'prefix)) |
+ |
2454 |
(new-suffix (company--suffix-str new-prefix)) |
+ |
2455 |
(ignore-case (company-call-backend 'ignore-case)) |
+ |
2456 |
(c (catch 'interrupted |
+ |
2457 |
(when (and (company--good-prefix-p new-prefix |
+ |
2458 |
(company--prefix-min-length)) |
+ |
2459 |
(setq new-prefix (company--prefix-str new-prefix)) |
+ |
2460 |
(= (- (point) (length new-prefix)) |
+ |
2461 |
(- company-point (length company-prefix)))) |
+ |
2462 |
(company-calculate-candidates new-prefix ignore-case new-suffix))))) |
+ |
2463 |
(cond |
+ |
2464 |
((eq c 'new-input) ; Keep the old completions, but update the rest. |
+ |
2465 |
(setq company-prefix new-prefix |
+ |
2466 |
company-suffix new-suffix |
+ |
2467 |
company-point (point)) |
+ |
2468 |
t) |
+ |
2469 |
((and company-abort-on-unique-match |
+ |
2470 |
(company--unique-match-p c new-prefix new-suffix ignore-case)) |
+ |
2471 |
;; Handle it like completion was aborted, to differentiate from user |
+ |
2472 |
;; calling one of Company's commands to insert the candidate, |
+ |
2473 |
;; not to trigger template expansion, etc. |
+ |
2474 |
(company-cancel 'unique)) |
+ |
2475 |
((consp c) |
+ |
2476 |
;; incremental match |
+ |
2477 |
(setq company-prefix new-prefix |
+ |
2478 |
company-suffix new-suffix |
+ |
2479 |
company-point (point)) |
+ |
2480 |
(company-update-candidates c) |
+ |
2481 |
c) |
+ |
2482 |
((and (characterp last-command-event) |
+ |
2483 |
(company-insertion-on-trigger-p (string last-command-event))) |
+ |
2484 |
;; Insertion on trigger. |
+ |
2485 |
(save-excursion |
+ |
2486 |
(goto-char company-point) |
+ |
2487 |
(company-complete-selection) |
+ |
2488 |
nil)) |
+ |
2489 |
((not (company--incremental-p)) |
+ |
2490 |
(company-cancel)) |
+ |
2491 |
(t (company--continue-failed new-prefix))))) |
+ |
2492 |
|
+ |
2493 |
(defun company--begin-new () |
+ |
2494 |
(let ((min-prefix (company--prefix-min-length)) |
+ |
2495 |
entity c) |
+ |
2496 |
(cl-dolist (backend (if company-backend |
+ |
2497 |
;; prefer manual override |
+ |
2498 |
(list company-backend) |
+ |
2499 |
company-backends)) |
+ |
2500 |
(setq entity |
+ |
2501 |
(if (or (symbolp backend) |
+ |
2502 |
(functionp backend)) |
+ |
2503 |
(when (company--maybe-init-backend backend) |
+ |
2504 |
(let ((company-backend backend)) |
+ |
2505 |
(company-call-backend 'prefix))) |
+ |
2506 |
(company--multi-backend-adapter backend 'prefix))) |
+ |
2507 |
(when entity |
+ |
2508 |
(when (and (company--good-prefix-p entity min-prefix) |
+ |
2509 |
(or (not company-inhibit-inside-symbols) |
+ |
2510 |
company--manual-action |
+ |
2511 |
(zerop (length (company--suffix-str entity))))) |
+ |
2512 |
(let ((ignore-case (company-call-backend 'ignore-case))) |
+ |
2513 |
;; Keep this undocumented, esp. while only 1 backend needs it. |
+ |
2514 |
;(company-call-backend 'set-min-prefix min-prefix);;BUGGED LINE that |
+ |
2515 |
;I fixed by simply replacing it with a "0". God damn it... |
+ |
2516 |
(company-call-backend 'set-min-prefix "0") |
+ |
2517 |
(setq company-prefix (company--prefix-str entity) |
+ |
2518 |
company-suffix (company--suffix-str entity) |
+ |
2519 |
company-point (point) |
+ |
2520 |
company-backend backend |
+ |
2521 |
c (catch 'interrupted |
+ |
2522 |
(company-calculate-candidates company-prefix ignore-case |
+ |
2523 |
company-suffix))) |
+ |
2524 |
(cond |
+ |
2525 |
((or (null c) (eq c 'new-input)) |
+ |
2526 |
(when company--manual-action |
+ |
2527 |
(message "No completion found"))) |
+ |
2528 |
((and company-abort-on-unique-match |
+ |
2529 |
(company--unique-match-p c company-prefix company-suffix ignore-case) |
+ |
2530 |
(if company--manual-action |
+ |
2531 |
;; If `company-manual-begin' was called, the user |
+ |
2532 |
;; really wants something to happen. Otherwise... |
+ |
2533 |
(ignore (message "Sole completion")) |
+ |
2534 |
t)) |
+ |
2535 |
;; ...abort and run the hooks, e.g. to clear the cache. |
+ |
2536 |
(company-cancel 'unique)) |
+ |
2537 |
(t ;; We got completions! |
+ |
2538 |
(when company--manual-action |
+ |
2539 |
(setq company--manual-prefix entity)) |
+ |
2540 |
(company-update-candidates c) |
+ |
2541 |
(run-hook-with-args 'company-completion-started-hook |
+ |
2542 |
(company-explicit-action-p)) |
+ |
2543 |
(company-call-frontends 'show))))) |
+ |
2544 |
(cl-return c))))) |
+ |
2545 |
|
+ |
2546 |
(defun company--perform () |
+ |
2547 |
(cond |
+ |
2548 |
(company-candidates |
+ |
2549 |
(company--continue)) |
+ |
2550 |
((company--should-complete) |
+ |
2551 |
(company-cache-expire) |
+ |
2552 |
(company--begin-new))) |
+ |
2553 |
(if (not company-candidates) |
+ |
2554 |
(setq company-backend nil) |
+ |
2555 |
(setq company--point-max (point-max)) |
+ |
2556 |
(company-ensure-emulation-alist) |
+ |
2557 |
(company-enable-overriding-keymap company-active-map) |
+ |
2558 |
(company-call-frontends 'update))) |
+ |
2559 |
|
+ |
2560 |
(defun company-cancel (&optional result) |
+ |
2561 |
(let ((prefix company-prefix) |
+ |
2562 |
(backend company-backend)) |
+ |
2563 |
(setq company-backend nil |
+ |
2564 |
company-prefix nil |
+ |
2565 |
company-candidates nil |
+ |
2566 |
company-candidates-length nil |
+ |
2567 |
company-candidates-cache nil |
+ |
2568 |
company-candidates-predicate nil |
+ |
2569 |
company-common nil |
+ |
2570 |
company-selection company-selection-default |
+ |
2571 |
company-selection-changed nil |
+ |
2572 |
company--manual-action nil |
+ |
2573 |
company--manual-prefix nil |
+ |
2574 |
company--point-max nil |
+ |
2575 |
company--multi-uncached-backends nil |
+ |
2576 |
company--multi-min-prefix nil |
+ |
2577 |
company-point nil) |
+ |
2578 |
(when company-timer |
+ |
2579 |
(cancel-timer company-timer)) |
+ |
2580 |
(company-echo-cancel t) |
+ |
2581 |
(company-search-mode 0) |
+ |
2582 |
(company-call-frontends 'hide) |
+ |
2583 |
(company-enable-overriding-keymap nil) |
+ |
2584 |
(when prefix |
+ |
2585 |
(if (stringp result) |
+ |
2586 |
(let ((company-backend backend)) |
+ |
2587 |
(run-hook-with-args 'company-completion-finished-hook result) |
+ |
2588 |
(company-call-backend 'post-completion result)) |
+ |
2589 |
(run-hook-with-args 'company-completion-cancelled-hook result)) |
+ |
2590 |
(run-hook-with-args 'company-after-completion-hook result))) |
+ |
2591 |
;; Make return value explicit. |
+ |
2592 |
nil) |
+ |
2593 |
|
+ |
2594 |
(defun company-abort () |
+ |
2595 |
(interactive) |
+ |
2596 |
(company-cancel 'abort)) |
+ |
2597 |
|
+ |
2598 |
(defun company-finish (result) |
+ |
2599 |
(pcase-let ((`(,prefix . ,suffix) (company--boundaries result))) |
+ |
2600 |
(company--insert-candidate result (or prefix company-prefix)) |
+ |
2601 |
(and (> (length suffix) 0) |
+ |
2602 |
(delete-region (point) (+ (point) (length suffix)))) |
+ |
2603 |
(let ((tick (buffer-chars-modified-tick)) |
+ |
2604 |
(backend company-backend)) |
+ |
2605 |
;; Call backend's `post-completion' and run other hooks, then exit. |
+ |
2606 |
(company-cancel result) |
+ |
2607 |
;; Try restarting completion, to see if we moved into a new field. |
+ |
2608 |
;; Most commonly, this would be after entering a dir in file completion. |
+ |
2609 |
(when (= (buffer-chars-modified-tick) tick) |
+ |
2610 |
(let (company-require-match) |
+ |
2611 |
(setq company-backend backend |
+ |
2612 |
company--manual-prefix 0) |
+ |
2613 |
(company--begin-new)) |
+ |
2614 |
(unless (and company-candidates |
+ |
2615 |
(equal (company--boundaries) '("" . ""))) |
+ |
2616 |
(company-cancel)))))) |
+ |
2617 |
|
+ |
2618 |
(defsubst company-keep (command) |
+ |
2619 |
(and (symbolp command) (get command 'company-keep))) |
+ |
2620 |
|
+ |
2621 |
(defun company--proper-suffix-p (candidate) |
+ |
2622 |
(and |
+ |
2623 |
(>= (length candidate) |
+ |
2624 |
(+ (length company-prefix) |
+ |
2625 |
(length company-suffix))) |
+ |
2626 |
(string-suffix-p company-suffix candidate |
+ |
2627 |
(company-call-backend 'ignore-case)))) |
+ |
2628 |
|
+ |
2629 |
(defun company--boundaries (&optional candidate) |
+ |
2630 |
(unless candidate |
+ |
2631 |
(setq candidate (nth (or company-selection 0) company-candidates))) |
+ |
2632 |
(or |
+ |
2633 |
(company-call-backend 'adjust-boundaries |
+ |
2634 |
candidate |
+ |
2635 |
company-prefix company-suffix) |
+ |
2636 |
(and |
+ |
2637 |
;; Default to replacing the suffix only if the completion ends with it. |
+ |
2638 |
(company--proper-suffix-p candidate) |
+ |
2639 |
(cons company-prefix company-suffix)) |
+ |
2640 |
(cons company-prefix ""))) |
+ |
2641 |
|
+ |
2642 |
(defun company--active-p () |
+ |
2643 |
company-candidates) |
+ |
2644 |
|
+ |
2645 |
(defun company-pre-command () |
+ |
2646 |
(company--electric-restore-window-configuration) |
+ |
2647 |
(unless (company-keep this-command) |
+ |
2648 |
(condition-case-unless-debug err |
+ |
2649 |
(when company-candidates |
+ |
2650 |
(company-call-frontends 'pre-command) |
+ |
2651 |
(unless (company--should-continue) |
+ |
2652 |
(company-abort))) |
+ |
2653 |
(error (message "Company: An error occurred in pre-command") |
+ |
2654 |
(message "%s" (error-message-string err)) |
+ |
2655 |
(company-cancel)))) |
+ |
2656 |
(when company-timer |
+ |
2657 |
(cancel-timer company-timer) |
+ |
2658 |
(setq company-timer nil)) |
+ |
2659 |
(company-echo-cancel t) |
+ |
2660 |
(company-uninstall-map)) |
+ |
2661 |
|
+ |
2662 |
(defun company-post-command () |
+ |
2663 |
(when (and company-candidates |
+ |
2664 |
(null this-command)) |
+ |
2665 |
;; Happens when the user presses `C-g' while inside |
+ |
2666 |
;; `flyspell-post-command-hook', for example. |
+ |
2667 |
;; Or any other `post-command-hook' function that can call `sit-for', |
+ |
2668 |
;; or any quittable timer function. |
+ |
2669 |
(company-abort) |
+ |
2670 |
(setq this-command 'company-abort)) |
+ |
2671 |
(unless (company-keep this-command) |
+ |
2672 |
(condition-case-unless-debug err |
+ |
2673 |
(progn |
+ |
2674 |
(unless (and (equal (point) company-point) |
+ |
2675 |
(equal (point-max) company--point-max)) |
+ |
2676 |
(let (company-idle-delay) ; Against misbehavior while debugging. |
+ |
2677 |
(company--perform))) |
+ |
2678 |
(if company-candidates |
+ |
2679 |
(progn |
+ |
2680 |
(company-call-frontends 'post-command) |
+ |
2681 |
(when company-auto-update-doc |
+ |
2682 |
(condition-case nil |
+ |
2683 |
(unless (company--electric-command-p) |
+ |
2684 |
(company-show-doc-buffer)) |
+ |
2685 |
(user-error nil) |
+ |
2686 |
(quit nil)))) |
+ |
2687 |
(let ((delay (company--idle-delay))) |
+ |
2688 |
(and (numberp delay) |
+ |
2689 |
(not defining-kbd-macro) |
+ |
2690 |
(company--should-begin) |
+ |
2691 |
(setq company-timer |
+ |
2692 |
(run-with-timer delay nil |
+ |
2693 |
'company-idle-begin |
+ |
2694 |
(current-buffer) (selected-window) |
+ |
2695 |
(buffer-chars-modified-tick) (point))))))) |
+ |
2696 |
(error (message "Company: An error occurred in post-command") |
+ |
2697 |
(message "%s" (error-message-string err)) |
+ |
2698 |
(company-cancel)))) |
+ |
2699 |
(company-install-map)) |
+ |
2700 |
|
+ |
2701 |
(defun company--idle-delay () |
+ |
2702 |
(let ((delay |
+ |
2703 |
(if (functionp company-idle-delay) |
+ |
2704 |
(funcall company-idle-delay) |
+ |
2705 |
company-idle-delay))) |
+ |
2706 |
(if (memql delay '(t 0 0.0)) |
+ |
2707 |
0.01 |
+ |
2708 |
delay))) |
+ |
2709 |
|
+ |
2710 |
(defvar company--begin-inhibit-commands '(company-abort |
+ |
2711 |
company-complete-mouse |
+ |
2712 |
company-complete |
+ |
2713 |
company-complete-common |
+ |
2714 |
company-complete-selection |
+ |
2715 |
company-complete-tooltip-row) |
+ |
2716 |
"List of commands after which idle completion is (still) disabled when |
+ |
2717 |
`company-begin-commands' is t.") |
+ |
2718 |
|
+ |
2719 |
(defun company--should-begin () |
+ |
2720 |
(if (eq t company-begin-commands) |
+ |
2721 |
(not (memq this-command company--begin-inhibit-commands)) |
+ |
2722 |
(or |
+ |
2723 |
(memq this-command company-begin-commands) |
+ |
2724 |
(and (symbolp this-command) (get this-command 'company-begin))))) |
+ |
2725 |
|
+ |
2726 |
;;; search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
+ |
2727 |
|
+ |
2728 |
(defcustom company-search-regexp-function #'regexp-quote |
+ |
2729 |
"Function to construct the search regexp from input. |
+ |
2730 |
It's called with one argument, the current search input. It must return |
+ |
2731 |
either a regexp without groups, or one where groups don't intersect and |
+ |
2732 |
each one wraps a part of the input string." |
+ |
2733 |
:type '(choice |
+ |
2734 |
(const :tag "Exact match" regexp-quote) |
+ |
2735 |
(const :tag "Words separated with spaces" company-search-words-regexp) |
+ |
2736 |
(const :tag "Words separated with spaces, in any order" |
+ |
2737 |
company-search-words-in-any-order-regexp) |
+ |
2738 |
(const :tag "All characters in given order, with anything in between" |
+ |
2739 |
company-search-flex-regexp))) |
+ |
2740 |
|
+ |
2741 |
(defvar-local company-search-string "") |
+ |
2742 |
|
+ |
2743 |
(defvar company-search-lighter '(" " |
+ |
2744 |
(company-search-filtering "Filter" "Search") |
+ |
2745 |
": \"" |
+ |
2746 |
company-search-string |
+ |
2747 |
"\"")) |
+ |
2748 |
|
+ |
2749 |
(defvar-local company-search-filtering nil |
+ |
2750 |
"Non-nil to filter the completion candidates by the search string") |
+ |
2751 |
|
+ |
2752 |
(defvar-local company--search-old-selection 0) |
+ |
2753 |
|
+ |
2754 |
(defvar-local company--search-old-changed nil) |
+ |
2755 |
|
+ |
2756 |
(defun company-search-words-regexp (input) |
+ |
2757 |
(mapconcat (lambda (word) (format "\\(%s\\)" (regexp-quote word))) |
+ |
2758 |
(split-string input " +" t) ".*")) |
+ |
2759 |
|
+ |
2760 |
(defun company-search-words-in-any-order-regexp (input) |
+ |
2761 |
(let* ((words (mapcar (lambda (word) (format "\\(%s\\)" (regexp-quote word))) |
+ |
2762 |
(split-string input " +" t))) |
+ |
2763 |
(permutations (company--permutations words))) |
+ |
2764 |
(mapconcat (lambda (words) |
+ |
2765 |
(mapconcat #'identity words ".*")) |
+ |
2766 |
permutations |
+ |
2767 |
"\\|"))) |
+ |
2768 |
|
+ |
2769 |
(defun company-search-flex-regexp (input) |
+ |
2770 |
(if (zerop (length input)) |
+ |
2771 |
"" |
+ |
2772 |
(concat (regexp-quote (string (aref input 0))) |
+ |
2773 |
(mapconcat (lambda (c) |
+ |
2774 |
(concat "[^" (string c) "]*" |
+ |
2775 |
(regexp-quote (string c)))) |
+ |
2776 |
(substring input 1) "")))) |
+ |
2777 |
|
+ |
2778 |
(defun company--permutations (lst) |
+ |
2779 |
(if (not lst) |
+ |
2780 |
'(nil) |
+ |
2781 |
;; FIXME: Replace with `mapcan' in Emacs 26. |
+ |
2782 |
(cl-mapcan |
+ |
2783 |
(lambda (e) |
+ |
2784 |
(mapcar (lambda (perm) (cons e perm)) |
+ |
2785 |
(company--permutations (cl-remove e lst :count 1)))) |
+ |
2786 |
lst))) |
+ |
2787 |
|
+ |
2788 |
(defun company--search (text lines) |
+ |
2789 |
(let ((re (funcall company-search-regexp-function text)) |
+ |
2790 |
(i 0)) |
+ |
2791 |
(cl-dolist (line lines) |
+ |
2792 |
(when (string-match-p re line) |
+ |
2793 |
(cl-return i)) |
+ |
2794 |
(cl-incf i)))) |
+ |
2795 |
|
+ |
2796 |
(defun company-search-printing-char () |
+ |
2797 |
(interactive) |
+ |
2798 |
(company--search-assert-enabled) |
+ |
2799 |
(let* ((event-type (event-basic-type last-command-event)) |
+ |
2800 |
(event-string (if (characterp event-type) |
+ |
2801 |
(string last-command-event) |
+ |
2802 |
;; Handle key press on the keypad. |
+ |
2803 |
(let ((name (symbol-name event-type))) |
+ |
2804 |
(if (string-match "kp-\\([0-9]\\)" name) |
+ |
2805 |
(match-string 1 name) |
+ |
2806 |
(error "Unexpected printing char input"))))) |
+ |
2807 |
(ss (concat company-search-string event-string))) |
+ |
2808 |
(when company-search-filtering |
+ |
2809 |
(company--search-update-predicate ss)) |
+ |
2810 |
(company--search-update-string ss))) |
+ |
2811 |
|
+ |
2812 |
(defun company--search-update-predicate (ss) |
+ |
2813 |
(let* ((re (funcall company-search-regexp-function ss)) |
+ |
2814 |
(company-candidates-predicate |
+ |
2815 |
(and (not (string-empty-p re)) |
+ |
2816 |
company-search-filtering |
+ |
2817 |
(lambda (candidate) (string-match-p re candidate)))) |
+ |
2818 |
(cc (company-calculate-candidates company-prefix |
+ |
2819 |
(company-call-backend 'ignore-case) |
+ |
2820 |
company-suffix))) |
+ |
2821 |
(unless cc (user-error "No match")) |
+ |
2822 |
(company-update-candidates cc))) |
+ |
2823 |
|
+ |
2824 |
(defun company--search-update-string (new) |
+ |
2825 |
(let* ((selection (or company-selection 0)) |
+ |
2826 |
(pos (company--search new (nthcdr selection company-candidates)))) |
+ |
2827 |
(if (null pos) |
+ |
2828 |
(ding) |
+ |
2829 |
(setq company-search-string new) |
+ |
2830 |
(company-set-selection (+ selection pos) t)))) |
+ |
2831 |
|
+ |
2832 |
(defun company--search-assert-input () |
+ |
2833 |
(company--search-assert-enabled) |
+ |
2834 |
(when (string-empty-p company-search-string) |
+ |
2835 |
(user-error "Empty search string"))) |
+ |
2836 |
|
+ |
2837 |
(defun company-search-repeat-forward () |
+ |
2838 |
"Repeat the incremental search in completion candidates forward." |
+ |
2839 |
(interactive) |
+ |
2840 |
(company--search-assert-input) |
+ |
2841 |
(let* ((selection (or company-selection 0)) |
+ |
2842 |
(pos (company--search company-search-string |
+ |
2843 |
(cdr (nthcdr selection company-candidates))))) |
+ |
2844 |
(if (null pos) |
+ |
2845 |
(ding) |
+ |
2846 |
(company-set-selection (+ selection pos 1) t)))) |
+ |
2847 |
|
+ |
2848 |
(defun company-search-repeat-backward () |
+ |
2849 |
"Repeat the incremental search in completion candidates backwards." |
+ |
2850 |
(interactive) |
+ |
2851 |
(company--search-assert-input) |
+ |
2852 |
(let* ((selection (or company-selection 0)) |
+ |
2853 |
(pos (company--search company-search-string |
+ |
2854 |
(nthcdr (- company-candidates-length |
+ |
2855 |
selection) |
+ |
2856 |
(reverse company-candidates))))) |
+ |
2857 |
(if (null pos) |
+ |
2858 |
(ding) |
+ |
2859 |
(company-set-selection (- selection pos 1) t)))) |
+ |
2860 |
|
+ |
2861 |
(defun company-search-toggle-filtering () |
+ |
2862 |
"Toggle `company-search-filtering'." |
+ |
2863 |
(interactive) |
+ |
2864 |
(company--search-assert-enabled) |
+ |
2865 |
(setq company-search-filtering (not company-search-filtering)) |
+ |
2866 |
(let ((ss company-search-string)) |
+ |
2867 |
(company--search-update-predicate ss) |
+ |
2868 |
(company--search-update-string ss))) |
+ |
2869 |
|
+ |
2870 |
(defun company-search-abort () |
+ |
2871 |
"Abort searching the completion candidates." |
+ |
2872 |
(interactive) |
+ |
2873 |
(company--search-assert-enabled) |
+ |
2874 |
(company-search-mode 0) |
+ |
2875 |
(company-set-selection company--search-old-selection t) |
+ |
2876 |
(setq company-selection-changed company--search-old-changed)) |
+ |
2877 |
|
+ |
2878 |
(defun company-search-other-char () |
+ |
2879 |
(interactive) |
+ |
2880 |
(company--search-assert-enabled) |
+ |
2881 |
(company-search-mode 0) |
+ |
2882 |
(company--unread-this-command-keys)) |
+ |
2883 |
|
+ |
2884 |
(defun company-search-delete-char () |
+ |
2885 |
(interactive) |
+ |
2886 |
(company--search-assert-enabled) |
+ |
2887 |
(if (string-empty-p company-search-string) |
+ |
2888 |
(ding) |
+ |
2889 |
(let ((ss (substring company-search-string 0 -1))) |
+ |
2890 |
(when company-search-filtering |
+ |
2891 |
(company--search-update-predicate ss)) |
+ |
2892 |
(company--search-update-string ss)))) |
+ |
2893 |
|
+ |
2894 |
(defvar company-search-map |
+ |
2895 |
(let ((i 0) |
+ |
2896 |
(keymap (make-keymap))) |
+ |
2897 |
(if (fboundp 'max-char) |
+ |
2898 |
(set-char-table-range (nth 1 keymap) (cons #x100 (max-char)) |
+ |
2899 |
'company-search-printing-char) |
+ |
2900 |
(with-no-warnings |
+ |
2901 |
;; obsolete in Emacs 23 |
+ |
2902 |
(let ((l (generic-character-list)) |
+ |
2903 |
(table (nth 1 keymap))) |
+ |
2904 |
(while l |
+ |
2905 |
(set-char-table-default table (car l) 'company-search-printing-char) |
+ |
2906 |
(setq l (cdr l)))))) |
+ |
2907 |
(define-key keymap [t] 'company-search-other-char) |
+ |
2908 |
(while (< i ?\s) |
+ |
2909 |
(define-key keymap (make-string 1 i) 'company-search-other-char) |
+ |
2910 |
(cl-incf i)) |
+ |
2911 |
(while (< i 256) |
+ |
2912 |
(define-key keymap (vector i) 'company-search-printing-char) |
+ |
2913 |
(cl-incf i)) |
+ |
2914 |
(dotimes (i 10) |
+ |
2915 |
(define-key keymap (kbd (format "<kp-%d>" i)) 'company-search-printing-char)) |
+ |
2916 |
(let ((meta-map (make-sparse-keymap))) |
+ |
2917 |
(define-key keymap (char-to-string meta-prefix-char) meta-map) |
+ |
2918 |
(define-key keymap [escape] meta-map)) |
+ |
2919 |
(define-key keymap (vector meta-prefix-char t) 'company-search-other-char) |
+ |
2920 |
(define-key keymap (kbd "C-n") 'company-select-next-or-abort) |
+ |
2921 |
(define-key keymap (kbd "C-p") 'company-select-previous-or-abort) |
+ |
2922 |
(define-key keymap (kbd "M-n") 'company--select-next-and-warn) |
+ |
2923 |
(define-key keymap (kbd "M-p") 'company--select-previous-and-warn) |
+ |
2924 |
(define-key keymap (kbd "<down>") 'company-select-next-or-abort) |
+ |
2925 |
(define-key keymap (kbd "<up>") 'company-select-previous-or-abort) |
+ |
2926 |
(define-key keymap "\e\e\e" 'company-search-other-char) |
+ |
2927 |
(define-key keymap [escape escape escape] 'company-search-other-char) |
+ |
2928 |
(define-key keymap (kbd "DEL") 'company-search-delete-char) |
+ |
2929 |
(define-key keymap [backspace] 'company-search-delete-char) |
+ |
2930 |
(define-key keymap "\C-g" 'company-search-abort) |
+ |
2931 |
(define-key keymap "\C-s" 'company-search-repeat-forward) |
+ |
2932 |
(define-key keymap "\C-r" 'company-search-repeat-backward) |
+ |
2933 |
(define-key keymap "\C-o" 'company-search-toggle-filtering) |
+ |
2934 |
(company-keymap--bind-quick-access keymap) |
+ |
2935 |
keymap) |
+ |
2936 |
"Keymap used for incrementally searching the completion candidates.") |
+ |
2937 |
|
+ |
2938 |
(define-minor-mode company-search-mode |
+ |
2939 |
"Search mode for completion candidates. |
+ |
2940 |
Don't start this directly, use `company-search-candidates' or |
+ |
2941 |
`company-filter-candidates'." |
+ |
2942 |
:lighter company-search-lighter |
+ |
2943 |
(if company-search-mode |
+ |
2944 |
(if (company-manual-begin) |
+ |
2945 |
(progn |
+ |
2946 |
(setq company--search-old-selection company-selection |
+ |
2947 |
company--search-old-changed company-selection-changed) |
+ |
2948 |
(company-call-frontends 'update) |
+ |
2949 |
(company-enable-overriding-keymap company-search-map)) |
+ |
2950 |
(setq company-search-mode nil)) |
+ |
2951 |
(kill-local-variable 'company-search-string) |
+ |
2952 |
(kill-local-variable 'company-search-filtering) |
+ |
2953 |
(kill-local-variable 'company--search-old-selection) |
+ |
2954 |
(kill-local-variable 'company--search-old-changed) |
+ |
2955 |
(when company-backend |
+ |
2956 |
(company--search-update-predicate "") |
+ |
2957 |
(company-call-frontends 'update)) |
+ |
2958 |
(company-enable-overriding-keymap company-active-map))) |
+ |
2959 |
|
+ |
2960 |
(defun company--search-assert-enabled () |
+ |
2961 |
(company-assert-enabled) |
+ |
2962 |
(unless company-search-mode |
+ |
2963 |
(company-uninstall-map) |
+ |
2964 |
(user-error "Company not in search mode"))) |
+ |
2965 |
|
+ |
2966 |
(defun company-search-candidates () |
+ |
2967 |
"Start searching the completion candidates incrementally. |
+ |
2968 |
|
+ |
2969 |
\\<company-search-map>Search can be controlled with the commands: |
+ |
2970 |
- `company-search-repeat-forward' (\\[company-search-repeat-forward]) |
+ |
2971 |
- `company-search-repeat-backward' (\\[company-search-repeat-backward]) |
+ |
2972 |
- `company-search-abort' (\\[company-search-abort]) |
+ |
2973 |
- `company-search-delete-char' (\\[company-search-delete-char]) |
+ |
2974 |
|
+ |
2975 |
Regular characters are appended to the search string. |
+ |
2976 |
|
+ |
2977 |
Customize `company-search-regexp-function' to change how the input |
+ |
2978 |
is interpreted when searching. |
+ |
2979 |
|
+ |
2980 |
The command `company-search-toggle-filtering' (\\[company-search-toggle-filtering]) |
+ |
2981 |
uses the search string to filter the completion candidates." |
+ |
2982 |
(interactive) |
+ |
2983 |
(company-search-mode 1)) |
+ |
2984 |
|
+ |
2985 |
(defun company-filter-candidates () |
+ |
2986 |
"Start filtering the completion candidates incrementally. |
+ |
2987 |
This works the same way as `company-search-candidates' immediately |
+ |
2988 |
followed by `company-search-toggle-filtering'." |
+ |
2989 |
(interactive) |
+ |
2990 |
(company-search-mode 1) |
+ |
2991 |
(setq company-search-filtering t)) |
+ |
2992 |
|
+ |
2993 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
+ |
2994 |
|
+ |
2995 |
(defun company-select-next (&optional arg) |
+ |
2996 |
"Select the next candidate in the list. |
+ |
2997 |
|
+ |
2998 |
With ARG, move by that many elements. |
+ |
2999 |
When `company-selection-default' is nil, add a special pseudo candidates |
+ |
3000 |
meant for no selection." |
+ |
3001 |
(interactive "p") |
+ |
3002 |
(when (company-manual-begin) |
+ |
3003 |
(let ((selection (+ (or arg 1) |
+ |
3004 |
(or company-selection |
+ |
3005 |
company-selection-default |
+ |
3006 |
-1)))) |
+ |
3007 |
(company-set-selection selection)))) |
+ |
3008 |
|
+ |
3009 |
(defun company-select-previous (&optional arg) |
+ |
3010 |
"Select the previous candidate in the list. |
+ |
3011 |
|
+ |
3012 |
With ARG, move by that many elements." |
+ |
3013 |
(interactive "p") |
+ |
3014 |
(company-select-next (if arg (- arg) -1))) |
+ |
3015 |
|
+ |
3016 |
(defun company-select-next-or-abort (&optional arg) |
+ |
3017 |
"Select the next candidate if more than one, else abort |
+ |
3018 |
and invoke the normal binding. |
+ |
3019 |
|
+ |
3020 |
With ARG, move by that many elements." |
+ |
3021 |
(interactive "p") |
+ |
3022 |
(if (or (not company-selection) |
+ |
3023 |
(> company-candidates-length 1)) |
+ |
3024 |
(company-select-next arg) |
+ |
3025 |
(company-abort) |
+ |
3026 |
(company--unread-this-command-keys))) |
+ |
3027 |
|
+ |
3028 |
(defun company-select-previous-or-abort (&optional arg) |
+ |
3029 |
"Select the previous candidate if more than one, else abort |
+ |
3030 |
and invoke the normal binding. |
+ |
3031 |
|
+ |
3032 |
With ARG, move by that many elements." |
+ |
3033 |
(interactive "p") |
+ |
3034 |
(if (> company-candidates-length 1) |
+ |
3035 |
(company-select-previous arg) |
+ |
3036 |
(company-abort) |
+ |
3037 |
(company--unread-this-command-keys))) |
+ |
3038 |
|
+ |
3039 |
(defun company-select-first () |
+ |
3040 |
"Select the first completion candidate." |
+ |
3041 |
(interactive) |
+ |
3042 |
(company-set-selection 0)) |
+ |
3043 |
|
+ |
3044 |
(defun company-select-last () |
+ |
3045 |
"Select the last completion candidate." |
+ |
3046 |
(interactive) |
+ |
3047 |
(company-set-selection (1- company-candidates-length))) |
+ |
3048 |
|
+ |
3049 |
(defun company-next-page () |
+ |
3050 |
"Select the candidate one page further." |
+ |
3051 |
(interactive) |
+ |
3052 |
(when (company-manual-begin) |
+ |
3053 |
(if (and company-selection-wrap-around |
+ |
3054 |
(= company-selection (1- company-candidates-length))) |
+ |
3055 |
(company-set-selection 0) |
+ |
3056 |
(let (company-selection-wrap-around) |
+ |
3057 |
(company-set-selection (+ company-selection |
+ |
3058 |
company-tooltip-limit)))))) |
+ |
3059 |
|
+ |
3060 |
(defun company-previous-page () |
+ |
3061 |
"Select the candidate one page earlier." |
+ |
3062 |
(interactive) |
+ |
3063 |
(when (company-manual-begin) |
+ |
3064 |
(if (and company-selection-wrap-around |
+ |
3065 |
(zerop company-selection)) |
+ |
3066 |
(company-set-selection (1- company-candidates-length)) |
+ |
3067 |
(let (company-selection-wrap-around) |
+ |
3068 |
(company-set-selection (- company-selection |
+ |
3069 |
company-tooltip-limit)))))) |
+ |
3070 |
|
+ |
3071 |
(defun company--event-col-row (event) |
+ |
3072 |
(company--posn-col-row (event-start event))) |
+ |
3073 |
|
+ |
3074 |
(defvar company-mouse-event nil |
+ |
3075 |
"Holds the mouse event from `company-select-mouse'. |
+ |
3076 |
For use in the `select-mouse' frontend action. `let'-bound.") |
+ |
3077 |
|
+ |
3078 |
(defun company-select-mouse (event) |
+ |
3079 |
"Select the candidate picked by the mouse." |
+ |
3080 |
(interactive "e") |
+ |
3081 |
(or (let ((company-mouse-event event)) |
+ |
3082 |
(cl-some #'identity (company-call-frontends 'select-mouse))) |
+ |
3083 |
(progn |
+ |
3084 |
(company-abort) |
+ |
3085 |
(company--unread-this-command-keys) |
+ |
3086 |
nil))) |
+ |
3087 |
|
+ |
3088 |
(defun company-complete-mouse (event) |
+ |
3089 |
"Insert the candidate picked by the mouse." |
+ |
3090 |
(interactive "e") |
+ |
3091 |
(when (company-select-mouse event) |
+ |
3092 |
(company-complete-selection))) |
+ |
3093 |
|
+ |
3094 |
(defun company-complete-selection () |
+ |
3095 |
"Insert the selected candidate. |
+ |
3096 |
|
+ |
3097 |
Restart completion if a new field is entered. A field is indicated by |
+ |
3098 |
`adjust-boundaries' as implemented in the backend. If both adjusted prefix |
+ |
3099 |
and adjusted suffix are empty strings, that means a new field." |
+ |
3100 |
(interactive) |
+ |
3101 |
(when (and (company-manual-begin) company-selection) |
+ |
3102 |
(let ((result (nth company-selection company-candidates))) |
+ |
3103 |
(company-finish result)))) |
+ |
3104 |
|
+ |
3105 |
(defun company--expand-common (prefix suffix) |
+ |
3106 |
(let ((expansion (company-call-backend 'expand-common prefix suffix))) |
+ |
3107 |
(unless expansion |
+ |
3108 |
;; Backend doesn't implement this, try emulating. |
+ |
3109 |
(let* (;; XXX: We could also filter/group `company-candidates'. |
+ |
3110 |
(candidates (company-call-backend 'candidates prefix suffix)) |
+ |
3111 |
;; Assuming that boundaries don't vary between completions here. |
+ |
3112 |
;; If they do, the backend should have a custom `expand-common'. |
+ |
3113 |
(boundaries-prefix (car (company--boundaries))) |
+ |
3114 |
(completion-ignore-case (company-call-backend 'ignore-case)) |
+ |
3115 |
(trycmp (try-completion boundaries-prefix candidates)) |
+ |
3116 |
(common (if (eq trycmp t) (car candidates) trycmp)) |
+ |
3117 |
(max-len (when (and common |
+ |
3118 |
(cl-every (lambda (s) (string-suffix-p |
+ |
3119 |
suffix s |
+ |
3120 |
completion-ignore-case)) |
+ |
3121 |
candidates)) |
+ |
3122 |
(- |
+ |
3123 |
(apply #'min |
+ |
3124 |
(mapcar #'length candidates)) |
+ |
3125 |
(length suffix)))) |
+ |
3126 |
(common (if max-len |
+ |
3127 |
(substring common 0 |
+ |
3128 |
(min max-len (length common))) |
+ |
3129 |
common))) |
+ |
3130 |
(setq expansion |
+ |
3131 |
(cond |
+ |
3132 |
((null candidates) |
+ |
3133 |
'no-match) |
+ |
3134 |
((string-prefix-p boundaries-prefix common t) |
+ |
3135 |
(cons (concat |
+ |
3136 |
(substring prefix |
+ |
3137 |
0 |
+ |
3138 |
(- (length prefix) |
+ |
3139 |
(length boundaries-prefix))) |
+ |
3140 |
common) |
+ |
3141 |
suffix)) |
+ |
3142 |
(t (cons prefix suffix)))))) |
+ |
3143 |
expansion)) |
+ |
3144 |
|
+ |
3145 |
(defun company-complete-common () |
+ |
3146 |
"Insert the common part of all candidates." |
+ |
3147 |
(interactive) |
+ |
3148 |
(when (company-manual-begin) |
+ |
3149 |
(if (and (not (cdr company-candidates)) |
+ |
3150 |
(equal company-common (car company-candidates))) |
+ |
3151 |
(company-complete-selection) |
+ |
3152 |
(let ((expansion (company--expand-common company-prefix |
+ |
3153 |
company-suffix))) |
+ |
3154 |
(when (eq expansion 'no-match) |
+ |
3155 |
(user-error "No matches for the current input")) |
+ |
3156 |
(unless (equal (car expansion) company-prefix) |
+ |
3157 |
(if (eq (company-call-backend 'ignore-case) 'keep-prefix) |
+ |
3158 |
(insert (substring (car expansion) (length company-prefix))) |
+ |
3159 |
(delete-region (- (point) (length company-prefix)) (point)) |
+ |
3160 |
(insert (car expansion)))) |
+ |
3161 |
(unless (equal (cdr expansion) company-suffix) |
+ |
3162 |
(save-excursion |
+ |
3163 |
(delete-region (point) (+ (point) (length company-suffix))) |
+ |
3164 |
(insert (cdr expansion)))))))) |
+ |
3165 |
|
+ |
3166 |
(defun company-complete-common-or-cycle (&optional arg) |
+ |
3167 |
"Insert the common part of all candidates, or select the next one. |
+ |
3168 |
|
+ |
3169 |
With ARG, move by that many elements." |
+ |
3170 |
(interactive "p") |
+ |
3171 |
(when (company-manual-begin) |
+ |
3172 |
(let ((tick (buffer-chars-modified-tick))) |
+ |
3173 |
(call-interactively 'company-complete-common) |
+ |
3174 |
(when (eq tick (buffer-chars-modified-tick)) |
+ |
3175 |
(let ((company-selection-wrap-around t) |
+ |
3176 |
(current-prefix-arg arg)) |
+ |
3177 |
(call-interactively 'company-select-next)))))) |
+ |
3178 |
|
+ |
3179 |
(defun company-cycle-backward (&optional arg) |
+ |
3180 |
(interactive "p") |
+ |
3181 |
(let ((company-selection-wrap-around t)) |
+ |
3182 |
(company-select-previous arg))) |
+ |
3183 |
|
+ |
3184 |
(defun company-complete-common-or-show-delayed-tooltip () |
+ |
3185 |
"Insert the common part of all candidates, or show a tooltip." |
+ |
3186 |
(interactive) |
+ |
3187 |
(when (company-manual-begin) |
+ |
3188 |
(let ((tick (buffer-chars-modified-tick))) |
+ |
3189 |
(call-interactively 'company-complete-common) |
+ |
3190 |
(when (eq tick (buffer-chars-modified-tick)) |
+ |
3191 |
(let ((company-tooltip-idle-delay 0.0)) |
+ |
3192 |
(company-complete) |
+ |
3193 |
(and company-candidates |
+ |
3194 |
(company-call-frontends 'post-command))))))) |
+ |
3195 |
|
+ |
3196 |
(defun company-indent-or-complete-common (arg) |
+ |
3197 |
"Indent the current line or region, or complete the common part." |
+ |
3198 |
(interactive "P") |
+ |
3199 |
(cond |
+ |
3200 |
((use-region-p) |
+ |
3201 |
(indent-region (region-beginning) (region-end))) |
+ |
3202 |
((memq indent-line-function |
+ |
3203 |
'(indent-relative indent-relative-maybe)) |
+ |
3204 |
(company-complete-common)) |
+ |
3205 |
((let ((old-point (point)) |
+ |
3206 |
(old-tick (buffer-chars-modified-tick)) |
+ |
3207 |
(tab-always-indent t)) |
+ |
3208 |
(indent-for-tab-command arg) |
+ |
3209 |
(when (and (eq old-point (point)) |
+ |
3210 |
(eq old-tick (buffer-chars-modified-tick))) |
+ |
3211 |
(company-complete-common)))))) |
+ |
3212 |
|
+ |
3213 |
(defun company-select-next-if-tooltip-visible-or-complete-selection () |
+ |
3214 |
"Insert selection if appropriate, or select the next candidate. |
+ |
3215 |
Insert selection if only preview is showing or only one candidate, |
+ |
3216 |
otherwise select the next candidate." |
+ |
3217 |
(interactive) |
+ |
3218 |
(if (and (company-tooltip-visible-p) (> company-candidates-length 1)) |
+ |
3219 |
(call-interactively 'company-select-next) |
+ |
3220 |
(call-interactively 'company-complete-selection))) |
+ |
3221 |
|
+ |
3222 |
;;;###autoload |
+ |
3223 |
(defun company-complete () |
+ |
3224 |
"Insert the common part of all candidates or the current selection. |
+ |
3225 |
The first time this is called, the common part is inserted, the second |
+ |
3226 |
time, or when the selection has been changed, the selected candidate is |
+ |
3227 |
inserted." |
+ |
3228 |
(interactive) |
+ |
3229 |
(when (company-manual-begin) |
+ |
3230 |
(if (or company-selection-changed |
+ |
3231 |
(and (eq real-last-command 'company-complete) |
+ |
3232 |
(eq last-command 'company-complete-common))) |
+ |
3233 |
(call-interactively 'company-complete-selection) |
+ |
3234 |
(call-interactively 'company-complete-common) |
+ |
3235 |
(when company-candidates |
+ |
3236 |
(setq this-command 'company-complete-common))) |
+ |
3237 |
this-command)) |
+ |
3238 |
|
+ |
3239 |
(define-obsolete-function-alias |
+ |
3240 |
'company-complete-number |
+ |
3241 |
'company-complete-tooltip-row |
+ |
3242 |
"0.10.0") |
+ |
3243 |
|
+ |
3244 |
(defun company-complete-tooltip-row (number) |
+ |
3245 |
"Insert a candidate visible on the tooltip's row NUMBER. |
+ |
3246 |
|
+ |
3247 |
Inserts one of the first ten candidates, |
+ |
3248 |
numbered according to the current scrolling position starting with 1. |
+ |
3249 |
|
+ |
3250 |
When called interactively, uses the last typed digit, stripping the |
+ |
3251 |
modifiers and translating 0 into 10, so `M-1' inserts the first visible |
+ |
3252 |
candidate, and `M-0' insert to 10th one. |
+ |
3253 |
|
+ |
3254 |
To show hint numbers beside the candidates, enable `company-show-quick-access'." |
+ |
3255 |
(interactive |
+ |
3256 |
(list (let* ((type (event-basic-type last-command-event)) |
+ |
3257 |
(char (if (characterp type) |
+ |
3258 |
;; Number on the main row. |
+ |
3259 |
type |
+ |
3260 |
;; Keypad number, if bound directly. |
+ |
3261 |
(car (last (string-to-list (symbol-name type)))))) |
+ |
3262 |
(number (- char ?0))) |
+ |
3263 |
(if (zerop number) 10 number)))) |
+ |
3264 |
(company--complete-nth (1- number))) |
+ |
3265 |
|
+ |
3266 |
(defun company-complete-quick-access (row) |
+ |
3267 |
"Insert a candidate visible on a ROW matched by a quick-access key binding. |
+ |
3268 |
See `company-quick-access-keys' for more details." |
+ |
3269 |
(interactive |
+ |
3270 |
(list (let* ((event-type (event-basic-type last-command-event)) |
+ |
3271 |
(event-string (if (characterp event-type) |
+ |
3272 |
(string event-type) |
+ |
3273 |
(error "Unexpected input")))) |
+ |
3274 |
(cl-position event-string company-quick-access-keys :test 'equal)))) |
+ |
3275 |
(when row |
+ |
3276 |
(company--complete-nth row))) |
+ |
3277 |
|
+ |
3278 |
(defvar-local company-tooltip-offset 0 |
+ |
3279 |
"Current scrolling state of the tooltip. |
+ |
3280 |
Represented by the index of the first visible completion candidate |
+ |
3281 |
from the candidates list.") |
+ |
3282 |
|
+ |
3283 |
(defun company--complete-nth (row) |
+ |
3284 |
"Insert a candidate visible on the tooltip's zero-based ROW." |
+ |
3285 |
(when (company-manual-begin) |
+ |
3286 |
(and (or (< row 0) (>= row (- company-candidates-length |
+ |
3287 |
company-tooltip-offset))) |
+ |
3288 |
(user-error "No candidate on the row number %d" row)) |
+ |
3289 |
(company-finish (nth (+ row company-tooltip-offset) |
+ |
3290 |
company-candidates)))) |
+ |
3291 |
|
+ |
3292 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
+ |
3293 |
|
+ |
3294 |
(defconst company-space-strings-limit 100) |
+ |
3295 |
|
+ |
3296 |
(defconst company-space-strings |
+ |
3297 |
(let (lst) |
+ |
3298 |
(dotimes (i company-space-strings-limit) |
+ |
3299 |
(push (make-string (- company-space-strings-limit 1 i) ?\ ) lst)) |
+ |
3300 |
(apply 'vector lst))) |
+ |
3301 |
|
+ |
3302 |
(defun company-space-string (len) |
+ |
3303 |
(if (< len company-space-strings-limit) |
+ |
3304 |
(aref company-space-strings len) |
+ |
3305 |
(make-string len ?\ ))) |
+ |
3306 |
|
+ |
3307 |
;; XXX: This is really a hack, but one that we could really get rid of only by |
+ |
3308 |
;; moving to the one-overlay-per-line scheme. |
+ |
3309 |
(defmacro company--with-face-remappings (&rest body) |
+ |
3310 |
`(let ((fra-local (and (local-variable-p 'face-remapping-alist) |
+ |
3311 |
face-remapping-alist)) |
+ |
3312 |
(bdt-local (and (local-variable-p 'buffer-display-table) |
+ |
3313 |
buffer-display-table)) |
+ |
3314 |
(bufs (list (get-buffer-create " *string-pixel-width*") |
+ |
3315 |
(get-buffer-create " *company-sps*")))) |
+ |
3316 |
(unwind-protect |
+ |
3317 |
(progn |
+ |
3318 |
(dolist (buf bufs) |
+ |
3319 |
(with-current-buffer buf |
+ |
3320 |
(when (bound-and-true-p display-line-numbers) |
+ |
3321 |
;; Workaround for debbugs#67248. |
+ |
3322 |
(setq-local display-line-numbers nil)) |
+ |
3323 |
(when fra-local |
+ |
3324 |
(setq-local face-remapping-alist fra-local)) |
+ |
3325 |
(when bdt-local |
+ |
3326 |
(setq-local buffer-display-table bdt-local)))) |
+ |
3327 |
,@body) |
+ |
3328 |
(dolist (buf bufs) |
+ |
3329 |
(and (buffer-live-p buf) |
+ |
3330 |
(with-current-buffer buf |
+ |
3331 |
(kill-local-variable 'face-remapping-alist) |
+ |
3332 |
(kill-local-variable 'buffer-display-table))))))) |
+ |
3333 |
|
+ |
3334 |
(declare-function buffer-text-pixel-size "xdisp.c") |
+ |
3335 |
|
+ |
3336 |
(defun company--string-pixel-width (string) |
+ |
3337 |
(if (zerop (length string)) |
+ |
3338 |
0 |
+ |
3339 |
;; Keeping a work buffer around is more efficient than creating a |
+ |
3340 |
;; new temporary buffer. |
+ |
3341 |
(with-current-buffer (get-buffer-create " *string-pixel-width*") |
+ |
3342 |
;; `display-line-numbers-mode' is enabled in internal buffers |
+ |
3343 |
;; that breaks width calculation, so need to disable (bug#59311) |
+ |
3344 |
(when (bound-and-true-p display-line-numbers-mode) |
+ |
3345 |
(with-no-warnings ;; Emacs 25 |
+ |
3346 |
(display-line-numbers-mode -1))) |
+ |
3347 |
(delete-region (point-min) (point-max)) |
+ |
3348 |
(insert string) |
+ |
3349 |
(if (fboundp #'buffer-text-pixel-size) |
+ |
3350 |
;; Emacs 29.1+ |
+ |
3351 |
(car (buffer-text-pixel-size nil nil t)) |
+ |
3352 |
(let ((wb (window-buffer)) |
+ |
3353 |
(hscroll (window-hscroll)) |
+ |
3354 |
(dedicated (window-dedicated-p)) |
+ |
3355 |
buffer-list-update-hook) |
+ |
3356 |
(unwind-protect |
+ |
3357 |
(progn |
+ |
3358 |
(when dedicated |
+ |
3359 |
(set-window-dedicated-p nil nil)) |
+ |
3360 |
(set-window-buffer nil (current-buffer)) |
+ |
3361 |
(car |
+ |
3362 |
(window-text-pixel-size nil nil nil 55555))) |
+ |
3363 |
(set-window-buffer nil wb) |
+ |
3364 |
(set-window-hscroll nil hscroll) |
+ |
3365 |
(when dedicated |
+ |
3366 |
(set-window-dedicated-p nil dedicated)))))))) |
+ |
3367 |
|
+ |
3368 |
(defun company--string-width (str) |
+ |
3369 |
(if (display-graphic-p) |
+ |
3370 |
(ceiling (/ (company--string-pixel-width str) |
+ |
3371 |
(float (default-font-width)))) |
+ |
3372 |
(string-width str))) |
+ |
3373 |
|
+ |
3374 |
;; TODO: Add more tests! |
+ |
3375 |
(defun company-safe-pixel-substring (str from &optional to) |
+ |
3376 |
(let ((from-chars 0) |
+ |
3377 |
(to-chars 0) |
+ |
3378 |
spw-from spw-to |
+ |
3379 |
spw-to-prev |
+ |
3380 |
front back |
+ |
3381 |
(orig-buf (window-buffer)) |
+ |
3382 |
(bis buffer-invisibility-spec) |
+ |
3383 |
(inhibit-read-only t) |
+ |
3384 |
(inhibit-modification-hooks t) |
+ |
3385 |
(dedicated (window-dedicated-p)) |
+ |
3386 |
(hscroll (window-hscroll)) |
+ |
3387 |
window-configuration-change-hook |
+ |
3388 |
buffer-list-update-hook) |
+ |
3389 |
(with-current-buffer (get-buffer-create " *company-sps*") |
+ |
3390 |
(unwind-protect |
+ |
3391 |
(progn |
+ |
3392 |
(delete-region (point-min) (point-max)) |
+ |
3393 |
(insert str) |
+ |
3394 |
(setq-local buffer-invisibility-spec bis) |
+ |
3395 |
(when dedicated (set-window-dedicated-p nil nil)) |
+ |
3396 |
(set-window-buffer nil (current-buffer) t) |
+ |
3397 |
|
+ |
3398 |
(vertical-motion (cons (/ from (frame-char-width)) 0)) |
+ |
3399 |
(setq from-chars (point)) |
+ |
3400 |
(setq spw-from |
+ |
3401 |
(if (bobp) 0 |
+ |
3402 |
(car (window-text-pixel-size nil (point-min) (point) 55555)))) |
+ |
3403 |
(while (and (< spw-from from) |
+ |
3404 |
(not (eolp))) |
+ |
3405 |
(forward-char 1) |
+ |
3406 |
(setq spw-from |
+ |
3407 |
(car (window-text-pixel-size nil (point-min) (point) 55555))) |
+ |
3408 |
(setq from-chars (point))) |
+ |
3409 |
|
+ |
3410 |
(if (= from-chars (point-max)) |
+ |
3411 |
(if (and to (> to from)) |
+ |
3412 |
(propertize " " 'display `(space . (:width (,(- to from))))) |
+ |
3413 |
"") |
+ |
3414 |
(if (not to) |
+ |
3415 |
(setq to-chars (point-max)) |
+ |
3416 |
(vertical-motion (cons (/ to (frame-char-width)) 0)) |
+ |
3417 |
(setq to-chars (point)) |
+ |
3418 |
(setq spw-to |
+ |
3419 |
(if (bobp) 0 |
+ |
3420 |
(car (window-text-pixel-size nil (point-min) (point) 55555)))) |
+ |
3421 |
(while (and (< spw-to to) |
+ |
3422 |
(not (eolp))) |
+ |
3423 |
(setq spw-to-prev spw-to) |
+ |
3424 |
(forward-char 1) |
+ |
3425 |
(setq spw-to |
+ |
3426 |
(car (window-text-pixel-size nil (point-min) (point) 55555))) |
+ |
3427 |
(when (<= spw-to to) |
+ |
3428 |
(setq to-chars (point))))) |
+ |
3429 |
|
+ |
3430 |
(unless spw-to-prev (setq spw-to-prev spw-to)) |
+ |
3431 |
|
+ |
3432 |
(when (> spw-from from) |
+ |
3433 |
(setq front (propertize " " 'display |
+ |
3434 |
`(space . (:width (,(- spw-from from))))))) |
+ |
3435 |
(when (and to (/= spw-to to)) |
+ |
3436 |
(setq back (propertize |
+ |
3437 |
" " 'display |
+ |
3438 |
`(space . (:width (,(- to |
+ |
3439 |
(if (< spw-to to) |
+ |
3440 |
spw-to |
+ |
3441 |
spw-to-prev)))))))) |
+ |
3442 |
(concat front (buffer-substring from-chars to-chars) back))) |
+ |
3443 |
(set-window-buffer nil orig-buf t) |
+ |
3444 |
(set-window-hscroll nil hscroll) |
+ |
3445 |
(when dedicated |
+ |
3446 |
(set-window-dedicated-p nil dedicated)))))) |
+ |
3447 |
|
+ |
3448 |
(defun company-safe-substring (str from &optional to) |
+ |
3449 |
(let ((ll (length str))) |
+ |
3450 |
(if (> from ll) |
+ |
3451 |
"" |
+ |
3452 |
(if to |
+ |
3453 |
(concat (substring str from (min to ll)) |
+ |
3454 |
(company-space-string (max 0 (- to ll)))) |
+ |
3455 |
(substring str from))))) |
+ |
3456 |
|
+ |
3457 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
+ |
3458 |
|
+ |
3459 |
(defvar-local company-last-metadata nil) |
+ |
3460 |
|
+ |
3461 |
(defun company-fetch-metadata () |
+ |
3462 |
(let ((selected (nth (or company-selection 0) company-candidates))) |
+ |
3463 |
(unless (eq selected (car company-last-metadata)) |
+ |
3464 |
(setq company-last-metadata |
+ |
3465 |
(cons selected (company-call-backend 'meta selected)))) |
+ |
3466 |
(cdr company-last-metadata))) |
+ |
3467 |
|
+ |
3468 |
(defun company-doc-buffer (&optional string) |
+ |
3469 |
(with-current-buffer (get-buffer-create "*company-documentation*") |
+ |
3470 |
(erase-buffer) |
+ |
3471 |
(fundamental-mode) |
+ |
3472 |
(when string |
+ |
3473 |
(save-excursion |
+ |
3474 |
(insert string) |
+ |
3475 |
(visual-line-mode))) |
+ |
3476 |
(current-buffer))) |
+ |
3477 |
|
+ |
3478 |
(defvar company--electric-saved-window-configuration nil) |
+ |
3479 |
|
+ |
3480 |
(defvar company--electric-commands |
+ |
3481 |
'(scroll-other-window scroll-other-window-down mwheel-scroll) |
+ |
3482 |
"List of Commands that won't break out of electric commands.") |
+ |
3483 |
|
+ |
3484 |
(defun company--electric-command-p () |
+ |
3485 |
(memq this-command company--electric-commands)) |
+ |
3486 |
|
+ |
3487 |
(defun company--electric-restore-window-configuration () |
+ |
3488 |
"Restore window configuration (after electric commands)." |
+ |
3489 |
(when (and company--electric-saved-window-configuration |
+ |
3490 |
(not (company--electric-command-p))) |
+ |
3491 |
(set-window-configuration company--electric-saved-window-configuration) |
+ |
3492 |
(setq company--electric-saved-window-configuration nil))) |
+ |
3493 |
|
+ |
3494 |
(defmacro company--electric-do (&rest body) |
+ |
3495 |
(declare (indent 0) (debug t)) |
+ |
3496 |
`(when company-candidates |
+ |
3497 |
(cl-assert (null company--electric-saved-window-configuration)) |
+ |
3498 |
(setq company--electric-saved-window-configuration (current-window-configuration)) |
+ |
3499 |
(let ((height (window-height)) |
+ |
3500 |
(row (company--row))) |
+ |
3501 |
,@body |
+ |
3502 |
(and (< (window-height) height) |
+ |
3503 |
(< (- (window-height) row 2) company-tooltip-limit) |
+ |
3504 |
(recenter (- (window-height) row 2)))))) |
+ |
3505 |
|
+ |
3506 |
(defun company--unread-this-command-keys () |
+ |
3507 |
(when (> (length (this-command-keys)) 0) |
+ |
3508 |
(setq unread-command-events (nconc |
+ |
3509 |
(listify-key-sequence (this-command-keys)) |
+ |
3510 |
unread-command-events)) |
+ |
3511 |
(clear-this-command-keys t))) |
+ |
3512 |
|
+ |
3513 |
(defun company--show-doc-buffer () |
+ |
3514 |
"Show the documentation buffer for the selection." |
+ |
3515 |
(let ((other-window-scroll-buffer) |
+ |
3516 |
(selection (or company-selection 0))) |
+ |
3517 |
(let* ((selected (nth selection company-candidates)) |
+ |
3518 |
(doc-buffer (or (company-call-backend 'doc-buffer selected) |
+ |
3519 |
(user-error "No documentation available"))) |
+ |
3520 |
start) |
+ |
3521 |
(when (consp doc-buffer) |
+ |
3522 |
(setq start (cdr doc-buffer) |
+ |
3523 |
doc-buffer (car doc-buffer))) |
+ |
3524 |
(setq other-window-scroll-buffer (get-buffer doc-buffer)) |
+ |
3525 |
(let ((win (display-buffer doc-buffer t))) |
+ |
3526 |
(set-window-start win (if start start (point-min))))))) |
+ |
3527 |
|
+ |
3528 |
(defun company-show-doc-buffer (&optional toggle-auto-update) |
+ |
3529 |
"Show the documentation buffer for the selection. |
+ |
3530 |
With a prefix argument TOGGLE-AUTO-UPDATE, toggle the value of |
+ |
3531 |
`company-auto-update-doc'. When `company-auto-update-doc' is non-nil, |
+ |
3532 |
automatically show the documentation buffer for each selection." |
+ |
3533 |
(interactive "P") |
+ |
3534 |
(when toggle-auto-update |
+ |
3535 |
(setq company-auto-update-doc (not company-auto-update-doc))) |
+ |
3536 |
(company--electric-do |
+ |
3537 |
(company--show-doc-buffer))) |
+ |
3538 |
(put 'company-show-doc-buffer 'company-keep t) |
+ |
3539 |
|
+ |
3540 |
(defun company-show-location () |
+ |
3541 |
"Temporarily display a buffer showing the selected candidate in context." |
+ |
3542 |
(interactive) |
+ |
3543 |
(let (other-window-scroll-buffer) |
+ |
3544 |
(company--electric-do |
+ |
3545 |
(let* ((selected (nth company-selection company-candidates)) |
+ |
3546 |
(location (company-call-backend 'location selected)) |
+ |
3547 |
(pos (or (cdr location) (user-error "No location available"))) |
+ |
3548 |
(buffer (or (and (bufferp (car location)) (car location)) |
+ |
3549 |
(find-file-noselect (car location) t)))) |
+ |
3550 |
(setq other-window-scroll-buffer (get-buffer buffer)) |
+ |
3551 |
(with-selected-window (display-buffer buffer t) |
+ |
3552 |
(save-restriction |
+ |
3553 |
(widen) |
+ |
3554 |
(if (bufferp (car location)) |
+ |
3555 |
(goto-char pos) |
+ |
3556 |
(goto-char (point-min)) |
+ |
3557 |
(forward-line (1- pos)))) |
+ |
3558 |
(set-window-start nil (point))))))) |
+ |
3559 |
(put 'company-show-location 'company-keep t) |
+ |
3560 |
|
+ |
3561 |
;;; package functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
+ |
3562 |
|
+ |
3563 |
(defvar-local company-callback nil) |
+ |
3564 |
|
+ |
3565 |
(defun company-remove-callback (&optional _ignored) |
+ |
3566 |
(remove-hook 'company-completion-finished-hook company-callback t) |
+ |
3567 |
(remove-hook 'company-completion-cancelled-hook 'company-remove-callback t) |
+ |
3568 |
(remove-hook 'company-completion-finished-hook 'company-remove-callback t)) |
+ |
3569 |
|
+ |
3570 |
(defun company-begin-backend (backend &optional callback) |
+ |
3571 |
"Start a completion at point using BACKEND." |
+ |
3572 |
(interactive (let ((val (completing-read "Company backend: " |
+ |
3573 |
obarray |
+ |
3574 |
'functionp nil "company-"))) |
+ |
3575 |
(when val |
+ |
3576 |
(list (intern val))))) |
+ |
3577 |
(when (setq company-callback callback) |
+ |
3578 |
(add-hook 'company-completion-finished-hook company-callback nil t)) |
+ |
3579 |
(add-hook 'company-completion-cancelled-hook 'company-remove-callback nil t) |
+ |
3580 |
(add-hook 'company-completion-finished-hook 'company-remove-callback nil t) |
+ |
3581 |
(setq company-backend backend) |
+ |
3582 |
;; Return non-nil if active. |
+ |
3583 |
(or (company-manual-begin) |
+ |
3584 |
(user-error "Cannot complete at point"))) |
+ |
3585 |
|
+ |
3586 |
(defun company-begin-with (candidates |
+ |
3587 |
&optional prefix-length require-match callback) |
+ |
3588 |
"Start a completion at point. |
+ |
3589 |
CANDIDATES is the list of candidates to use and PREFIX-LENGTH is the length |
+ |
3590 |
of the prefix that already is in the buffer before point. |
+ |
3591 |
It defaults to 0. |
+ |
3592 |
|
+ |
3593 |
CALLBACK is a function called with the selected result if the user |
+ |
3594 |
successfully completes the input. |
+ |
3595 |
|
+ |
3596 |
Example: \(company-begin-with \\='\(\"foo\" \"foobar\" \"foobarbaz\"\)\)" |
+ |
3597 |
(let ((begin-marker (copy-marker (point) t))) |
+ |
3598 |
(company-begin-backend |
+ |
3599 |
(lambda (command &optional arg &rest _ignored) |
+ |
3600 |
(pcase command |
+ |
3601 |
(`prefix |
+ |
3602 |
(when (equal (point) (marker-position begin-marker)) |
+ |
3603 |
(buffer-substring (- (point) (or prefix-length 0)) (point)))) |
+ |
3604 |
(`candidates |
+ |
3605 |
(all-completions arg candidates)) |
+ |
3606 |
(`require-match |
+ |
3607 |
require-match))) |
+ |
3608 |
callback))) |
+ |
3609 |
|
+ |
3610 |
(declare-function find-library-name "find-func") |
+ |
3611 |
(declare-function lm-version "lisp-mnt") |
+ |
3612 |
|
+ |
3613 |
(defun company-version (&optional show-version) |
+ |
3614 |
"Get the Company version as string. |
+ |
3615 |
|
+ |
3616 |
If SHOW-VERSION is non-nil, show the version in the echo area." |
+ |
3617 |
(interactive (list t)) |
+ |
3618 |
(with-temp-buffer |
+ |
3619 |
(require 'find-func) |
+ |
3620 |
(insert-file-contents (find-library-name "company")) |
+ |
3621 |
(require 'lisp-mnt) |
+ |
3622 |
(if show-version |
+ |
3623 |
(message "Company version: %s" (lm-version)) |
+ |
3624 |
(lm-version)))) |
+ |
3625 |
|
+ |
3626 |
(defun company-diag () |
+ |
3627 |
"Pop a buffer with information about completions at point." |
+ |
3628 |
(interactive) |
+ |
3629 |
(let* ((bb company-backends) |
+ |
3630 |
(mode (symbol-name major-mode)) |
+ |
3631 |
backend |
+ |
3632 |
(prefix (cl-loop for b in bb |
+ |
3633 |
thereis (let ((company-backend b)) |
+ |
3634 |
(setq backend b) |
+ |
3635 |
(company-call-backend 'prefix)))) |
+ |
3636 |
(c-a-p-f completion-at-point-functions) |
+ |
3637 |
cc annotations) |
+ |
3638 |
(when (or (stringp prefix) (consp prefix)) |
+ |
3639 |
(let ((company-backend backend)) |
+ |
3640 |
(condition-case nil |
+ |
3641 |
(setq cc (company-call-backend 'candidates |
+ |
3642 |
(company--prefix-str prefix) |
+ |
3643 |
(company--suffix-str prefix)) |
+ |
3644 |
annotations |
+ |
3645 |
(mapcar |
+ |
3646 |
(lambda (c) (cons c (company-call-backend 'annotation c))) |
+ |
3647 |
cc)) |
+ |
3648 |
(error (setq annotations 'error))))) |
+ |
3649 |
(pop-to-buffer (get-buffer-create "*company-diag*")) |
+ |
3650 |
(setq buffer-read-only nil) |
+ |
3651 |
(erase-buffer) |
+ |
3652 |
(insert (format "Emacs %s (%s) of %s on %s" |
+ |
3653 |
emacs-version system-configuration |
+ |
3654 |
(format-time-string "%Y-%m-%d" emacs-build-time) |
+ |
3655 |
emacs-build-system)) |
+ |
3656 |
(insert "\nCompany " (company-version) "\n\n") |
+ |
3657 |
(insert "company-backends: " (pp-to-string bb)) |
+ |
3658 |
(insert "\n") |
+ |
3659 |
(insert "Used backend: " (pp-to-string backend)) |
+ |
3660 |
(insert "\n") |
+ |
3661 |
(when (if (listp backend) |
+ |
3662 |
(memq 'company-capf backend) |
+ |
3663 |
(eq backend 'company-capf)) |
+ |
3664 |
(insert "Value of c-a-p-f: " |
+ |
3665 |
(pp-to-string c-a-p-f))) |
+ |
3666 |
(insert "Major mode: " mode) |
+ |
3667 |
(insert "\n") |
+ |
3668 |
(insert "Prefix: " (pp-to-string prefix)) |
+ |
3669 |
(insert "\n") |
+ |
3670 |
(insert "Completions:") |
+ |
3671 |
(unless cc (insert " none")) |
+ |
3672 |
(if (eq annotations 'error) |
+ |
3673 |
(insert "(error fetching)") |
+ |
3674 |
(save-excursion |
+ |
3675 |
(dolist (c annotations) |
+ |
3676 |
(insert "\n " (prin1-to-string (car c))) |
+ |
3677 |
(when (cdr c) |
+ |
3678 |
(insert " " (prin1-to-string (cdr c))))))) |
+ |
3679 |
(special-mode))) |
+ |
3680 |
|
+ |
3681 |
;;; pseudo-tooltip ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
+ |
3682 |
|
+ |
3683 |
(defvar-local company--tooltip-current-width 0) |
+ |
3684 |
|
+ |
3685 |
(defun company-tooltip--lines-update-offset (selection num-lines limit) |
+ |
3686 |
(cl-decf limit 2) |
+ |
3687 |
(setq company-tooltip-offset |
+ |
3688 |
(max (min selection company-tooltip-offset) |
+ |
3689 |
(- selection -1 limit))) |
+ |
3690 |
|
+ |
3691 |
(when (<= company-tooltip-offset 1) |
+ |
3692 |
(cl-incf limit) |
+ |
3693 |
(setq company-tooltip-offset 0)) |
+ |
3694 |
|
+ |
3695 |
(when (>= company-tooltip-offset (- num-lines limit 1)) |
+ |
3696 |
(cl-incf limit) |
+ |
3697 |
(when (= selection (1- num-lines)) |
+ |
3698 |
(cl-decf company-tooltip-offset) |
+ |
3699 |
(when (<= company-tooltip-offset 1) |
+ |
3700 |
(setq company-tooltip-offset 0) |
+ |
3701 |
(cl-incf limit)))) |
+ |
3702 |
|
+ |
3703 |
limit) |
+ |
3704 |
|
+ |
3705 |
(defun company-tooltip--simple-update-offset (selection _num-lines limit) |
+ |
3706 |
(setq company-tooltip-offset |
+ |
3707 |
(if (< selection company-tooltip-offset) |
+ |
3708 |
selection |
+ |
3709 |
(max company-tooltip-offset |
+ |
3710 |
(- selection limit -1))))) |
+ |
3711 |
|
+ |
3712 |
;;; propertize |
+ |
3713 |
|
+ |
3714 |
(defun company-round-tab (arg) |
+ |
3715 |
(* (/ (+ arg tab-width) tab-width) tab-width)) |
+ |
3716 |
|
+ |
3717 |
(defun company-plainify (str) |
+ |
3718 |
(let ((prefix (get-text-property 0 'line-prefix str))) |
+ |
3719 |
(when (stringp prefix) ; Keep the original value unmodified, for no special reason. |
+ |
3720 |
(setq str (concat prefix str)) |
+ |
3721 |
(remove-text-properties 0 (length str) '(line-prefix) str))) |
+ |
3722 |
(let* ((pieces (split-string str "\t")) |
+ |
3723 |
(copy pieces)) |
+ |
3724 |
(while (cdr copy) |
+ |
3725 |
(setcar copy (company-safe-substring |
+ |
3726 |
(car copy) 0 (company-round-tab (string-width (car copy))))) |
+ |
3727 |
(pop copy)) |
+ |
3728 |
(apply 'concat pieces))) |
+ |
3729 |
|
+ |
3730 |
(defun company--common-or-matches (value &optional suffix) |
+ |
3731 |
(let ((matches (company-call-backend 'match value))) |
+ |
3732 |
(when (integerp matches) |
+ |
3733 |
(setq matches `((0 . ,matches)))) |
+ |
3734 |
(or matches |
+ |
3735 |
(and company-common `((0 . ,(length company-common)) |
+ |
3736 |
,@(list |
+ |
3737 |
(cons |
+ |
3738 |
(- (length value) |
+ |
3739 |
(length (or suffix |
+ |
3740 |
(cdr (company--boundaries value))))) |
+ |
3741 |
(length value))))) |
+ |
3742 |
nil))) |
+ |
3743 |
|
+ |
3744 |
(defun company-fill-propertize (value annotation width selected left right) |
+ |
3745 |
(let* ((margin (length left)) |
+ |
3746 |
(common (company--common-or-matches value)) |
+ |
3747 |
(_ (setq value |
+ |
3748 |
(company--clean-string |
+ |
3749 |
(company-reformat (company--pre-render value))) |
+ |
3750 |
annotation (and annotation |
+ |
3751 |
(company--clean-string |
+ |
3752 |
(company--pre-render annotation t))))) |
+ |
3753 |
(ann-ralign company-tooltip-align-annotations) |
+ |
3754 |
(ann-padding (or company-tooltip-annotation-padding 0)) |
+ |
3755 |
(ann-truncate (< width |
+ |
3756 |
(+ (length value) (length annotation) |
+ |
3757 |
ann-padding))) |
+ |
3758 |
(ann-start (+ margin |
+ |
3759 |
(if ann-ralign |
+ |
3760 |
(if ann-truncate |
+ |
3761 |
(+ (length value) ann-padding) |
+ |
3762 |
(- width (length annotation))) |
+ |
3763 |
(+ (length value) ann-padding)))) |
+ |
3764 |
(ann-end (min (+ ann-start (length annotation)) (+ margin width))) |
+ |
3765 |
(line (concat left |
+ |
3766 |
(if (or ann-truncate (not ann-ralign)) |
+ |
3767 |
(company-safe-substring |
+ |
3768 |
(concat value |
+ |
3769 |
(when annotation |
+ |
3770 |
(company-space-string ann-padding)) |
+ |
3771 |
annotation) |
+ |
3772 |
0 width) |
+ |
3773 |
(concat |
+ |
3774 |
(company-safe-substring value 0 |
+ |
3775 |
(- width (length annotation))) |
+ |
3776 |
annotation)) |
+ |
3777 |
right))) |
+ |
3778 |
(setq width (+ width margin (length right))) |
+ |
3779 |
|
+ |
3780 |
(font-lock-append-text-property 0 width 'mouse-face |
+ |
3781 |
'company-tooltip-mouse |
+ |
3782 |
line) |
+ |
3783 |
(when (< ann-start ann-end) |
+ |
3784 |
(add-face-text-property ann-start ann-end |
+ |
3785 |
(if selected |
+ |
3786 |
'company-tooltip-annotation-selection |
+ |
3787 |
'company-tooltip-annotation) |
+ |
3788 |
t line)) |
+ |
3789 |
(cl-loop |
+ |
3790 |
with width = (- width (length right)) |
+ |
3791 |
for (comp-beg . comp-end) in common |
+ |
3792 |
for inline-beg = (+ margin comp-beg) |
+ |
3793 |
for inline-end = (min (+ margin comp-end) width) |
+ |
3794 |
when (< inline-beg width) |
+ |
3795 |
do (add-face-text-property inline-beg inline-end |
+ |
3796 |
(if selected |
+ |
3797 |
'company-tooltip-common-selection |
+ |
3798 |
'company-tooltip-common) |
+ |
3799 |
nil line)) |
+ |
3800 |
(when (let ((re (funcall company-search-regexp-function |
+ |
3801 |
company-search-string))) |
+ |
3802 |
(and (not (string-empty-p re)) |
+ |
3803 |
(string-match re value))) |
+ |
3804 |
(pcase-dolist (`(,mbeg . ,mend) (company--search-chunks)) |
+ |
3805 |
(let ((beg (+ margin mbeg)) |
+ |
3806 |
(end (+ margin mend)) |
+ |
3807 |
(width (- width (length right)))) |
+ |
3808 |
(when (< beg width) |
+ |
3809 |
(add-face-text-property beg (min end width) |
+ |
3810 |
(if selected |
+ |
3811 |
'company-tooltip-search-selection |
+ |
3812 |
'company-tooltip-search) |
+ |
3813 |
nil line))))) |
+ |
3814 |
(when selected |
+ |
3815 |
(add-face-text-property 0 width 'company-tooltip-selection t line)) |
+ |
3816 |
|
+ |
3817 |
(when (company-call-backend 'deprecated value) |
+ |
3818 |
(add-face-text-property margin |
+ |
3819 |
(min |
+ |
3820 |
(+ margin (length value)) |
+ |
3821 |
(- width (length right))) |
+ |
3822 |
'company-tooltip-deprecated t line)) |
+ |
3823 |
|
+ |
3824 |
(add-face-text-property 0 width 'company-tooltip t line) |
+ |
3825 |
line)) |
+ |
3826 |
|
+ |
3827 |
(defun company--search-chunks () |
+ |
3828 |
(let ((md (match-data t)) |
+ |
3829 |
res) |
+ |
3830 |
(if (<= (length md) 2) |
+ |
3831 |
(push (cons (nth 0 md) (nth 1 md)) res) |
+ |
3832 |
(while (setq md (nthcdr 2 md)) |
+ |
3833 |
(when (car md) |
+ |
3834 |
(push (cons (car md) (cadr md)) res)))) |
+ |
3835 |
res)) |
+ |
3836 |
|
+ |
3837 |
(defun company--pre-render (str &optional annotation-p) |
+ |
3838 |
(or (company-call-backend 'pre-render str annotation-p) |
+ |
3839 |
(progn |
+ |
3840 |
(when (or (text-property-not-all 0 (length str) 'face nil str) |
+ |
3841 |
(text-property-not-all 0 (length str) 'mouse-face nil str)) |
+ |
3842 |
(setq str (copy-sequence str)) |
+ |
3843 |
(remove-text-properties 0 (length str) |
+ |
3844 |
'(face nil font-lock-face nil mouse-face nil) |
+ |
3845 |
str)) |
+ |
3846 |
str))) |
+ |
3847 |
|
+ |
3848 |
(defun company--clean-string (str) |
+ |
3849 |
(let* ((add-pixels 0) |
+ |
3850 |
(add-length 0) |
+ |
3851 |
(new-str |
+ |
3852 |
(replace-regexp-in-string |
+ |
3853 |
"\\([^[:graph:] ]\\)\\|\\(\ufeff\\)\\|[[:multibyte:]]+" |
+ |
3854 |
(lambda (match) |
+ |
3855 |
(cond |
+ |
3856 |
((match-beginning 1) |
+ |
3857 |
;; FIXME: Better char for 'non-printable'? |
+ |
3858 |
;; We shouldn't get any of these, but sometimes we might. |
+ |
3859 |
;; The official "replacement character" is not supported by some fonts. |
+ |
3860 |
;;"\ufffd" |
+ |
3861 |
(if (equal match "\n") |
+ |
3862 |
(propertize "\\\\n" 'face 'font-lock-escape-face) |
+ |
3863 |
"?") |
+ |
3864 |
) |
+ |
3865 |
((match-beginning 2) |
+ |
3866 |
;; Zero-width non-breakable space. |
+ |
3867 |
"") |
+ |
3868 |
(t |
+ |
3869 |
;; FIXME: Maybe move that counting later to a non-replacement loop. |
+ |
3870 |
(let ((msw (company--string-width match))) |
+ |
3871 |
(cl-incf add-pixels |
+ |
3872 |
(- (* (default-font-width) |
+ |
3873 |
msw) |
+ |
3874 |
(company--string-pixel-width match))) |
+ |
3875 |
(cl-incf add-length (- msw (length match))) |
+ |
3876 |
match |
+ |
3877 |
)) |
+ |
3878 |
)) |
+ |
3879 |
str))) |
+ |
3880 |
(if (>= 0 add-length) |
+ |
3881 |
new-str |
+ |
3882 |
(concat new-str |
+ |
3883 |
(propertize |
+ |
3884 |
(make-string add-length ?\ufeff) |
+ |
3885 |
'display `(space . (:width (,add-pixels)))))))) |
+ |
3886 |
|
+ |
3887 |
;;; replace |
+ |
3888 |
|
+ |
3889 |
(defun company-buffer-lines (beg end) |
+ |
3890 |
(goto-char beg) |
+ |
3891 |
(let (lines lines-moved) |
+ |
3892 |
(while (and (not (eobp)) ; http://debbugs.gnu.org/19553 |
+ |
3893 |
(> (setq lines-moved (vertical-motion 1)) 0) |
+ |
3894 |
(<= (point) end)) |
+ |
3895 |
(let ((bound (min end (point)))) |
+ |
3896 |
;; A visual line can contain several physical lines (e.g. with outline's |
+ |
3897 |
;; folding overlay). Take only the first one. |
+ |
3898 |
(push (buffer-substring beg |
+ |
3899 |
(save-excursion |
+ |
3900 |
(goto-char beg) |
+ |
3901 |
(re-search-forward "$" bound 'move) |
+ |
3902 |
(point))) |
+ |
3903 |
lines)) |
+ |
3904 |
;; One physical line can be displayed as several visual ones as well: |
+ |
3905 |
;; add empty strings to the list, to even the count. |
+ |
3906 |
(dotimes (_ (1- lines-moved)) |
+ |
3907 |
(push "" lines)) |
+ |
3908 |
(setq beg (point))) |
+ |
3909 |
(unless (eq beg end) |
+ |
3910 |
(push (buffer-substring beg end) lines)) |
+ |
3911 |
(nreverse lines))) |
+ |
3912 |
|
+ |
3913 |
(defun company-modify-line (old new offset) |
+ |
3914 |
(if (not new) |
+ |
3915 |
;; Avoid modifying OLD, e.g. to avoid "blinking" with half-spaces for |
+ |
3916 |
;; double-width (or usually fractional) characters. |
+ |
3917 |
old |
+ |
3918 |
(concat (company-safe-pixel-substring old 0 offset) |
+ |
3919 |
new |
+ |
3920 |
(company-safe-pixel-substring old (+ offset (company--string-pixel-width new)))))) |
+ |
3921 |
|
+ |
3922 |
(defun company--show-numbers (numbered) |
+ |
3923 |
(format " %s" (if (<= numbered 10) |
+ |
3924 |
(mod numbered 10) |
+ |
3925 |
" "))) |
+ |
3926 |
(make-obsolete |
+ |
3927 |
'company--show-numbers |
+ |
3928 |
"use `company-quick-access-hint-key' instead, |
+ |
3929 |
but adjust the expected values appropriately." |
+ |
3930 |
"0.10.0") |
+ |
3931 |
|
+ |
3932 |
(defsubst company--window-height () |
+ |
3933 |
(if (fboundp 'window-screen-lines) |
+ |
3934 |
(floor (window-screen-lines)) |
+ |
3935 |
(window-body-height))) |
+ |
3936 |
|
+ |
3937 |
(defun company--window-width (&optional pixelwise) |
+ |
3938 |
(let ((ww (window-body-width nil pixelwise))) |
+ |
3939 |
;; Account for the line continuation column. |
+ |
3940 |
(when (zerop (cadr (window-fringes))) |
+ |
3941 |
(cl-decf ww (if pixelwise (company--string-pixel-width ">") 1))) |
+ |
3942 |
(when (bound-and-true-p display-line-numbers) |
+ |
3943 |
(cl-decf ww |
+ |
3944 |
(if pixelwise |
+ |
3945 |
(line-number-display-width t) |
+ |
3946 |
(+ 2 (line-number-display-width))))) |
+ |
3947 |
;; whitespace-mode with newline-mark |
+ |
3948 |
(when (and buffer-display-table |
+ |
3949 |
(aref buffer-display-table ?\n)) |
+ |
3950 |
(cl-decf ww |
+ |
3951 |
(if pixelwise |
+ |
3952 |
(company--string-pixel-width "\n") |
+ |
3953 |
(1- (length (aref buffer-display-table ?\n)))))) |
+ |
3954 |
ww)) |
+ |
3955 |
|
+ |
3956 |
(defun company--face-attribute (face attr) |
+ |
3957 |
;; Like `face-attribute', but accounts for faces that have been remapped to |
+ |
3958 |
;; another face, a list of faces, or a face spec. |
+ |
3959 |
(cond ((null face) nil) |
+ |
3960 |
((symbolp face) |
+ |
3961 |
(let ((remap (cdr (assq face face-remapping-alist)))) |
+ |
3962 |
(if remap |
+ |
3963 |
(company--face-attribute |
+ |
3964 |
;; Faces can be remapped to their unremapped selves, but that |
+ |
3965 |
;; would cause us infinite recursion. |
+ |
3966 |
(if (listp remap) (remq face remap) remap) |
+ |
3967 |
attr) |
+ |
3968 |
(face-attribute face attr nil t)))) |
+ |
3969 |
((keywordp (car-safe face)) |
+ |
3970 |
(or (plist-get face attr) |
+ |
3971 |
(company--face-attribute (plist-get face :inherit) attr))) |
+ |
3972 |
((listp face) |
+ |
3973 |
(cl-find-if #'stringp |
+ |
3974 |
(mapcar (lambda (f) (company--face-attribute f attr)) |
+ |
3975 |
face))))) |
+ |
3976 |
|
+ |
3977 |
(defun company--replacement-string (lines column-offset old column nl &optional align-top) |
+ |
3978 |
(cl-decf column column-offset) |
+ |
3979 |
|
+ |
3980 |
(when (< column 0) (setq column 0)) |
+ |
3981 |
|
+ |
3982 |
(when (and align-top company-tooltip-flip-when-above) |
+ |
3983 |
(setq lines (reverse lines))) |
+ |
3984 |
|
+ |
3985 |
(let* ((px-width (company--string-pixel-width (car lines))) |
+ |
3986 |
;; The (display (space :width (..))) spec is only applied to the |
+ |
3987 |
;; visible part of the buffer (past hscroll), so subtracting |
+ |
3988 |
;; window-scroll here is a good idea. But then we also need to slice |
+ |
3989 |
;; the "old" strings so the hidden contents don't get shown. |
+ |
3990 |
;; XXX: `auto-hscroll-mode' set to `current-line' is not supported. |
+ |
3991 |
(px-col (* (- column (window-hscroll)) (default-font-width))) |
+ |
3992 |
(remaining-px (- (company--window-width t) px-col)) |
+ |
3993 |
(hscroll-space (when (> (window-hscroll) 0) |
+ |
3994 |
(company-space-string (window-hscroll)))) |
+ |
3995 |
new) |
+ |
3996 |
(when (> px-width remaining-px) |
+ |
3997 |
(cl-decf px-col (- px-width remaining-px))) |
+ |
3998 |
(when hscroll-space |
+ |
3999 |
(setq old (mapcar (lambda (s) (company-safe-substring s (window-hscroll))) |
+ |
4000 |
old))) |
+ |
4001 |
(when align-top |
+ |
4002 |
;; untouched lines first |
+ |
4003 |
(dotimes (_ (- (length old) (length lines))) |
+ |
4004 |
(push (pop old) new))) |
+ |
4005 |
;; length into old lines. |
+ |
4006 |
(while old |
+ |
4007 |
(push (company-modify-line (pop old) (pop lines) px-col) |
+ |
4008 |
new)) |
+ |
4009 |
;; Append whole new lines. |
+ |
4010 |
(while lines |
+ |
4011 |
(push (concat (company-safe-pixel-substring "" 0 px-col) (pop lines)) |
+ |
4012 |
new)) |
+ |
4013 |
|
+ |
4014 |
;; XXX: Also see branch 'more-precise-extend'. |
+ |
4015 |
(let* ((nl-face `(,@(when (version<= "27" emacs-version) |
+ |
4016 |
'(:extend t)) |
+ |
4017 |
:inverse-video nil |
+ |
4018 |
:background ,(or (company--face-attribute 'default :background) |
+ |
4019 |
(face-attribute 'default :background nil t)))) |
+ |
4020 |
(str (apply #'concat |
+ |
4021 |
(when nl " \n") |
+ |
4022 |
(cl-mapcan |
+ |
4023 |
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=42552#23 |
+ |
4024 |
(lambda (line) (list hscroll-space line (propertize "\n" 'face nl-face))) |
+ |
4025 |
(nreverse new))))) |
+ |
4026 |
;; https://debbugs.gnu.org/38563 |
+ |
4027 |
(add-face-text-property 0 (length str) 'default t str) |
+ |
4028 |
(when nl (put-text-property 0 1 'cursor t str)) |
+ |
4029 |
str))) |
+ |
4030 |
|
+ |
4031 |
(defun company--create-lines (selection limit) |
+ |
4032 |
(let ((len company-candidates-length) |
+ |
4033 |
(window-width (company--window-width)) |
+ |
4034 |
(company-tooltip-annotation-padding |
+ |
4035 |
(or company-tooltip-annotation-padding |
+ |
4036 |
(if company-tooltip-align-annotations 1 0))) |
+ |
4037 |
left-margins |
+ |
4038 |
left-margin-size |
+ |
4039 |
right-margin |
+ |
4040 |
lines |
+ |
4041 |
width |
+ |
4042 |
lines-copy |
+ |
4043 |
items |
+ |
4044 |
previous |
+ |
4045 |
remainder |
+ |
4046 |
scrollbar-bounds) |
+ |
4047 |
|
+ |
4048 |
;; Maybe clear old offset. |
+ |
4049 |
(when (< len (+ company-tooltip-offset limit)) |
+ |
4050 |
(setq company-tooltip-offset 0)) |
+ |
4051 |
|
+ |
4052 |
(let ((selection (or selection 0))) |
+ |
4053 |
;; Scroll to offset. |
+ |
4054 |
(if (eq company-tooltip-offset-display 'lines) |
+ |
4055 |
(setq limit (company-tooltip--lines-update-offset selection len limit)) |
+ |
4056 |
(company-tooltip--simple-update-offset selection len limit)) |
+ |
4057 |
|
+ |
4058 |
(cond |
+ |
4059 |
((eq company-tooltip-offset-display 'scrollbar) |
+ |
4060 |
(setq scrollbar-bounds (company--scrollbar-bounds company-tooltip-offset |
+ |
4061 |
limit len))) |
+ |
4062 |
((eq company-tooltip-offset-display 'lines) |
+ |
4063 |
(when (> company-tooltip-offset 0) |
+ |
4064 |
(setq previous (format "...(%d)" company-tooltip-offset))) |
+ |
4065 |
(setq remainder (- len limit company-tooltip-offset) |
+ |
4066 |
remainder (when (> remainder 0) |
+ |
4067 |
(setq remainder (format "...(%d)" remainder))))))) |
+ |
4068 |
|
+ |
4069 |
(when selection |
+ |
4070 |
(cl-decf selection company-tooltip-offset)) |
+ |
4071 |
|
+ |
4072 |
(setq width (max (length previous) (length remainder)) |
+ |
4073 |
lines (nthcdr company-tooltip-offset company-candidates) |
+ |
4074 |
right-margin (company--right-margin limit len) |
+ |
4075 |
len (min limit len) |
+ |
4076 |
lines-copy lines) |
+ |
4077 |
|
+ |
4078 |
(when scrollbar-bounds (cl-decf window-width)) |
+ |
4079 |
|
+ |
4080 |
(when company-format-margin-function |
+ |
4081 |
(let ((lines-copy lines-copy) |
+ |
4082 |
res) |
+ |
4083 |
(dotimes (i len) |
+ |
4084 |
(push (funcall company-format-margin-function |
+ |
4085 |
(pop lines-copy) |
+ |
4086 |
(equal selection i)) |
+ |
4087 |
res)) |
+ |
4088 |
(setq left-margins (nreverse res)))) |
+ |
4089 |
|
+ |
4090 |
;; XXX: format-function outputting shorter strings than the |
+ |
4091 |
;; default margin is not supported (yet?). |
+ |
4092 |
(setq left-margin-size (apply #'max company-tooltip-margin |
+ |
4093 |
(mapcar #'length left-margins))) |
+ |
4094 |
|
+ |
4095 |
(cl-decf window-width company-tooltip-margin) |
+ |
4096 |
(cl-decf window-width left-margin-size) |
+ |
4097 |
|
+ |
4098 |
(dotimes (_ len) |
+ |
4099 |
(let* ((value (pop lines-copy)) |
+ |
4100 |
(annotation (company-call-backend 'annotation value)) |
+ |
4101 |
(left (or (pop left-margins) |
+ |
4102 |
(company-space-string left-margin-size)))) |
+ |
4103 |
(when annotation |
+ |
4104 |
(when company-tooltip-align-annotations |
+ |
4105 |
;; `lisp-completion-at-point' adds a space. |
+ |
4106 |
(setq annotation (string-trim-left annotation)))) |
+ |
4107 |
(push (list value annotation left) items) |
+ |
4108 |
(setq width (max (+ (company--string-width value) |
+ |
4109 |
(if annotation |
+ |
4110 |
(+ (company--string-width annotation) |
+ |
4111 |
company-tooltip-annotation-padding) |
+ |
4112 |
0)) |
+ |
4113 |
width)))) |
+ |
4114 |
|
+ |
4115 |
(setq width (min window-width |
+ |
4116 |
company-tooltip-maximum-width |
+ |
4117 |
(max company-tooltip-minimum-width |
+ |
4118 |
(if company-show-quick-access |
+ |
4119 |
(+ 2 width) |
+ |
4120 |
width)))) |
+ |
4121 |
|
+ |
4122 |
(when company-tooltip-width-grow-only |
+ |
4123 |
(setq width (max company--tooltip-current-width width)) |
+ |
4124 |
(setq company--tooltip-current-width width)) |
+ |
4125 |
|
+ |
4126 |
(let ((items (nreverse items)) |
+ |
4127 |
(row (if company-show-quick-access 0 99999)) |
+ |
4128 |
new) |
+ |
4129 |
(when previous |
+ |
4130 |
(push (company--scrollpos-line previous width left-margin-size) new)) |
+ |
4131 |
|
+ |
4132 |
(dotimes (i len) |
+ |
4133 |
(let* ((item (pop items)) |
+ |
4134 |
(str (car item)) |
+ |
4135 |
(annotation (cadr item)) |
+ |
4136 |
(left (nth 2 item)) |
+ |
4137 |
(right right-margin) |
+ |
4138 |
(width width) |
+ |
4139 |
(selected (equal selection i))) |
+ |
4140 |
(when company-show-quick-access |
+ |
4141 |
(let ((quick-access (gv-ref (if (eq company-show-quick-access 'left) |
+ |
4142 |
left right))) |
+ |
4143 |
(qa-hint (company-tooltip--format-quick-access-hint |
+ |
4144 |
row selected))) |
+ |
4145 |
(cl-decf width (company--string-width qa-hint)) |
+ |
4146 |
(setf (gv-deref quick-access) |
+ |
4147 |
(concat qa-hint (gv-deref quick-access)))) |
+ |
4148 |
(cl-incf row)) |
+ |
4149 |
(push (concat |
+ |
4150 |
(company-fill-propertize str annotation |
+ |
4151 |
width selected |
+ |
4152 |
left |
+ |
4153 |
right) |
+ |
4154 |
(when scrollbar-bounds |
+ |
4155 |
(company--scrollbar i scrollbar-bounds))) |
+ |
4156 |
new))) |
+ |
4157 |
|
+ |
4158 |
(when remainder |
+ |
4159 |
(push (company--scrollpos-line remainder width left-margin-size) new)) |
+ |
4160 |
|
+ |
4161 |
(cons |
+ |
4162 |
left-margin-size |
+ |
4163 |
(nreverse new))))) |
+ |
4164 |
|
+ |
4165 |
(defun company--scrollbar-bounds (offset limit length) |
+ |
4166 |
(when (> length limit) |
+ |
4167 |
(let* ((size (ceiling (* limit (float limit)) length)) |
+ |
4168 |
(lower (floor (* limit (float offset)) length)) |
+ |
4169 |
(upper (+ lower size -1))) |
+ |
4170 |
(cons lower upper)))) |
+ |
4171 |
|
+ |
4172 |
(defun company--scrollbar (i bounds) |
+ |
4173 |
(let* ((scroll-width (ceiling (* (default-font-width) |
+ |
4174 |
company-tooltip-scrollbar-width)))) |
+ |
4175 |
(propertize " " |
+ |
4176 |
'display `(space . (:width (,scroll-width))) |
+ |
4177 |
'face |
+ |
4178 |
(if (and (>= i (car bounds)) (<= i (cdr bounds))) |
+ |
4179 |
'company-tooltip-scrollbar-thumb |
+ |
4180 |
'company-tooltip-scrollbar-track)))) |
+ |
4181 |
|
+ |
4182 |
(defun company--right-margin (limit length) |
+ |
4183 |
(if (or (not (eq company-tooltip-offset-display 'scrollbar)) |
+ |
4184 |
(not (display-graphic-p)) |
+ |
4185 |
(= company-tooltip-scrollbar-width 1) |
+ |
4186 |
(<= length limit)) |
+ |
4187 |
(company-space-string company-tooltip-margin) |
+ |
4188 |
(let* ((scroll-width (ceiling (* (default-font-width) |
+ |
4189 |
company-tooltip-scrollbar-width))) |
+ |
4190 |
(rest-width (- (* (default-font-width) company-tooltip-margin) |
+ |
4191 |
scroll-width))) |
+ |
4192 |
(propertize |
+ |
4193 |
(company-space-string company-tooltip-margin) |
+ |
4194 |
'display `(space . (:width (,rest-width))))))) |
+ |
4195 |
|
+ |
4196 |
(defun company--scrollpos-line (text width fancy-margin-width) |
+ |
4197 |
(propertize (concat (company-space-string company-tooltip-margin) |
+ |
4198 |
(company-safe-substring text 0 width) |
+ |
4199 |
(company-space-string fancy-margin-width)) |
+ |
4200 |
'face 'company-tooltip)) |
+ |
4201 |
|
+ |
4202 |
(defun company-tooltip--format-quick-access-hint (row selected) |
+ |
4203 |
"Format a quick-access hint for outputting on a tooltip's ROW. |
+ |
4204 |
Value of SELECTED determines the added face." |
+ |
4205 |
(propertize (format "%2s" (funcall company-quick-access-hint-function row)) |
+ |
4206 |
'face |
+ |
4207 |
(if selected |
+ |
4208 |
'company-tooltip-quick-access-selection |
+ |
4209 |
'company-tooltip-quick-access))) |
+ |
4210 |
|
+ |
4211 |
;; show |
+ |
4212 |
|
+ |
4213 |
(defvar-local company-pseudo-tooltip-overlay nil) |
+ |
4214 |
|
+ |
4215 |
(defun company--inside-tooltip-p (event-col-row row height) |
+ |
4216 |
(let* ((ovl company-pseudo-tooltip-overlay) |
+ |
4217 |
(column (overlay-get ovl 'company-column)) |
+ |
4218 |
(width (overlay-get ovl 'company-width)) |
+ |
4219 |
(evt-col (car event-col-row)) |
+ |
4220 |
(evt-row (cdr event-col-row))) |
+ |
4221 |
(and (>= evt-col column) |
+ |
4222 |
(< evt-col (+ column width)) |
+ |
4223 |
(if (> height 0) |
+ |
4224 |
(and (> evt-row row) |
+ |
4225 |
(<= evt-row (+ row height) )) |
+ |
4226 |
(and (< evt-row row) |
+ |
4227 |
(>= evt-row (+ row height))))))) |
+ |
4228 |
|
+ |
4229 |
(defun company--pseudo-tooltip-height () |
+ |
4230 |
"Calculate the appropriate tooltip height. |
+ |
4231 |
Returns a negative number if the tooltip should be displayed above point." |
+ |
4232 |
(let* ((lines (company--row)) |
+ |
4233 |
(below (- (company--window-height) 1 lines))) |
+ |
4234 |
(if (and (< below (min company-tooltip-minimum company-candidates-length)) |
+ |
4235 |
(> lines below)) |
+ |
4236 |
(- (max 3 (min company-tooltip-limit lines))) |
+ |
4237 |
(max 3 (min company-tooltip-limit below))))) |
+ |
4238 |
|
+ |
4239 |
(defun company-pseudo-tooltip-show (row column selection) |
+ |
4240 |
(company-pseudo-tooltip-hide) |
+ |
4241 |
|
+ |
4242 |
(let* ((height (company--pseudo-tooltip-height)) |
+ |
4243 |
above) |
+ |
4244 |
|
+ |
4245 |
(when (< height 0) |
+ |
4246 |
(setq row (+ row height -1) |
+ |
4247 |
above t)) |
+ |
4248 |
|
+ |
4249 |
;; This can happen in Emacs versions which allow arbitrary scrolling, |
+ |
4250 |
;; such as Yamamoto's Mac Port. |
+ |
4251 |
(unless (pos-visible-in-window-p (window-start)) |
+ |
4252 |
(cl-decf row)) |
+ |
4253 |
|
+ |
4254 |
(let (nl beg end ov args) |
+ |
4255 |
(save-excursion |
+ |
4256 |
(setq nl (< (move-to-window-line row) row)) |
+ |
4257 |
;; HACK: Very specific to the log-edit buffer. Could alternatively |
+ |
4258 |
;; look up the `display-line-numbers-disable' property, but with |
+ |
4259 |
;; larger consequences. |
+ |
4260 |
(when (and (not nl) (> height 0)) |
+ |
4261 |
(while (eq (get-char-property (point) 'face) |
+ |
4262 |
'log-edit-headers-separator) |
+ |
4263 |
(vertical-motion 1))) |
+ |
4264 |
(setq beg (point) |
+ |
4265 |
end (save-excursion |
+ |
4266 |
(vertical-motion (abs height)) |
+ |
4267 |
(point)) |
+ |
4268 |
ov (make-overlay beg end nil t) |
+ |
4269 |
args (list (mapcar 'company-plainify |
+ |
4270 |
(company-buffer-lines beg end)) |
+ |
4271 |
column nl above))) |
+ |
4272 |
|
+ |
4273 |
(setq company-pseudo-tooltip-overlay ov) |
+ |
4274 |
(overlay-put ov 'company-replacement-args args) |
+ |
4275 |
|
+ |
4276 |
(let* ((lines-and-offset (company--create-lines selection (abs height))) |
+ |
4277 |
(lines (cdr lines-and-offset)) |
+ |
4278 |
(column-offset (car lines-and-offset))) |
+ |
4279 |
(overlay-put ov 'company-display |
+ |
4280 |
(apply 'company--replacement-string |
+ |
4281 |
lines column-offset args)) |
+ |
4282 |
(overlay-put ov 'company-width (company--string-width (car lines)))) |
+ |
4283 |
|
+ |
4284 |
(overlay-put ov 'company-column column) |
+ |
4285 |
(overlay-put ov 'company-height height)))) |
+ |
4286 |
|
+ |
4287 |
(defun company-pseudo-tooltip-show-at-point (pos column-offset) |
+ |
4288 |
(let* ((col-row (company--col-row pos)) |
+ |
4289 |
(col (- (car col-row) column-offset))) |
+ |
4290 |
(when (< col 0) (setq col 0)) |
+ |
4291 |
(company--with-face-remappings |
+ |
4292 |
(company-pseudo-tooltip-show (1+ (cdr col-row)) col company-selection)))) |
+ |
4293 |
|
+ |
4294 |
(defun company-pseudo-tooltip-edit (selection) |
+ |
4295 |
(let* ((height (overlay-get company-pseudo-tooltip-overlay 'company-height)) |
+ |
4296 |
(lines-and-offset (company--create-lines selection (abs height))) |
+ |
4297 |
(lines (cdr lines-and-offset)) |
+ |
4298 |
(column-offset (car lines-and-offset))) |
+ |
4299 |
(overlay-put company-pseudo-tooltip-overlay 'company-width |
+ |
4300 |
(company--string-width (car lines))) |
+ |
4301 |
(overlay-put company-pseudo-tooltip-overlay 'company-display |
+ |
4302 |
(apply 'company--replacement-string |
+ |
4303 |
lines column-offset |
+ |
4304 |
(overlay-get company-pseudo-tooltip-overlay |
+ |
4305 |
'company-replacement-args))))) |
+ |
4306 |
|
+ |
4307 |
(defun company-pseudo-tooltip-hide () |
+ |
4308 |
(when company-pseudo-tooltip-overlay |
+ |
4309 |
(delete-overlay company-pseudo-tooltip-overlay) |
+ |
4310 |
(setq company-pseudo-tooltip-overlay nil))) |
+ |
4311 |
|
+ |
4312 |
(defun company-pseudo-tooltip-hide-temporarily () |
+ |
4313 |
(when (overlayp company-pseudo-tooltip-overlay) |
+ |
4314 |
(overlay-put company-pseudo-tooltip-overlay 'invisible nil) |
+ |
4315 |
(overlay-put company-pseudo-tooltip-overlay 'line-prefix nil) |
+ |
4316 |
(overlay-put company-pseudo-tooltip-overlay 'before-string nil) |
+ |
4317 |
(overlay-put company-pseudo-tooltip-overlay 'display nil) |
+ |
4318 |
(overlay-put company-pseudo-tooltip-overlay 'face nil))) |
+ |
4319 |
|
+ |
4320 |
(defun company-pseudo-tooltip-unhide () |
+ |
4321 |
(when company-pseudo-tooltip-overlay |
+ |
4322 |
(let* ((ov company-pseudo-tooltip-overlay) |
+ |
4323 |
(disp (overlay-get ov 'company-display))) |
+ |
4324 |
;; Beat outline's folding overlays. |
+ |
4325 |
;; And Flymake (53). And Flycheck (110). |
+ |
4326 |
(overlay-put ov 'priority 111) |
+ |
4327 |
;; visual-line-mode |
+ |
4328 |
(when (and (memq (char-before (overlay-start ov)) '(?\s ?\t)) |
+ |
4329 |
;; not eob |
+ |
4330 |
(not (nth 2 (overlay-get ov 'company-replacement-args)))) |
+ |
4331 |
(setq disp (concat "\n" disp))) |
+ |
4332 |
;; No (extra) prefix for the first line. |
+ |
4333 |
(overlay-put ov 'line-prefix "") |
+ |
4334 |
(overlay-put ov 'before-string disp) |
+ |
4335 |
;; `display' is better than `invisible': |
+ |
4336 |
;; https://debbugs.gnu.org/18285 |
+ |
4337 |
;; https://debbugs.gnu.org/20847 |
+ |
4338 |
;; https://debbugs.gnu.org/42521 |
+ |
4339 |
(overlay-put ov 'display "") |
+ |
4340 |
(overlay-put ov 'window (selected-window))))) |
+ |
4341 |
|
+ |
4342 |
(defun company-pseudo-tooltip-guard (prefix) |
+ |
4343 |
(list |
+ |
4344 |
(- (point) (length prefix)) |
+ |
4345 |
(save-excursion (beginning-of-visual-line)) |
+ |
4346 |
(window-width) |
+ |
4347 |
(let ((ov company-pseudo-tooltip-overlay) |
+ |
4348 |
(overhang (save-excursion (end-of-visual-line) |
+ |
4349 |
(- (line-end-position) (point))))) |
+ |
4350 |
(when (>= (overlay-get ov 'company-height) 0) |
+ |
4351 |
(cons |
+ |
4352 |
(buffer-substring-no-properties (point) (overlay-start ov)) |
+ |
4353 |
(when (>= overhang 0) overhang)))))) |
+ |
4354 |
|
+ |
4355 |
(defun company-pseudo-tooltip-frontend (command) |
+ |
4356 |
"`company-mode' frontend similar to a tooltip but based on overlays." |
+ |
4357 |
(cl-case command |
+ |
4358 |
(pre-command (company-pseudo-tooltip-hide-temporarily)) |
+ |
4359 |
(unhide |
+ |
4360 |
(let ((ov company-pseudo-tooltip-overlay)) |
+ |
4361 |
(when (and ov (> (overlay-get ov 'company-height) 0)) |
+ |
4362 |
;; Sleight of hand: if the current line wraps, we adjust the |
+ |
4363 |
;; start of the overlay so that the popup does not zig-zag, |
+ |
4364 |
;; but don't update the popup's background. This seems just |
+ |
4365 |
;; non-annoying enough to avoid the work required for the latter. |
+ |
4366 |
(save-excursion |
+ |
4367 |
(vertical-motion 1) |
+ |
4368 |
(unless (= (point) (overlay-start ov)) |
+ |
4369 |
(move-overlay ov (point) (overlay-end ov)))))) |
+ |
4370 |
(company-pseudo-tooltip-unhide)) |
+ |
4371 |
(post-command |
+ |
4372 |
(let ((prefix (car (company--boundaries))) |
+ |
4373 |
guard) |
+ |
4374 |
(unless (when (overlayp company-pseudo-tooltip-overlay) |
+ |
4375 |
(let* ((ov company-pseudo-tooltip-overlay) |
+ |
4376 |
(old-height (overlay-get ov 'company-height)) |
+ |
4377 |
(new-height (company--pseudo-tooltip-height))) |
+ |
4378 |
(and |
+ |
4379 |
(>= (* old-height new-height) 0) |
+ |
4380 |
(>= (abs old-height) (abs new-height)) |
+ |
4381 |
(equal (setq guard (company-pseudo-tooltip-guard prefix)) |
+ |
4382 |
(overlay-get ov 'company-guard))))) |
+ |
4383 |
;; Redraw needed. |
+ |
4384 |
(company-pseudo-tooltip-show-at-point (point) |
+ |
4385 |
(length prefix)) |
+ |
4386 |
(overlay-put company-pseudo-tooltip-overlay |
+ |
4387 |
'company-guard (or guard |
+ |
4388 |
(company-pseudo-tooltip-guard prefix))))) |
+ |
4389 |
(company-pseudo-tooltip-unhide)) |
+ |
4390 |
(show (setq company--tooltip-current-width 0)) |
+ |
4391 |
(hide (company-pseudo-tooltip-hide) |
+ |
4392 |
(setq company-tooltip-offset 0)) |
+ |
4393 |
(update (when (overlayp company-pseudo-tooltip-overlay) |
+ |
4394 |
(company--with-face-remappings |
+ |
4395 |
(company-pseudo-tooltip-edit company-selection)))) |
+ |
4396 |
(select-mouse |
+ |
4397 |
(let ((event-col-row (company--event-col-row company-mouse-event)) |
+ |
4398 |
(ovl-row (company--row)) |
+ |
4399 |
(ovl-height (and company-pseudo-tooltip-overlay |
+ |
4400 |
(min (overlay-get company-pseudo-tooltip-overlay |
+ |
4401 |
'company-height) |
+ |
4402 |
company-candidates-length)))) |
+ |
4403 |
(cond ((and ovl-height |
+ |
4404 |
(company--inside-tooltip-p event-col-row ovl-row ovl-height)) |
+ |
4405 |
(company-set-selection (+ (cdr event-col-row) |
+ |
4406 |
(1- company-tooltip-offset) |
+ |
4407 |
(if (and (eq company-tooltip-offset-display 'lines) |
+ |
4408 |
(not (zerop company-tooltip-offset))) |
+ |
4409 |
-1 0) |
+ |
4410 |
(- ovl-row) |
+ |
4411 |
(if (< ovl-height 0) |
+ |
4412 |
(- 1 ovl-height) |
+ |
4413 |
0))) |
+ |
4414 |
t)))))) |
+ |
4415 |
|
+ |
4416 |
(defun company-pseudo-tooltip-unless-just-one-frontend (command) |
+ |
4417 |
"`company-pseudo-tooltip-frontend', but not shown for single candidates." |
+ |
4418 |
(unless (and (memq command '(post-command unhide)) |
+ |
4419 |
(company--show-inline-p)) |
+ |
4420 |
(company-pseudo-tooltip-frontend command))) |
+ |
4421 |
|
+ |
4422 |
(defun company-pseudo-tooltip--ujofwd-on-timer (command) |
+ |
4423 |
(when company-candidates |
+ |
4424 |
(company-pseudo-tooltip-unless-just-one-frontend-with-delay command))) |
+ |
4425 |
|
+ |
4426 |
(defun company-pseudo-tooltip-unless-just-one-frontend-with-delay (command) |
+ |
4427 |
"`compandy-pseudo-tooltip-frontend', but shown after a delay. |
+ |
4428 |
Delay is determined by `company-tooltip-idle-delay'." |
+ |
4429 |
(defvar company-preview-overlay) |
+ |
4430 |
(when (and (memq command '(pre-command hide)) |
+ |
4431 |
company-tooltip-timer) |
+ |
4432 |
(cancel-timer company-tooltip-timer) |
+ |
4433 |
(setq company-tooltip-timer nil)) |
+ |
4434 |
(cl-case command |
+ |
4435 |
(post-command |
+ |
4436 |
(if (or company-tooltip-timer |
+ |
4437 |
(overlayp company-pseudo-tooltip-overlay)) |
+ |
4438 |
(if (not (overlayp company-preview-overlay)) |
+ |
4439 |
(company-pseudo-tooltip-unless-just-one-frontend command) |
+ |
4440 |
(let (company-tooltip-timer) |
+ |
4441 |
(company-call-frontends 'pre-command)) |
+ |
4442 |
(company-call-frontends 'post-command)) |
+ |
4443 |
(setq company-tooltip-timer |
+ |
4444 |
(run-with-timer company-tooltip-idle-delay nil |
+ |
4445 |
'company-pseudo-tooltip--ujofwd-on-timer |
+ |
4446 |
'post-command)))) |
+ |
4447 |
(unhide |
+ |
4448 |
(when (overlayp company-pseudo-tooltip-overlay) |
+ |
4449 |
(company-pseudo-tooltip-unless-just-one-frontend command))) |
+ |
4450 |
(t |
+ |
4451 |
(company-pseudo-tooltip-unless-just-one-frontend command)))) |
+ |
4452 |
|
+ |
4453 |
;;; overlay ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
+ |
4454 |
|
+ |
4455 |
(defvar-local company-preview-overlay nil) |
+ |
4456 |
|
+ |
4457 |
(defun company-preview-show-at-point (pos completion &optional boundaries) |
+ |
4458 |
(company-preview-hide) |
+ |
4459 |
|
+ |
4460 |
(let* ((boundaries (or boundaries (company--boundaries completion))) |
+ |
4461 |
(prefix (car boundaries)) |
+ |
4462 |
(suffix (cdr boundaries)) |
+ |
4463 |
(company-common (and company-common |
+ |
4464 |
(string-prefix-p prefix company-common) |
+ |
4465 |
company-common)) |
+ |
4466 |
(common (company--common-or-matches completion suffix))) |
+ |
4467 |
(setq completion (copy-sequence (company--pre-render completion))) |
+ |
4468 |
(add-face-text-property 0 (length completion) 'company-preview |
+ |
4469 |
nil completion) |
+ |
4470 |
|
+ |
4471 |
(cl-loop for (beg . end) in common |
+ |
4472 |
do (add-face-text-property beg end 'company-preview-common |
+ |
4473 |
nil completion)) |
+ |
4474 |
|
+ |
4475 |
;; Add search string |
+ |
4476 |
(and (string-match (funcall company-search-regexp-function |
+ |
4477 |
company-search-string) |
+ |
4478 |
completion) |
+ |
4479 |
(pcase-dolist (`(,mbeg . ,mend) (company--search-chunks)) |
+ |
4480 |
(add-face-text-property mbeg mend 'company-preview-search |
+ |
4481 |
nil completion))) |
+ |
4482 |
|
+ |
4483 |
(setq completion (if (string-prefix-p prefix completion |
+ |
4484 |
(eq (company-call-backend 'ignore-case) |
+ |
4485 |
'keep-prefix)) |
+ |
4486 |
(company-strip-prefix completion prefix) |
+ |
4487 |
completion)) |
+ |
4488 |
|
+ |
4489 |
(when (string-prefix-p "\n" completion) |
+ |
4490 |
(setq completion (concat (propertize " " 'face 'company-preview) "\n" |
+ |
4491 |
(substring completion 1)))) |
+ |
4492 |
|
+ |
4493 |
(and (equal pos (point)) |
+ |
4494 |
(not (string-empty-p completion)) |
+ |
4495 |
(add-text-properties 0 1 '(cursor 1) completion)) |
+ |
4496 |
|
+ |
4497 |
(let* ((beg pos) |
+ |
4498 |
(pto company-pseudo-tooltip-overlay) |
+ |
4499 |
(ptf-workaround (and |
+ |
4500 |
pto |
+ |
4501 |
(char-before pos) |
+ |
4502 |
(eq pos (overlay-start pto)))) |
+ |
4503 |
(end pos)) |
+ |
4504 |
;; Try to accommodate for the pseudo-tooltip overlay, |
+ |
4505 |
;; which may start at the same position if it's at eol. |
+ |
4506 |
(when ptf-workaround |
+ |
4507 |
(cl-decf beg) |
+ |
4508 |
(setq completion (concat (buffer-substring beg pos) completion))) |
+ |
4509 |
|
+ |
4510 |
(when (string-suffix-p suffix completion) |
+ |
4511 |
(cl-incf end (length suffix))) |
+ |
4512 |
|
+ |
4513 |
(setq company-preview-overlay (make-overlay beg end)) |
+ |
4514 |
|
+ |
4515 |
(let ((ov company-preview-overlay)) |
+ |
4516 |
(overlay-put ov (if (> end beg) 'display 'after-string) |
+ |
4517 |
completion) |
+ |
4518 |
(overlay-put ov 'window (selected-window)))))) |
+ |
4519 |
|
+ |
4520 |
(defun company-preview-hide () |
+ |
4521 |
(when company-preview-overlay |
+ |
4522 |
(delete-overlay company-preview-overlay) |
+ |
4523 |
(setq company-preview-overlay nil))) |
+ |
4524 |
|
+ |
4525 |
(defun company-preview-frontend (command) |
+ |
4526 |
"`company-mode' frontend showing the selection as if it had been inserted." |
+ |
4527 |
(pcase command |
+ |
4528 |
(`pre-command (company-preview-hide)) |
+ |
4529 |
(`unhide |
+ |
4530 |
(when company-selection |
+ |
4531 |
(let* ((current (nth company-selection company-candidates))) |
+ |
4532 |
(company-preview-show-at-point (point) current)))) |
+ |
4533 |
(`post-command |
+ |
4534 |
(when company-selection |
+ |
4535 |
(company-preview-show-at-point (point) |
+ |
4536 |
(nth company-selection company-candidates)))) |
+ |
4537 |
(`hide (company-preview-hide)))) |
+ |
4538 |
|
+ |
4539 |
(defun company-preview-if-just-one-frontend (command) |
+ |
4540 |
"`company-preview-frontend', but only shown for single candidates." |
+ |
4541 |
(when (or (not (memq command '(post-command unhide))) |
+ |
4542 |
(company--show-inline-p)) |
+ |
4543 |
(company-preview-frontend command))) |
+ |
4544 |
|
+ |
4545 |
(defun company--show-inline-p () |
+ |
4546 |
(let* ((boundaries (and company-candidates (company--boundaries))) |
+ |
4547 |
(prefix (car boundaries)) |
+ |
4548 |
(suffix (cdr boundaries)) |
+ |
4549 |
(ignore-case (company-call-backend 'ignore-case)) |
+ |
4550 |
(candidate (car company-candidates))) |
+ |
4551 |
(and (not (cdr company-candidates)) |
+ |
4552 |
company-common |
+ |
4553 |
(not (eq t (compare-strings prefix nil nil |
+ |
4554 |
candidate nil nil |
+ |
4555 |
t))) |
+ |
4556 |
(string-suffix-p suffix candidate ignore-case) |
+ |
4557 |
(or (eq ignore-case 'keep-prefix) |
+ |
4558 |
(string-prefix-p prefix company-common))))) |
+ |
4559 |
|
+ |
4560 |
(defun company-tooltip-visible-p () |
+ |
4561 |
"Returns whether the tooltip is visible." |
+ |
4562 |
(when (overlayp company-pseudo-tooltip-overlay) |
+ |
4563 |
(not (overlay-get company-pseudo-tooltip-overlay 'invisible)))) |
+ |
4564 |
|
+ |
4565 |
(defun company-preview-common--show-p () |
+ |
4566 |
"Returns whether the preview of common can be showed or not" |
+ |
4567 |
(and company-common |
+ |
4568 |
(or (eq (company-call-backend 'ignore-case) 'keep-prefix) |
+ |
4569 |
(string-prefix-p company-prefix company-common)))) |
+ |
4570 |
|
+ |
4571 |
(defun company-preview-common-frontend (command) |
+ |
4572 |
"`company-mode' frontend preview the common part of candidates." |
+ |
4573 |
(when (or (not (memq command '(post-command unhide))) |
+ |
4574 |
(company-preview-common--show-p)) |
+ |
4575 |
(pcase command |
+ |
4576 |
(`pre-command (company-preview-hide)) |
+ |
4577 |
((or 'post-command 'unhide) |
+ |
4578 |
(company-preview-show-at-point (point) company-common)) |
+ |
4579 |
(`hide (company-preview-hide))))) |
+ |
4580 |
|
+ |
4581 |
;;; echo ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
+ |
4582 |
|
+ |
4583 |
(defvar-local company-echo-last-msg nil) |
+ |
4584 |
|
+ |
4585 |
(defvar company-echo-timer nil) |
+ |
4586 |
|
+ |
4587 |
(defvar company-echo-delay .01) |
+ |
4588 |
|
+ |
4589 |
(defcustom company-echo-truncate-lines t |
+ |
4590 |
"Whether frontend messages written to the echo area should be truncated." |
+ |
4591 |
:type 'boolean |
+ |
4592 |
:package-version '(company . "0.9.3")) |
+ |
4593 |
|
+ |
4594 |
(defun company-echo-show (&optional getter) |
+ |
4595 |
(let ((last-msg company-echo-last-msg) |
+ |
4596 |
(message-log-max nil) |
+ |
4597 |
(message-truncate-lines company-echo-truncate-lines)) |
+ |
4598 |
(when getter |
+ |
4599 |
(setq company-echo-last-msg (funcall getter))) |
+ |
4600 |
;; Avoid modifying the echo area if we don't have anything to say, and we |
+ |
4601 |
;; didn't put the previous message there (thus there's nothing to clear), |
+ |
4602 |
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=62816#20 |
+ |
4603 |
(if (not (member company-echo-last-msg '(nil ""))) |
+ |
4604 |
(message "%s" company-echo-last-msg) |
+ |
4605 |
(unless (member last-msg '(nil "")) |
+ |
4606 |
(message ""))))) |
+ |
4607 |
|
+ |
4608 |
(defun company-echo-show-soon (&optional getter delay) |
+ |
4609 |
(company-echo-cancel) |
+ |
4610 |
(setq company-echo-timer (run-with-timer (or delay company-echo-delay) |
+ |
4611 |
nil |
+ |
4612 |
'company-echo-show getter))) |
+ |
4613 |
|
+ |
4614 |
(defun company-echo-cancel (&optional unset) |
+ |
4615 |
(when company-echo-timer |
+ |
4616 |
(cancel-timer company-echo-timer)) |
+ |
4617 |
(when unset |
+ |
4618 |
(setq company-echo-timer nil))) |
+ |
4619 |
|
+ |
4620 |
(defun company-echo-format () |
+ |
4621 |
(let ((selection (or company-selection 0))) |
+ |
4622 |
(let ((limit (window-body-width (minibuffer-window))) |
+ |
4623 |
(len -1) |
+ |
4624 |
(candidates (nthcdr selection company-candidates)) |
+ |
4625 |
(numbered (if company-show-quick-access selection 99999)) |
+ |
4626 |
(qa-keys-len (length company-quick-access-keys)) |
+ |
4627 |
comp msg) |
+ |
4628 |
|
+ |
4629 |
(while candidates |
+ |
4630 |
(setq comp (propertize |
+ |
4631 |
(company-reformat (company--clean-string (pop candidates))) |
+ |
4632 |
'face |
+ |
4633 |
'company-echo) |
+ |
4634 |
len (+ len 1 (length comp))) |
+ |
4635 |
(let ((beg 0) |
+ |
4636 |
(end (company--string-width (or company-common "")))) |
+ |
4637 |
(when (< numbered qa-keys-len) |
+ |
4638 |
(let ((qa-hint |
+ |
4639 |
(format "%s: " (funcall |
+ |
4640 |
company-quick-access-hint-function |
+ |
4641 |
numbered)))) |
+ |
4642 |
(setq beg (company--string-width qa-hint) |
+ |
4643 |
end (+ beg end)) |
+ |
4644 |
(cl-incf len beg) |
+ |
4645 |
(setq comp (propertize (concat qa-hint comp) 'face 'company-echo))) |
+ |
4646 |
(cl-incf numbered)) |
+ |
4647 |
;; FIXME: Add support for the `match' backend action, and thus, |
+ |
4648 |
;; non-prefix matches. |
+ |
4649 |
(add-text-properties beg end '(face company-echo-common) comp)) |
+ |
4650 |
(if (>= len limit) |
+ |
4651 |
(setq candidates nil) |
+ |
4652 |
(push comp msg))) |
+ |
4653 |
|
+ |
4654 |
(mapconcat 'identity (nreverse msg) " ")))) |
+ |
4655 |
|
+ |
4656 |
(defun company-echo-strip-common-format () |
+ |
4657 |
(let ((selection (or company-selection 0))) |
+ |
4658 |
(let ((limit (window-body-width (minibuffer-window))) |
+ |
4659 |
(len (+ (length company-prefix) 2)) |
+ |
4660 |
(candidates (nthcdr selection company-candidates)) |
+ |
4661 |
(numbered (if company-show-quick-access selection 99999)) |
+ |
4662 |
(qa-keys-len (length company-quick-access-keys)) |
+ |
4663 |
comp msg) |
+ |
4664 |
|
+ |
4665 |
(while candidates |
+ |
4666 |
(setq comp (company-strip-prefix (pop candidates) company-prefix) |
+ |
4667 |
len (+ len 2 (length comp))) |
+ |
4668 |
(when (< numbered qa-keys-len) |
+ |
4669 |
(let ((qa-hint (format " (%s)" |
+ |
4670 |
(funcall company-quick-access-hint-function |
+ |
4671 |
numbered)))) |
+ |
4672 |
(setq comp (concat comp qa-hint)) |
+ |
4673 |
(cl-incf len (company--string-width qa-hint))) |
+ |
4674 |
(cl-incf numbered)) |
+ |
4675 |
(if (>= len limit) |
+ |
4676 |
(setq candidates nil) |
+ |
4677 |
(push (propertize comp 'face 'company-echo) msg))) |
+ |
4678 |
|
+ |
4679 |
(concat (propertize company-prefix 'face 'company-echo-common) "{" |
+ |
4680 |
(mapconcat 'identity (nreverse msg) ", ") |
+ |
4681 |
"}")))) |
+ |
4682 |
|
+ |
4683 |
(defun company-echo-hide () |
+ |
4684 |
(unless (string-empty-p company-echo-last-msg) |
+ |
4685 |
(setq company-echo-last-msg "") |
+ |
4686 |
(company-echo-show))) |
+ |
4687 |
|
+ |
4688 |
(defun company-echo-frontend (command) |
+ |
4689 |
"`company-mode' frontend showing the candidates in the echo area." |
+ |
4690 |
(pcase command |
+ |
4691 |
(`post-command (company-echo-show-soon 'company-echo-format 0)) |
+ |
4692 |
(`hide (company-echo-hide)))) |
+ |
4693 |
|
+ |
4694 |
(defun company-echo-strip-common-frontend (command) |
+ |
4695 |
"`company-mode' frontend showing the candidates in the echo area." |
+ |
4696 |
(pcase command |
+ |
4697 |
(`post-command (company-echo-show-soon 'company-echo-strip-common-format 0)) |
+ |
4698 |
(`hide (company-echo-hide)))) |
+ |
4699 |
|
+ |
4700 |
(defun company-echo-metadata-frontend (command) |
+ |
4701 |
"`company-mode' frontend showing the documentation in the echo area." |
+ |
4702 |
(pcase command |
+ |
4703 |
(`post-command (company-echo-show-soon 'company-fetch-metadata)) |
+ |
4704 |
(`unhide (company-echo-show)) |
+ |
4705 |
(`hide (company-echo-hide)))) |
+ |
4706 |
|
+ |
4707 |
(provide 'company) |
+ |
4708 |
;;; company.el ends here |
+ |
4709 |
init.el ¶
7 additions and 1 deletion.
View changes Hide changes
1 |
1 |
;; Copyright © 2018-2022 Maarten Vangeneugden |
2 |
2 |
;; Author: Maarten Vangeneugden <contact_me@maartenv.be> |
3 |
3 |
;; URL: https://maartenv.be |
4 |
4 |
;; |
5 |
5 |
;; Welcome to Ghent Emacs. |
6 |
6 |
;; |
7 |
7 |
;; This is the configuration file for Ghent Emacs, a GNU Emacs derivative |
8 |
8 |
;; developed in the city of Ghent, Belgium, by a student of Engineering |
9 |
9 |
;; Informatics at Ghent University. |
10 |
10 |
;; |
11 |
11 |
;; License: GPLv3+ |
12 |
12 |
|
13 |
13 |
;; USAGE: |
14 |
14 |
;; This configuration file uses the use-package declaration, that means the |
15 |
15 |
;; settings are a bit different from what you'd normally do in a GNU Emacs |
16 |
16 |
;; init.el file. Consult https://github.com/jwiegley/use-package for info on how |
17 |
17 |
;; to correctly write package configuration. |
18 |
18 |
|
19 |
19 |
;; DEBUGGING NOTE FOR COMPANY-FUZZY: |
20 |
20 |
;; Do you get shit like "wrong number of arguments" that completely freezes up |
21 |
21 |
;; the autocompleter? Fix it by removing the company-fuzzy.elc file from the |
22 |
22 |
;; .emacs elpa layers directory, and replacing company-fuzzy.el with the |
23 |
23 |
;; company-fuzzy.el file in the rc repository. Just adding this fixes a bug that |
24 |
24 |
;; apparently nobody else on the internet has or has managed to figure out a fix for. |
25 |
25 |
|
26 |
- | |
+ |
26 |
;; In the same fashion as the previous debugging note: If you get the error |
+ |
27 |
;; 'company: backend company-fuzzy-all-other-backends error |
+ |
28 |
;; "wrong type argument: stringp, 0" with args (set-min-prefix 0)', |
+ |
29 |
;; then fix it by removing the company.el file from the .emacs/elpa/company directory |
+ |
30 |
;; and replacing company.el with the one from the rc repository. Fixes bug that |
+ |
31 |
;; (again) only I seem to have or seem to have figured out how to fix. |
+ |
32 |
|
27 |
33 |
(eval-when-compile |
28 |
34 |
(require 'use-package)) |
29 |
35 |
;(require 'diminish) ;; if you use :diminish |
30 |
36 |
(require 'bind-key) ;; if you use any :bind variant |
31 |
37 |
|
32 |
38 |
(custom-set-variables |
33 |
39 |
;; custom-set-variables was added by Custom. |
34 |
40 |
;; If you edit it by hand, you could mess it up, so be careful. |
35 |
41 |
;; Your init file should contain only one such instance. |
36 |
42 |
;; If there is more than one, they won't work right. |
37 |
43 |
'(custom-safe-themes |
38 |
44 |
'("763bf89898a06b03f7b65fbc29857a1c292e4350246093702fdbd6c4e46e2cf0" "78e6be576f4a526d212d5f9a8798e5706990216e9be10174e3f3b015b8662e27" "d9646b131c4aa37f01f909fbdd5a9099389518eb68f25277ed19ba99adeb7279" "8b58ef2d23b6d164988a607ee153fd2fa35ee33efc394281b1028c2797ddeebb" "f9aede508e587fe21bcfc0a85e1ec7d27312d9587e686a6f5afdbb0d220eab50" "83ae405e25a0a81f2840bfe5daf481f74df0ddb687f317b5e005aa61261126e9" "c433c87bd4b64b8ba9890e8ed64597ea0f8eb0396f4c9a9e01bd20a04d15d358" "a24c5b3c12d147da6cef80938dca1223b7c7f70f2f382b26308eba014dc4833a" "732b807b0543855541743429c9979ebfb363e27ec91e82f463c91e68c772f6e3" "a2cde79e4cc8dc9a03e7d9a42fabf8928720d420034b66aecc5b665bbf05d4e9" "8aebf25556399b58091e533e455dd50a6a9cba958cc4ebb0aab175863c25b9a4" "bd7b7c5df1174796deefce5debc2d976b264585d51852c962362be83932873d9" default)) |
39 |
45 |
'(inhibit-startup-screen t) |
40 |
46 |
'(package-selected-packages |
41 |
47 |
'(company-fuzzy company-yasnippet web-mode use-package srefactor spacemacs-theme spaceline solarized-theme rainbow-delimiters pretty-mode page-break-lines monokai-theme helm general evil dashboard dante company-flx company-anaconda clang-format auto-package-update auctex a)) |
42 |
48 |
'(spaceline-inflation 1 t nil "Customized with use-package spaceline") |
43 |
49 |
'(spaceline-toggle-buffer-size-off nil t nil "Customized with use-package spaceline") |
44 |
50 |
'(warning-suppress-types '((comp)))) |
45 |
51 |
;(custom-set-faces |
46 |
52 |
;; custom-set-faces was added by Custom. |
47 |
53 |
;; If you edit it by hand, you could mess it up, so be careful. |
48 |
54 |
;; Your init file should contain only one such instance. |
49 |
55 |
;; If there is more than one, they won't work right. |
50 |
56 |
;'(default ((((class color) (min-colors 89)) (:foreground "#ffffff" :background "#263238"))))) |
51 |
57 |
|
52 |
58 |
|
53 |
59 |
(add-to-list 'default-frame-alist |
54 |
60 |
'(font . "Hack-11")) |
55 |
61 |
|
56 |
62 |
;; To get rid of those FUCKING ANNOYING BACKUP FILES FUCKING HELL DUDE |
57 |
63 |
(setq backup-directory-alist '(("." . "~/.emacs.d/backup")) |
58 |
64 |
backup-by-copying t ; Don't delink hardlinks |
59 |
65 |
version-control t ; Use version numbers on backups |
60 |
66 |
delete-old-versions t ; Automatically delete excess backups |
61 |
67 |
kept-new-versions 20 ; how many of the newest versions to keep |
62 |
68 |
kept-old-versions 5 ; and how many of the old |
63 |
69 |
) |
64 |
70 |
;; And yes I copied it from SO, suck it: https://stackoverflow.com/questions/2680389/how-to-remove-all-files-ending-with-made-by-emacs |
65 |
71 |
|
66 |
72 |
;; Disables the use of tabs, replaces them with spaces |
67 |
73 |
(setq-default indent-tabs-mode nil) |
68 |
74 |
|
69 |
75 |
;; Activate UTF-8 throughout Ghent Emacs |
70 |
76 |
(prefer-coding-system 'utf-8) |
71 |
77 |
(set-default-coding-systems 'utf-8) |
72 |
78 |
(set-terminal-coding-system 'utf-8) |
73 |
79 |
(set-keyboard-coding-system 'utf-8) |
74 |
80 |
(setq x-select-request-type '(UTF8_STRING COMPOUND_TEXT TEXT STRING)) |
75 |
81 |
|
76 |
82 |
;; Line numbering config |
77 |
83 |
(global-display-line-numbers-mode) |
78 |
84 |
(setq display-line-numbers-mode t) |
79 |
85 |
(setq display-line-numbers-widen t) |
80 |
86 |
(setq display-line-numbers-type 'relative) |
81 |
87 |
(setq display-line-numbers-current-absolute t) |
82 |
88 |
|
83 |
89 |
(setq mouse-wheel-scroll-amount '(1 ((shift) . 1))) |
84 |
90 |
(setq scroll-step 1) |
85 |
91 |
(setq scroll-margin 10) ;; Keeps 10 lines above and down always visible if still left |
86 |
92 |
|
87 |
93 |
;; Enable line breaks in all modes at column 80 |
88 |
94 |
(setq-default auto-fill-function 'do-auto-fill) |
89 |
95 |
(setq-default fill-column 80) |
90 |
96 |
|
91 |
97 |
(setq ring-bell-function 'ignore) ;; Disables the FUCKING ANNOYING BEEPS HOLY SHIT |
92 |
98 |
|
93 |
99 |
;; Setup packages |
94 |
100 |
;(package-initialize) |
95 |
101 |
(require 'package) |
96 |
102 |
(setq package-enable-at-startup nil) |
97 |
103 |
(add-to-list 'package-archives '("org" . "https://orgmode.org/elpa/")) |
98 |
104 |
(add-to-list 'package-archives '("melpa" . "http://melpa.org/packages/")) |
99 |
105 |
(unless (package-installed-p 'use-package) |
100 |
106 |
(package-refresh-contents) |
101 |
107 |
(package-install 'use-package)) |
102 |
108 |
|
103 |
109 |
|
104 |
110 |
|
105 |
111 |
|
106 |
112 |
;; Next two lines allow foregoing :ensure t on all packages |
107 |
113 |
;; :ensure t simply makes sure that, if a package isn't installed on this |
108 |
114 |
;; machine, it's automatically fetched and installed. |
109 |
115 |
;; This doesn't keep packages up-to-date, cfr. auto-package-update for that |
110 |
116 |
(require 'use-package-ensure) |
111 |
117 |
(setq use-package-always-ensure t) |
112 |
118 |
|
113 |
119 |
;; Package for automatic updating of all the other packages |
114 |
120 |
(use-package auto-package-update |
115 |
121 |
:config |
116 |
122 |
(setq auto-package-update-delete-old-versions t) |
117 |
123 |
(setq auto-package-update-hide-results t) |
118 |
124 |
(auto-package-update-maybe)) |
119 |
125 |
|
120 |
126 |
;; Easier keybindings so we can do more lazy loading |
121 |
127 |
(use-package general |
122 |
128 |
:config |
123 |
129 |
(general-create-definer my-leader-def |
124 |
130 |
;; :prefix my-leader |
125 |
131 |
:prefix "SPC") |
126 |
132 |
(general-create-definer local-leader-def |
127 |
133 |
;; :prefix local-leader |
128 |
134 |
:prefix ",")) |
129 |
135 |
|
130 |
136 |
(use-package dashboard |
131 |
137 |
:init |
132 |
138 |
(setq dashboard-banner-logo-title "") ; It's nicer to just not have a title text. |
133 |
139 |
(setq dashboard-startup-banner "~/ghent-emacs.png") |
134 |
140 |
:config |
135 |
141 |
(dashboard-setup-startup-hook)) |
136 |
142 |
|
137 |
143 |
;; AUCTeX configuration |
138 |
144 |
;; Partly inspired by https://piotr.is/2010/emacs-as-the-ultimate-latex-editor/ |
139 |
145 |
;;;;(use-package auctex |
140 |
146 |
;;:init |
141 |
147 |
;;(setq TeX-auto-save t) |
142 |
148 |
;;(setq TeX-parse-self t) |
143 |
149 |
;;(setq Tex-save-query nil) |
144 |
150 |
;;) |
145 |
151 |
|
146 |
152 |
;; Updates all packages automatically |
147 |
153 |
(use-package auto-package-update |
148 |
154 |
:config |
149 |
155 |
(setq auto-package-update-delete-old-versions t) |
150 |
156 |
(setq auto-package-update-hide-results t) |
151 |
157 |
(auto-package-update-maybe)) |
152 |
158 |
|
153 |
159 |
;; UI settings |
154 |
160 |
(tool-bar-mode -1) |
155 |
161 |
(menu-bar-mode -1) |
156 |
162 |
(toggle-scroll-bar -1) |
157 |
163 |
|
158 |
164 |
;; Tabs and width |
159 |
165 |
(setq-default tab-width 4) |
160 |
166 |
(setq-default c-basic-offset 4) |
161 |
167 |
|
162 |
168 |
(use-package spaceline |
163 |
169 |
:init |
164 |
170 |
(setq frame-char-height 35) |
165 |
171 |
(setq powerline-height 35) |
166 |
172 |
:custom |
167 |
173 |
(spaceline-toggle-buffer-size-off) |
168 |
174 |
;(setq powerline-height 21) |
169 |
175 |
(spaceline-inflation 1) |
170 |
176 |
(powerline-default-separator 'slant) |
171 |
177 |
:config |
172 |
178 |
(spaceline-spacemacs-theme) |
173 |
179 |
(setq spaceline-highlight-face-func 'spaceline-highlight-face-evil-state)) |
174 |
180 |
|
175 |
181 |
|
176 |
182 |
(use-package monokai-theme |
177 |
183 |
:config |
178 |
184 |
(load-theme 'monokai t) |
179 |
185 |
(setq monokai-variable-pitch-mode t)) |
180 |
186 |
;; When using solarized as theme, put in :config |
181 |
187 |
;; (setq x-underline-at-descent-line t) |
182 |
188 |
;; Which will block an ugly line being drawn trhough the modeline. |
183 |
189 |
|
184 |
190 |
;(add-hook 'org-mode-hook '(lambda () (setq fill-column 80))) |
185 |
191 |
;(add-hook 'org-mode-hook 'auto-fill-mode) |
186 |
192 |
;; (Programming) languages |
187 |
193 |
|
188 |
194 |
|
189 |
195 |
|
190 |
196 |
(use-package dante |
191 |
197 |
:after haskell-mode |
192 |
198 |
:commands 'dante-mode |
193 |
199 |
:init |
194 |
200 |
(add-hook 'haskell-mode-hook 'dante-mode) |
195 |
201 |
(add-hook 'haskell-mode-hook 'flycheck-mode) |
196 |
202 |
(add-hook 'haskell-mode-hook ' |
197 |
203 |
(lambda () (modify-syntax-entry ?_ "w"))) |
198 |
204 |
) |
199 |
205 |
|
200 |
206 |
|
201 |
207 |
;; HTML/CSS/Django |
202 |
208 |
(use-package web-mode |
203 |
209 |
:mode "\\.html?\\.djhtml\\'" |
204 |
210 |
:init |
205 |
211 |
(add-to-list 'auto-mode-alist '("\\.djhtml\\'" . web-mode)) |
206 |
212 |
(setq web-mode-markup-indent-offset 4) |
207 |
213 |
(setq web-mode-css-indent-offset 4) |
208 |
214 |
(setq web-mode-code-indent-offset 4) |
209 |
215 |
;(setq web-mode-engines-alist |
210 |
216 |
; '(("django" . "\\.html\\"))) ;; FIXME this doesn't work yet. IDK why. |
211 |
217 |
:custom ;; Next lines disable all the automatic completion stuff that I didn't explicitely ask for |
212 |
218 |
(web-mode-enable-auto-pairing nil) |
213 |
219 |
(web-mode-enable-auto-closing nil) |
214 |
220 |
(web-mode-enable-auto-expanding nil) |
215 |
221 |
(web-mode-enable-auto-opening nil) |
216 |
222 |
(web-mode-enable-auto-quoting nil)) |
217 |
223 |
|
218 |
224 |
|
219 |
225 |
(use-package company |
220 |
226 |
:hook (after-init . global-company-mode) |
221 |
227 |
:init |
222 |
228 |
(company-tng-configure-default) ; Use <TAB> to scroll in completion options |
223 |
229 |
(setq company-minimum-prefix-length 2) |
224 |
230 |
(setq company-idle-delay 0.0)) |
225 |
231 |
|
226 |
232 |
|
227 |
233 |
(use-package company-fuzzy |
228 |
234 |
:hook (company-mode . company-fuzzy-mode) |
229 |
235 |
:init |
230 |
236 |
(setq company-fuzzy-sorting-backend 'flx |
231 |
237 |
company-fuzzy-reset-selection t |
232 |
238 |
company-fuzzy-prefix-on-top nil |
233 |
239 |
company-fuzzy-history-backends '(company-yasnippet) |
234 |
240 |
company-fuzzy-trigger-symbols '("." "->" "<" "\"" "'" "@"))) |
235 |
241 |
|
236 |
242 |
(global-company-fuzzy-mode 1) |
237 |
243 |
|
238 |
244 |
(use-package clang-format |
239 |
245 |
:general |
240 |
246 |
(local-leader-def |
241 |
247 |
:states 'normal |
242 |
248 |
:modes '(c-mode-map c++-mode-map) |
243 |
249 |
"b" '(:ignore t :which-key "clang") |
244 |
250 |
"bf" 'clang-format-buffer) |
245 |
251 |
:init |
246 |
252 |
(setq-default clang-format-style "{BasedOnStyle: llvm, IndentWidth: 4}")) |
247 |
253 |
|
248 |
254 |
;; eViL-mode |
249 |
255 |
(use-package evil |
250 |
256 |
:hook (after-init . evil-mode) |
251 |
257 |
:bind (:map evil-normal-state-map ;; Scrolls over lines correctly |
252 |
258 |
("j" . evil-next-visual-line) |
253 |
259 |
("k" . evil-previous-visual-line)) |
254 |
260 |
:general |
255 |
261 |
(my-leader-def |
256 |
262 |
:states 'normal |
257 |
263 |
"b" '(:ignore t :which-key "buffer") |
258 |
264 |
"g" '(:ignore t :which-key "magit") |
259 |
265 |
"f" '(:ignore t :which-key "files") |
260 |
266 |
"bk" 'kill-this-buffer |
261 |
267 |
"bd" 'kill-other-buffers |
262 |
268 |
"bh" 'switch-to-home-buffer |
263 |
269 |
"br" 'revert-buffer |
264 |
270 |
"h" 'split-window-vertically |
265 |
271 |
"v" 'split-window-horizontally) |
266 |
272 |
(local-leader-def |
267 |
273 |
:states 'normal |
268 |
274 |
;; General lang options |
269 |
275 |
"c" 'compile) |
270 |
276 |
:init |
271 |
277 |
(setq evil-find-skip-newlines t) ;; Allows f/F/t/T to search beyond CR/LF |
272 |
278 |
(setq evil-undo-system 'undo-redo) ;; Just uses standard undo-redo behaviour |
273 |
279 |
;; a normal human expects |
274 |
280 |
(setq evil-want-C-u-scroll t)) ;; Activates c-u scroll to above. |
275 |
281 |
|
276 |
282 |
;; About smooth-scrolling: I'd normally just use some variables for scrolling |
277 |
283 |
;; but they all fail with org-mode. This package fixes everything that's wrong for me. |
278 |
284 |
;(use-package smooth-scrolling |
279 |
285 |
;:config |
280 |
286 |
;(smooth-scrolling-mode 1)) |
281 |
287 |
|
282 |
288 |
(use-package org |
283 |
289 |
:pin "org" |
284 |
290 |
; FIXME This causes some errors with bind-keys or what have you. Commented |
285 |
291 |
; until it is fixed. |
286 |
292 |
;:bind (:bind-keymap |
287 |
293 |
; ("C-c x" . org-todo-state-map) |
288 |
294 |
; :map org-todo-state-map |
289 |
295 |
; ("x" . #'(lambda nil (interactive) (org-todo "CANCELLED"))) |
290 |
296 |
; ("d" . #'(lambda nil (interactive) (org-todo "DONE"))) |
291 |
297 |
; ("f" . #'(lambda nil (interactive) (org-todo "DEFERRED"))) |
292 |
298 |
; ("l" . #'(lambda nil (interactive) (org-todo "DELEGATED"))) |
293 |
299 |
; ("s" . #'(lambda nil (interactive) (org-todo "STARTED"))) |
294 |
300 |
; ("w" . #'(lambda nil (interactive) (org-todo "WAITING")))) |
295 |
301 |
; :map org-mode-map |
296 |
302 |
; ("C-c x" . org-todo-state-map)) |
297 |
303 |
:init |
298 |
304 |
(define-key mode-specific-map [?a] 'org-agenda) |
299 |
305 |
:custom |
300 |
306 |
;; Because I use XeLaTeX (it's objectively better), some variables need to be |
301 |
307 |
;; set so org-mode knows what to call. |
302 |
308 |
|
303 |
309 |
;; Okay, so you cán export asynchronous so compiling your PDF doesn't lock up |
304 |
310 |
;; the editor completely, but for one reason or another, you MUST set the |
305 |
311 |
;; async-debug to nil. Otherwise it will constantly "exit abnormally" without |
306 |
312 |
;; reason. This fixes it, who knows why. |
307 |
313 |
(org-export-async-debug nil) |
308 |
314 |
|
309 |
315 |
(org-latex-compiler 'xelatex) ; Makes sure the XeLaTeX compiler is used |
310 |
316 |
|
311 |
317 |
; Tells Org to use dvisvgm because dvipng does not support XeLaTeX's output format |
312 |
318 |
(org-preview-latex-default-process 'dvisvgm) |
313 |
319 |
|
314 |
320 |
; This edits the preview process so it works correctly with XeLaTeX. |
315 |
321 |
; Changes: |
316 |
322 |
; - "latex" to "xelatex" |
317 |
323 |
; - Added the "-no-pdf" flag so it prints an XDV file instead of PDF. |
318 |
324 |
; - change input type from dvi to xdv |
319 |
325 |
; - Only leave the dvisvgm option because I don't need the others |
320 |
326 |
(org-preview-latex-process-alist |
321 |
327 |
(quote |
322 |
328 |
((dvisvgm :programs |
323 |
329 |
("xelatex" "dvisvgm") |
324 |
330 |
:description "dvi > svg" :message "you need to install the programs: xelatex and dvisvgm." :use-xcolor t :image-input-type "xdv" :image-output-type "svg" :image-size-adjust |
325 |
331 |
(1.7 . 1.5) |
326 |
332 |
:latex-compiler |
327 |
333 |
("xelatex -interaction nonstopmode -no-pdf -output-directory %o %f") |
328 |
334 |
:image-converter |
329 |
335 |
("dvisvgm %f -n -b min -c %S -o %O"))))) |
330 |
336 |
|
331 |
337 |
;; Sets the formatting options. I only changed :scale to 1.6, but I don't know |
332 |
338 |
;; how to change only thát, so for now I'm configuring the entire variable |
333 |
339 |
(org-format-latex-options (quote |
334 |
340 |
(:foreground default :background default :scale 1.6 :html-foreground "Black" :html-background "Transparent" :html-scale 1.0 :matchers |
335 |
341 |
("begin" "$1" "$" "$$" "\\(" "\\[")))) |
336 |
342 |
|
337 |
343 |
;; Sets the directory in which the preview fragments are stored to the /tmp |
338 |
344 |
;; folder. Otherwise it clutters up the folder in which the source resides |
339 |
345 |
;; with what are essentially cache files. |
340 |
346 |
(org-preview-latex-image-directory "/tmp/ltximg/") |
341 |
347 |
|
342 |
348 |
;; Following customizations are in regard to org-agenda configuration. |
343 |
349 |
(org-agenda-files (quote ("~/shared/planning/planning.org"))) |
344 |
350 |
(org-default-notes-file "~/shared/planning/notes.org") |
345 |
351 |
(org-agenda-span 62) |
346 |
352 |
(org-deadline-warning-days 14) |
347 |
353 |
(org-agenda-show-all-dates t) |
348 |
354 |
(org-agenda-skip-deadline-if-done t) |
349 |
355 |
(org-agenda-skip-scheduled-if-done t) |
350 |
356 |
(org-agenda-start-on-weekday nil) |
351 |
357 |
(org-reverse-note-order t) |
352 |
358 |
(org-fast-tag-selection-single-key (quote expert)) |
353 |
359 |
(org-agenda-custom-commands |
354 |
360 |
(quote (("d" todo "DELEGATED" nil) |
355 |
361 |
("c" todo "DONE|DEFERRED|CANCELED" nil) |
356 |
362 |
("w" todo "WAITING" nil) |
357 |
363 |
("W" agenda "" ((org-agenda-ndays 21))) |
358 |
364 |
("A" agenda "" |
359 |
365 |
((org-agenda-skip-function |
360 |
366 |
(lambda nil |
361 |
367 |
(org-agenda-skip-entry-if (quote notregexp) "\\=.*\\[#A\\]"))) |
362 |
368 |
(org-agenda-ndays 1) |
363 |
369 |
(org-agenda-overriding-header "Today's Priority #A tasks: "))) |
364 |
370 |
("u" alltodo "" |
365 |
371 |
((org-agenda-skip-function |
366 |
372 |
(lambda nil |
367 |
373 |
(org-agenda-skip-entry-if (quote scheduled) (quote deadline) |
368 |
374 |
(quote regexp) "\n]+>"))) |
369 |
375 |
(org-agenda-overriding-header "Unscheduled TODO entries: ")))))) |
370 |
376 |
(org-capture-store-without-prompt t) |
371 |
377 |
(org-capture-templates |
372 |
378 |
(quote ((116 "* TODO %?\n %u" "~/Repositories/private/org/planning.org" "Tasks") |
373 |
379 |
(110 "* %u %?" "~/Repositories/private/org/notes.org" "Notes")))) |
374 |
380 |
(capture-annotation-functions (quote (org-capture-annotation))) |
375 |
381 |
(capture-handler-functions (quote (org-capture-handler)))) |
376 |
382 |
|
377 |
383 |
;:general |
378 |
384 |
;(local-leader-def |
379 |
385 |
; :states 'normal |
380 |
386 |
; :keymaps 'org-mode-map |
381 |
387 |
; "e" 'org-export-dispatch |
382 |
388 |
; "x" 'org-table-export |
383 |
389 |
; "." 'org-time-stamp |
384 |
390 |
; "t" 'org-twbs-export-to-html |
385 |
391 |
; "s" 'org-schedule |
386 |
392 |
; "d" 'org-deadline |
387 |
393 |
; "'" 'org-edit-special) |
388 |
394 |
; :config |
389 |
395 |
; ;; log todo items with timestamp |
390 |
396 |
; (setq org-log-done 'time)) |
391 |
397 |
|
392 |
398 |
(use-package helm |
393 |
399 |
:hook (after-init . helm-mode) |
394 |
400 |
:commands (helm-autoresize-mode) |
395 |
401 |
:init |
396 |
402 |
;; (defvar helm-google-suggest-use-curl-p) |
397 |
403 |
(defvar helm-ff-search-library-in-sexp) |
398 |
404 |
(defvar helm-echo-input-in-header-line) |
399 |
405 |
(defvar helm-ff-file-name-history-use-recentf) |
400 |
406 |
:general |
401 |
407 |
(general-define-key |
402 |
408 |
"M-x" 'helm-M-x |
403 |
409 |
"M-:" 'helm-eval-expression |
404 |
410 |
"C-c h" 'helm-command-prefix) |
405 |
411 |
(general-define-key |
406 |
412 |
:keymaps 'helm-map |
407 |
413 |
"<tab>" 'helm-execute-persistent-action |
408 |
414 |
"C-i" 'helm-execute-persistent-action |
409 |
415 |
"C-z" 'helm-select-action) |
410 |
416 |
(my-leader-def |
411 |
417 |
:states 'normal |
412 |
418 |
"bb" 'helm-buffers-list |
413 |
419 |
"ff" 'helm-find-files |
414 |
420 |
"p" 'helm-show-kill-ring) |
415 |
421 |
:config |
416 |
422 |
(setq helm-split-window-inside-p t ; open helm buffer inside current window, not occupy whole other window |
417 |
423 |
helm-move-to-line-cycle-in-source t ; move to end or beginning of source when reaching top or bottom of source. |
418 |
424 |
helm-ff-search-library-in-sexp t ; search for library in `require' and `declare-function' sexp. |
419 |
425 |
helm-scroll-amount 8 ; scroll 8 lines other window using m-<next>/m-<prior> |
420 |
426 |
helm-ff-file-name-history-use-recentf t |
421 |
427 |
helm-echo-input-in-header-line t) |
422 |
428 |
|
423 |
429 |
;; hide some autogenerated files from helm |
424 |
430 |
(setq helm-ff-skip-boring-files t) |
425 |
431 |
;; (add-to-list 'helm-boring-file-regexp-list "\\~$") |
426 |
432 |
|
427 |
433 |
(setq helm-autoresize-max-height 0) |
428 |
434 |
(setq helm-autoresize-min-height 20) |
429 |
435 |
(helm-autoresize-mode 1)) |
430 |
436 |
|
431 |
437 |
|
432 |
438 |
(use-package rainbow-delimiters |
433 |
439 |
:hook (prog-mode . rainbow-delimiters-mode)) |
434 |
440 |
|
435 |
441 |
;; Settings for having an LaTeX beamer class export tool |
436 |
442 |
(unless (boundp 'org-export-latex-classes) |
437 |
443 |
(setq org-export-latex-classes nil)) |
438 |
444 |
(add-to-list 'org-export-latex-classes |
439 |
445 |
;; beamer class, for presentations |
440 |
446 |
'("beamer" |
441 |
447 |
"\\documentclass[11pt]{beamer}\n |
442 |
448 |
\\mode<{{{beamermode}}}>\n |
443 |
449 |
\\usetheme{{{{beamertheme}}}}\n |
444 |
450 |
\\usecolortheme{{{{beamercolortheme}}}}\n |
445 |
451 |
\\beamertemplateballitem\n |
446 |
452 |
\\setbeameroption{show notes} |
447 |
453 |
\\usepackage[utf8]{inputenc}\n |
448 |
454 |
\\usepackage[T1]{fontenc}\n |
449 |
455 |
\\usepackage{hyperref}\n |
450 |
456 |
\\usepackage{color} |
451 |
457 |
\\usepackage{listings} |
452 |
458 |
\\lstset{numbers=none,language=[ISO]C++,tabsize=4, |
453 |
459 |
frame=single, |
454 |
460 |
basicstyle=\\small, |
455 |
461 |
showspaces=false,showstringspaces=false, |
456 |
462 |
showtabs=false, |
457 |
463 |
keywordstyle=\\color{blue}\\bfseries, |
458 |
464 |
commentstyle=\\color{red}, |
459 |
465 |
}\n |
460 |
466 |
\\usepackage{verbatim}\n |
461 |
467 |
\\institute{{{{beamerinstitute}}}}\n |
462 |
468 |
\\subject{{{{beamersubject}}}}\n" |
463 |
469 |
|
464 |
470 |
("\\section{%s}" . "\\section*{%s}") |
465 |
471 |
|
466 |
472 |
("\\begin{frame}[fragile]\\frametitle{%s}" |
467 |
473 |
"\\end{frame}" |
468 |
474 |
"\\begin{frame}[fragile]\\frametitle{%s}" |
469 |
475 |
"\\end{frame}"))) |
470 |
476 |
|
471 |
477 |
;; Adds a letter class, for formal letters |
472 |
478 |
|
473 |
479 |
(add-to-list 'org-export-latex-classes |
474 |
480 |
|
475 |
481 |
'("letter" |
476 |
482 |
"\\documentclass[11pt]{letter}\n |
477 |
483 |
\\usepackage[utf8]{inputenc}\n |
478 |
484 |
\\usepackage[T1]{fontenc}\n |
479 |
485 |
\\usepackage{color}" |
480 |
486 |
|
481 |
487 |
("\\section{%s}" . "\\section*{%s}") |
482 |
488 |
("\\subsection{%s}" . "\\subsection*{%s}") |
483 |
489 |
("\\subsubsection{%s}" . "\\subsubsection*{%s}") |
484 |
490 |
("\\paragraph{%s}" . "\\paragraph*{%s}") |
485 |
491 |
("\\subparagraph{%s}" . "\\subparagraph*{%s}"))) |
486 |
492 |
|
487 |
493 |
|
488 |
494 |
(custom-set-faces |
489 |
495 |
;; custom-set-faces was added by Custom. |
490 |
496 |
;; If you edit it by hand, you could mess it up, so be careful. |
491 |
497 |
;; Your init file should contain only one such instance. |
492 |
498 |
;; If there is more than one, they won't work right. |
493 |
499 |
'(default ((t (:background nil))))) |
494 |
500 |
|
495 |
501 |
|
496 |
502 |
;; This is to fix the retarded scrolling behaviour in Emacs as much as possible: |
497 |
503 |
(setq redisplay-dont-pause t |
498 |
504 |
scroll-margin 1 |
499 |
505 |
scroll-step 1 |
500 |
506 |
scroll-conservatively 10000 |
501 |
507 |
scroll-preserve-screen-position 1) |
502 |
508 |
;; Stops Emacs from accelerating my scroll: |
503 |
509 |
(setq mouse-wheel-progressive-speed nil) |
504 |
510 |
;; Makes scrolling do 5 lines at a time, otherwise it's pretty slow |
505 |
511 |
(setq mouse-wheel-scroll-amount '(2)) |
506 |
512 |