branch: externals/company
commit 24c804393eaebe2e6919c1d9f7fbebfbc76d6eae
Merge: 6c7731d4ec 566c273678
Author: Dmitry Gutov <dmi...@gutov.dev>
Commit: GitHub <nore...@github.com>
Merge pull request #1471 from company-mode/async_no_cache_flicker
No-flicker with no-cache+async and while-no-input in company-capf
---
NEWS.md | 8 ++++++++
company-capf.el | 18 ++++++++++++++---
company.el | 59 ++++++++++++++++++++++++++++++++----------------------
test/capf-tests.el | 27 ++++++++++++++++++++++++-
4 files changed, 84 insertions(+), 28 deletions(-)
diff --git a/NEWS.md b/NEWS.md
index 7a5085ff2f..093f2bb3d7 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,6 +2,14 @@
# Next
+* Improved behavior when user types new character while completion is being
+ computed: better performance, less blinking (in the rare cases when it still
+ happened). The improvement extends to native async backends and to
+ `company-capf`.
+* As such `company-capf` now interrupts computation on new user
+ input. Completion tables that are incompatible with this behavior should get
+ updated: bind `inhibit-quit` to non-nil around their sensitive sections, or
+ simply around the whole implementation (as a fallback).
* `company-elisp` has been removed. It's not needed since Emacs 24.4, with all
of its features having been incorporated into the built-in Elisp completion.
* `company-files` shows shorter completions. Previously, the popup spanned
diff --git a/company-capf.el b/company-capf.el
index 0173a611cc..2543f3d8d2 100644
--- a/company-capf.el
+++ b/company-capf.el
@@ -1,6 +1,6 @@
;;; company-capf.el --- company-mode completion-at-point-functions backend -*-
lexical-binding: t -*-
-;; Copyright (C) 2013-2023 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2024 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monn...@iro.umontreal.ca>
@@ -189,9 +189,10 @@ so we can't just use the preceding variable instead.")
table pred))))
(company-capf--save-current-data res meta)
(when res
- (let* ((candidates (completion-all-completions input table pred
+ (let* ((candidates (company-capf--candidates-1 input table pred
(length input)
- meta))
+ meta
+ non-essential))
(sortfun (cdr (assq 'display-sort-function meta)))
(last (last candidates))
(base-size (and (numberp (cdr last)) (cdr last))))
@@ -207,6 +208,17 @@ so we can't just use the preceding variable instead.")
candidates))
candidates)))))
+(defun company-capf--candidates-1 (input table pred len meta
interrupt-on-input)
+ (if (not interrupt-on-input)
+ (completion-all-completions input table pred len meta)
+ (let (res)
+ (and (while-no-input
+ (setq res
+ (completion-all-completions input table pred len meta))
+ nil)
+ (throw 'interrupted 'new-input))
+ res)))
+
(defun company--capf-post-completion (arg)
(let* ((res company-capf--current-completion-data)
(exit-function (plist-get (nthcdr 4 res) :exit-function))
diff --git a/company.el b/company.el
index 9b518347c3..fb564f1d25 100644
--- a/company.el
+++ b/company.el
@@ -1411,7 +1411,10 @@ be recomputed when this value changes."
(defvar-local company-selection-changed nil)
(defvar-local company--manual-action nil
- "Non-nil, if manual completion took place.")
+ "Non-nil if manual completion was performed by the user.")
+
+(defvar-local company--manual-now nil
+ "Non-nil if manual completion is being performed now.")
(defvar-local company--manual-prefix nil)
@@ -1591,12 +1594,11 @@ update if FORCE-UPDATE."
'snippet))))
(defun company--fetch-candidates (prefix)
- (let* ((non-essential (not (company-explicit-action-p)))
+ (let* ((non-essential (not company--manual-now))
(inhibit-redisplay t)
- (c (if (or company-selection-changed
- ;; FIXME: This is not ideal, but we have not managed to
deal
- ;; with these situations in a better way yet.
- (company-require-match-p))
+ ;; At least we need "fresh" completions if the current command will
+ ;; rely on the result (e.g. insert common, or finish completion).
+ (c (if company--manual-now
(company-call-backend 'candidates prefix)
(company-call-backend-raw 'candidates prefix))))
(if (not (eq (car c) :async))
@@ -1617,9 +1619,11 @@ update if FORCE-UPDATE."
(while (member (car unread-command-events)
'(company-foo (t . company-foo)))
(pop unread-command-events))
- (prog1
- (and (consp res) res)
- (setq res 'exited))))))
+ (let ((res-was res))
+ (setq res 'exited)
+ (if (eq 'none res-was)
+ (throw 'interrupted 'new-input)
+ res-was))))))
(defun company--sneaky-refresh ()
(when company-candidates (company-call-frontends 'unhide))
@@ -2102,8 +2106,10 @@ doesn't cause any immediate changes to the buffer text."
(company-assert-enabled)
(setq company--manual-action t)
(unwind-protect
- (let ((company-minimum-prefix-length 0))
- (or company-candidates
+ (let ((company-minimum-prefix-length 0)
+ (company--manual-now t))
+ (or (and company-candidates
+ (= company-point (point)))
(company-auto-begin)))
(unless company-candidates
(setq company--manual-action nil))))
@@ -2201,13 +2207,16 @@ For more details see `company-insertion-on-trigger' and
(setq company-candidates-cache nil))
(let* ((new-prefix (company-call-backend 'prefix))
(ignore-case (company-call-backend 'ignore-case))
- (c (when (and (company--good-prefix-p new-prefix
- (company--prefix-min-length))
- (setq new-prefix (company--prefix-str new-prefix))
- (= (- (point) (length new-prefix))
- (- company-point (length company-prefix))))
- (company-calculate-candidates new-prefix ignore-case))))
+ (c (catch 'interrupted
+ (when (and (company--good-prefix-p new-prefix
+ (company--prefix-min-length))
+ (setq new-prefix (company--prefix-str new-prefix))
+ (= (- (point) (length new-prefix))
+ (- company-point (length company-prefix))))
+ (company-calculate-candidates new-prefix ignore-case)))))
(cond
+ ((eq c 'new-input) ; Keep the old completions, company-point, prefix.
+ t)
((and company-abort-on-unique-match
(company--unique-match-p c new-prefix ignore-case))
;; Handle it like completion was aborted, to differentiate from user
@@ -2216,7 +2225,8 @@ For more details see `company-insertion-on-trigger' and
(company-cancel 'unique))
((consp c)
;; incremental match
- (setq company-prefix new-prefix)
+ (setq company-prefix new-prefix
+ company-point (point))
(company-update-candidates c)
c)
((and (characterp last-command-event)
@@ -2250,9 +2260,14 @@ For more details see `company-insertion-on-trigger' and
;; Keep this undocumented, esp. while only 1 backend needs it.
(company-call-backend 'set-min-prefix min-prefix)
(setq company-prefix (company--prefix-str prefix)
+ company-point (point)
company-backend backend
- c (company-calculate-candidates company-prefix ignore-case))
+ c (catch 'interrupted
+ (company-calculate-candidates company-prefix
ignore-case)))
(cond
+ ((or (null c) (eq c 'new-input))
+ (when company--manual-action
+ (message "No completion found")))
((and company-abort-on-unique-match
(company--unique-match-p c company-prefix ignore-case)
(if company--manual-action
@@ -2262,9 +2277,6 @@ For more details see `company-insertion-on-trigger' and
t))
;; ...abort and run the hooks, e.g. to clear the cache.
(company-cancel 'unique))
- ((null c)
- (when company--manual-action
- (message "No completion found")))
(t ;; We got completions!
(when company--manual-action
(setq company--manual-prefix prefix))
@@ -2282,8 +2294,7 @@ For more details see `company-insertion-on-trigger' and
(company--begin-new)))
(if (not company-candidates)
(setq company-backend nil)
- (setq company-point (point)
- company--point-max (point-max))
+ (setq company--point-max (point-max))
(company-ensure-emulation-alist)
(company-enable-overriding-keymap company-active-map)
(company-call-frontends 'update)))
diff --git a/test/capf-tests.el b/test/capf-tests.el
index 37efa8d541..bf7997ade0 100644
--- a/test/capf-tests.el
+++ b/test/capf-tests.el
@@ -1,6 +1,6 @@
;;; capf-tests.el --- company tests for the company-capf backend -*-
lexical-binding: t; -*-
-;; Copyright (C) 2018-2019, 2021-2023 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2019, 2021-2024 Free Software Foundation, Inc.
;; Author: João Távora <joaotav...@gmail.com>
;; Keywords:
@@ -141,5 +141,30 @@
0 14 (face (company-tooltip-common company-tooltip));
"with-current-b"
14 19 (face company-tooltip))))))) ; "uffer"
+(ert-deftest company-capf-interrupted-on-input ()
+ (should
+ (eq
+ (catch 'interrupted
+ (with-temp-buffer
+ (let ((completion-at-point-functions
+ (list (lambda ()
+ (list 1 1 obarray :company-use-while-no-input t))))
+ (unread-command-events '(?a))
+ (non-essential t))
+ (company-capf 'candidates "a")
+ (error "Not reachable"))))
+ 'new-input)))
+
+(ert-deftest company-capf-uninterrupted ()
+ (should
+ (equal
+ (with-temp-buffer
+ (let ((completion-at-point-functions
+ (list (lambda ()
+ (list 1 1 '("abcd" "ae" "be") t))))
+ (unread-command-events '(?a)))
+ (company-capf 'candidates "b")))
+ '("be"))))
+
(provide 'capf-tests)
;;; capf-tests.el ends here
