[elpa] externals/company 5d05b0829b 2/2: In grouped backend, use the highest prefix length override

[ELPA Syncer]

branch: externals/company
commit 5d05b0829b65ac0f5c334b85b53d9d7cc0204427
Author: Dmitry Gutov <dmitry@gutov.dev>
Commit: Dmitry Gutov <dmitry@gutov.dev>

    In grouped backend, use the highest prefix length override
    
    Should help in scenarios related to #1268.  Made possible by #1405.
---
 company.el         | 24 +++++++++++++++++++++++-
 test/core-tests.el | 29 +++++++++++++++++++++++++++++
 2 files changed, 52 insertions(+), 1 deletion(-)

diff --git a/company.el b/company.el
index 725df25a36..7060b60dc5 100644
--- a/company.el
+++ b/company.el
@@ -1281,7 +1281,7 @@ be recomputed when this value changes."
                                         company--multi-uncached-backends))))
                       found))))
        t)
-      ((or `prefix `ignore-case `no-cache `require-match)
+      ((or `ignore-case `no-cache `require-match)
        (let (value)
          (cl-dolist (backend backends)
            (when (setq value (company--force-sync
@@ -1290,6 +1290,7 @@ be recomputed when this value changes."
                         (eq value 'keep-prefix))
                (setq value t))
              (cl-return value)))))
+      (`prefix (company--multi-prefix backends))
       (_
        (let ((arg (car args)))
          (when (> (length arg) 0)
@@ -1297,6 +1298,27 @@ be recomputed when this value changes."
                               (car backends))))
              (apply backend command args))))))))
 
+(defun company--multi-prefix (backends)
+  (let (str len)
+    (dolist (backend backends)
+      (let* ((prefix (company--force-sync backend '(prefix) backend))
+             (prefix-len (cdr-safe prefix)))
+        (when (stringp (company--prefix-str prefix))
+          (cond
+           ((not str)
+            (setq str (company--prefix-str prefix)
+                  len (cdr-safe prefix)))
+           ((and prefix-len
+                 (not (eq len t))
+                 (equal str (company--prefix-str prefix))
+                 (or (null len)
+                     (eq prefix-len t)
+                     (> prefix-len len)))
+            (setq len prefix-len))))))
+    (if (and str len)
+        (cons str len)
+      str)))
+
 (defun company--multi-backend-adapter-candidates (backends prefix min-length 
separate)
   (let ((pairs (cl-loop for backend in backends
                         when (let ((bp (let ((company-backend backend))
diff --git a/test/core-tests.el b/test/core-tests.el
index 0a2e877b22..be3dbee60d 100644
--- a/test/core-tests.el
+++ b/test/core-tests.el
@@ -254,6 +254,35 @@
       (should (equal '("aa" "aab")
                      (company-call-backend 'candidates "aa"))))))
 
+(ert-deftest company-multi-backend-chooses-longest-prefix-length ()
+  (let* ((one (lambda (command &optional _)
+                (cl-case command
+                  (prefix "aa")
+                  (candidates (list "aa")))))
+         (two (lambda (command &optional _)
+                (cl-case command
+                  (prefix (cons "aa" t))
+                  (candidates (list "aab" )))))
+         (tri (lambda (command &optional _)
+                (cl-case command
+                  (prefix "")
+                  (candidates (list "aac")))))
+         (fur (lambda (command &optional _)
+                (cl-case command
+                  (prefix (cons "aa" 3))
+                  (candidates (list "aac")))))
+         (company--multi-uncached-backends (list one tri)))
+    (let ((company-backend (list one tri fur)))
+      (should
+       (equal
+        '("aa" . 3)
+        (company-call-backend 'prefix))))
+    (let ((company-backend (list one two tri fur)))
+      (should
+       (equal
+        '("aa" . t)
+        (company-call-backend 'prefix))))))
+
 (ert-deftest company-begin-backend-failure-doesnt-break-company-backends ()
   (with-temp-buffer
     (insert "a")