[elpa] externals/company 7ed2baeedd 05/30: Merge branch 'master' into completion_inside_symbol

[ELPA Syncer]

branch: externals/company
commit 7ed2baeedd1ffc0663a0901fa7477541019e56a1
Merge: ff6107bde3 24c804393e
Author: Dmitry Gutov <dmitry@gutov.dev>
Commit: Dmitry Gutov <dmitry@gutov.dev>

    Merge branch 'master' into completion_inside_symbol
---
 NEWS.md            |  8 +++++++
 company-capf.el    | 18 +++++++++++++---
 company.el         | 61 ++++++++++++++++++++++++++++++++----------------------
 test/capf-tests.el | 27 +++++++++++++++++++++++-
 4 files changed, 85 insertions(+), 29 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index fc883bc254..27792063d1 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -6,6 +6,14 @@
   (#[340](https://github.com/company-mode/company-mode/issues/340)).
 * New user option `company-inhibit-inside-symbols`. Set it to `t` to switch
   closer to the previous behavior.
+* 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 d72bb4fe56..03761d9469 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 <monnier@iro.umontreal.ca>
 
@@ -187,10 +187,11 @@ 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 (concat input suffix)
+      (let* ((candidates (company-capf--candidates-1 (concat input suffix)
                                                      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))))
@@ -206,6 +207,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 d62ae5c56a..8a4f6430ef 100644
--- a/company.el
+++ b/company.el
@@ -1458,7 +1458,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)
 
@@ -1641,12 +1644,11 @@ update if FORCE-UPDATE."
                 'snippet))))
 
 (defun company--fetch-candidates (prefix suffix)
-  (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 suffix)
               (company-call-backend-raw 'candidates prefix suffix))))
     (if (not (eq (car c) :async))
@@ -1667,9 +1669,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))
@@ -2152,8 +2156,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))))
@@ -2252,13 +2258,16 @@ For more details see `company-insertion-on-trigger' and
   (let* ((new-prefix (company-call-backend 'prefix))
          (new-suffix (company--suffix-str new-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 
new-suffix))))
+         (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 
new-suffix)))))
     (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
@@ -2268,7 +2277,8 @@ For more details see `company-insertion-on-trigger' and
      ((consp c)
       ;; incremental match
       (setq company-prefix new-prefix
-            company-suffix new-suffix)
+            company-suffix new-suffix
+            company-point (point))
       (company-update-candidates c)
       c)
      ((and (characterp last-command-event)
@@ -2306,10 +2316,15 @@ For more details see `company-insertion-on-trigger' and
             (company-call-backend 'set-min-prefix min-prefix)
             (setq company-prefix (company--prefix-str entity)
                   company-suffix (company--suffix-str entity)
+                  company-point (point)
                   company-backend backend
-                  c (company-calculate-candidates company-prefix ignore-case
-                                                  company-suffix))
+                  c (catch 'interrupted
+                      (company-calculate-candidates company-prefix ignore-case
+                                                    company-suffix)))
             (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
@@ -2319,9 +2334,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 entity))
@@ -2339,8 +2351,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 <joaotavora@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