[elpa] externals/company 4ba6dcb874 22/24: Merge pull request #1488 from company-mode/expand-common

[ELPA Syncer]

branch: externals/company
commit 4ba6dcb874ff6e1f77e79bd18c9f6079480b7af8
Merge: 1321e285a5 df4f6e9ea3
Author: Dmitry Gutov <dmitry@gutov.dev>
Commit: GitHub <noreply@github.com>

    Merge pull request #1488 from company-mode/expand-common
    
    company-complete-common: Generalized "expand common" behavior
---
 NEWS.md                 |   5 +
 company-capf.el         |  10 +-
 company-dabbrev-code.el |  46 +++++---
 company-etags.el        |  31 ++++--
 company.el              | 289 ++++++++++++++++++++++++++++++++++++------------
 test/async-tests.el     |   4 +-
 test/capf-tests.el      |   4 +-
 test/core-tests.el      | 110 ++++++++++++++----
 8 files changed, 379 insertions(+), 120 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index ab50446e29..d764e1c60d 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,6 +2,11 @@
 
 # Next
 
+* `company-complete-common` now performs generalized ([expand common
+  part](https://github.com/company-mode/company-mode/pull/1488)) completion 
when
+  the backend supports that. In particular, for `completion-at-point-functions`
+  it queries `completion-try-completion`. `company-dabbrev-code` and
+  `company-etags` also do that when `completion-styles` support is enabled.
 * `company-dabbrev-other-buffers` and `company-dabbrev-code-other-buffers` can
   now take a function as its value 
(#[1485](https://github.com/company-mode/company-mode/issues/1485))
 * Completion works in the middle of a symbol
diff --git a/company-capf.el b/company-capf.el
index 166c569b8a..b58c5678fc 100644
--- a/company-capf.el
+++ b/company-capf.el
@@ -19,7 +19,6 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
 
-
 ;;; Commentary:
 ;;
 ;; The CAPF back-end provides a bridge to the standard
@@ -164,8 +163,17 @@ so we can't just use the preceding variable instead.")
      (company--capf-post-completion arg))
     (`adjust-boundaries
      company-capf--current-boundaries)
+    (`expand-common
+     (company-capf--expand-common arg (car rest)))
     ))
 
+(defun company-capf--expand-common (prefix suffix)
+  (let* ((data company-capf--current-completion-data)
+         (table (nth 3 data))
+         (pred (plist-get (nthcdr 4 data) :predicate)))
+    (company--capf-expand-common prefix suffix table pred
+                                 company-capf--current-completion-metadata)))
+
 (defun company-capf--annotation (arg)
   (let* ((f (or (plist-get (nthcdr 4 company-capf--current-completion-data)
                            :annotation-function)
diff --git a/company-dabbrev-code.el b/company-dabbrev-code.el
index 4a5be06cf2..e9dec1d566 100644
--- a/company-dabbrev-code.el
+++ b/company-dabbrev-code.el
@@ -114,6 +114,7 @@ comments or strings."
     (candidates (company-dabbrev--candidates arg (car rest)))
     (adjust-boundaries (and company-dabbrev-code-completion-styles
                             company-dabbrev--boundaries))
+    (expand-common (company-dabbrev-code--expand-common arg (car rest)))
     (kind 'text)
     (no-cache t)
     (ignore-case company-dabbrev-code-ignore-case)
@@ -121,26 +122,37 @@ comments or strings."
              (company--match-from-capf-face arg)))
     (duplicates t)))
 
+(defun company-dabbrev-code--expand-common (prefix suffix)
+  (when company-dabbrev-code-completion-styles
+    (let ((completion-styles (if (listp company-dabbrev-code-completion-styles)
+                                 company-dabbrev-code-completion-styles
+                               completion-styles)))
+      (company--capf-expand-common prefix suffix
+                                   (company-dabbrev-code--table prefix)))))
+
 (defun company-dabbrev--candidates (prefix suffix)
-  (let* ((case-fold-search company-dabbrev-code-ignore-case)
-         (regexp (company-dabbrev-code--make-regexp prefix)))
+  (let* ((case-fold-search company-dabbrev-code-ignore-case))
     (company-dabbrev-code--filter
      prefix suffix
-     (company-cache-fetch
-      'dabbrev-code-candidates
-      (lambda ()
-        (company-dabbrev--search
-         regexp
-         company-dabbrev-code-time-limit
-         (pcase company-dabbrev-code-other-buffers
-           (`t (list major-mode))
-           (`code company-dabbrev-code-modes)
-           ((pred functionp) (funcall company-dabbrev-code-other-buffers 
(current-buffer)))
-           (`all `all))
-         (not company-dabbrev-code-everywhere)))
-      :expire t
-      :check-tag
-      (cons regexp company-dabbrev-code-completion-styles)))))
+     (company-dabbrev-code--table prefix))))
+
+(defun company-dabbrev-code--table (prefix)
+  (let ((regexp (company-dabbrev-code--make-regexp prefix)))
+    (company-cache-fetch
+     'dabbrev-code-candidates
+     (lambda ()
+       (company-dabbrev--search
+        regexp
+        company-dabbrev-code-time-limit
+        (pcase company-dabbrev-code-other-buffers
+          (`t (list major-mode))
+          (`code company-dabbrev-code-modes)
+          ((pred functionp) (funcall company-dabbrev-code-other-buffers 
(current-buffer)))
+          (`all `all))
+        (not company-dabbrev-code-everywhere)))
+     :expire t
+     :check-tag
+     (cons regexp company-dabbrev-code-completion-styles))))
 
 (defun company-dabbrev-code--filter (prefix suffix table)
   (let ((completion-ignore-case company-dabbrev-code-ignore-case)
diff --git a/company-etags.el b/company-etags.el
index 9f5c9d4f46..34c68b814d 100644
--- a/company-etags.el
+++ b/company-etags.el
@@ -82,25 +82,35 @@ Set it to t or to a list of major modes."
         company-etags-buffer-table)))
 
 (defun company-etags--candidates (prefix suffix)
-  (let ((tags-table-list (company-etags-buffer-table))
-        (tags-file-name tags-file-name)
-        (completion-ignore-case company-etags-ignore-case)
+  (let ((completion-ignore-case company-etags-ignore-case)
         (completion-styles (if (listp company-etags-completion-styles)
                                company-etags-completion-styles
                              completion-styles))
-        table)
-    (and (or tags-file-name tags-table-list)
-         (fboundp 'tags-completion-table)
-         (setq table
-               (save-excursion
-                 (visit-tags-table-buffer)
-                 (tags-completion-table)))
+        (table (company-etags--table)))
+    (and table
          (if company-etags-completion-styles
              (let ((res (company--capf-completions prefix suffix table)))
                (setq company-etags--boundaries (assoc-default :boundaries res))
                (assoc-default :completions res))
            (all-completions prefix table)))))
 
+(defun company-etags--table ()
+  (let ((tags-table-list (company-etags-buffer-table))
+        (tags-file-name tags-file-name))
+    (and (or tags-file-name tags-table-list)
+         (fboundp 'tags-completion-table)
+         (save-excursion
+           (visit-tags-table-buffer)
+           (tags-completion-table)))))
+
+(defun company-etags--expand-common (prefix suffix)
+  (when company-etags-completion-styles
+    (let ((completion-styles (if (listp company-etags-completion-styles)
+                                 company-etags-completion-styles
+                               completion-styles)))
+      (company--capf-expand-common prefix suffix
+                                   (company-etags--table)))))
+
 ;;;###autoload
 (defun company-etags (command &optional arg &rest rest)
   "`company-mode' completion backend for etags."
@@ -116,6 +126,7 @@ Set it to t or to a list of major modes."
     (candidates (company-etags--candidates arg (car rest)))
     (adjust-boundaries (and company-etags-completion-styles
                             company-etags--boundaries))
+    (expand-common (company-etags--expand-common arg (car rest)))
     (no-cache company-etags-completion-styles)
     (location (let ((tags-table-list (company-etags-buffer-table)))
                 (when (fboundp 'find-tag-noselect)
diff --git a/company.el b/company.el
index ddad6422d6..ccc57a68f7 100644
--- a/company.el
+++ b/company.el
@@ -397,8 +397,8 @@ return value should be a list of candidates that match the 
prefix.
 
 Non-prefix matches are also supported (candidates that don't start with the
 prefix, but match it in some backend-defined way).  Backends that use this
-feature must disable cache (return t to `no-cache') and might also want to
-respond to `match'.
+feature must disable cache (return t in response to `no-cache') and might
+also want to handle `match'.
 
 Optional commands
 =================
@@ -473,6 +473,14 @@ is suffix (previously returned by the `prefix' command).  
Return a
 cons (NEW-PREFIX . NEW-SUFFIX) where both parts correspond to the
 completion candidate.
 
+`expand-common': The first argument is prefix and the second argument is
+suffix.  Return a cons (NEW-PREFIX . NEW-SUFFIX) that denote an edit in the
+current buffer which would be performed by `company-complete-common'.  It
+should try to make the combined length of the prefix and suffix longer,
+while ensuring that the completions for the new inputs are the same.
+Othewise return the original inputs.  If there are no matching completions,
+return the symbol `no-match'.
+
 The backend should return nil for all commands it does not support or
 does not know about.  It should also be callable interactively and use
 `company-begin-backend' to start itself in that case.
@@ -1235,6 +1243,20 @@ MAX-LEN is how far back to try to match the 
IDLE-BEGIN-AFTER-RE regexp."
       (:boundaries . ,(cons (substring prefix base-size)
                             (substring suffix 0 (cdr bounds)))))))
 
+(defun company--capf-expand-common (prefix suffix table &optional pred 
metadata)
+  (let* ((res
+          (completion-try-completion (concat prefix suffix)
+                                     table pred (length prefix) metadata)))
+    (cond
+     ((null res)
+      'no-match)
+     ((memq res '(t nil))
+      (cons prefix suffix))
+     (t
+      (cons
+       (substring (car res) 0 (cdr res))
+       (substring (car res) (cdr res)))))))
+
 (defvar company--cache (make-hash-table :test #'equal :size 10))
 
 (cl-defun company-cache-fetch (key
@@ -1314,15 +1336,12 @@ be recomputed when this value changes."
                            collect b))
         (separate (memq :separate backends)))
 
-    (when (eq command 'prefix)
-      (setq backends (butlast backends (length (member :with backends)))))
-
-    (setq backends (cl-delete-if #'keywordp backends))
+    (unless (eq command 'prefix)
+      (setq backends (cl-delete-if #'keywordp backends)))
 
     (pcase command
       (`candidates
        (company--multi-backend-adapter-candidates backends
-                                                  (car args)
                                                   (or 
company--multi-min-prefix 0)
                                                   separate))
       (`set-min-prefix (setq company--multi-min-prefix (car args)))
@@ -1355,53 +1374,158 @@ be recomputed when this value changes."
                (setq value t))
              (cl-return value)))))
       (`prefix (company--multi-prefix backends))
+      (`adjust-boundaries
+       (defvar company-point)
+       (let ((arg (car args)))
+         (when (> (length arg) 0)
+           (let* ((backend (or (get-text-property 0 'company-backend arg)
+                               (car backends)))
+                  (entity (company--force-sync backend '(prefix) backend))
+                  (prefix (company--prefix-str entity))
+                  (suffix (company--suffix-str entity)))
+             ;; XXX: Working around the stuff in
+             ;; company-preview--refresh-prefix.
+             (when (> (point) company-point)
+               (setq prefix (substring prefix
+                                       0
+                                       (- (length prefix)
+                                          (- (point) company-point)))))
+             (setq args (list arg prefix suffix))
+             (or
+              (apply backend command args)
+              (cons prefix suffix))))))
+      (`expand-common
+       (apply #'company--multi-expand-common
+              backends
+              (or company--multi-min-prefix 0)
+              args))
       (_
        (let ((arg (car args)))
          (when (> (length arg) 0)
            (let ((backend (or (get-text-property 0 'company-backend arg)
                               (car backends))))
-             (when (eq command 'adjust-boundaries)
-               (let ((entity (company--force-sync backend '(prefix) backend)))
-                 (setq args (list arg
-                                  (company--prefix-str entity)
-                                  (company--suffix-str entity)))))
              (apply backend command args))))))))
 
 (defun company--multi-prefix (backends)
-  (let (res len)
-    (dolist (backend backends)
-      (let* ((prefix (company--force-sync backend '(prefix) backend))
-             (prefix-len (company--prefix-len prefix)))
-        (when (stringp (company--prefix-str prefix))
-          (cond
-           ((not res)
-            (setq res prefix
-                  len (company--prefix-len prefix)))
-           ((and prefix-len
-                 (not (eq len t))
-                 (equal (company--prefix-str res)
-                        (company--prefix-str prefix))
-                 (or (eq prefix-len t)
-                     (> prefix-len (or len (length (company--prefix-str 
prefix))))))
-            (setq len prefix-len
-                  res prefix))))))
-    res))
+  (let* ((backends-after-with (cdr (member :with backends)))
+         prefix suffix len)
 
-(defun company--multi-backend-adapter-candidates (backends prefix min-length 
separate)
+    (dolist (backend backends)
+      (let* ((entity (and
+                      (not (keywordp backend))
+                      (company--force-sync backend '(prefix) backend)))
+             (new-len (company--prefix-len entity)))
+        (when (stringp (company--prefix-str entity))
+          (or (not backends-after-with)
+              (unless (memq backend backends-after-with)
+                (setq backends-after-with nil)))
+          (when (or
+                 (null prefix)
+                 (> (length (company--prefix-str entity))
+                    (length prefix)))
+            (setq prefix (company--prefix-str entity)))
+          (when (> (length (company--suffix-str entity))
+                   (length suffix))
+            (setq suffix (company--suffix-str entity)))
+          (when (or (eq t new-len)
+                    (and new-len
+                         (not (eq t len))
+                         (or (not len) (> new-len len))))
+            (setq len new-len)))))
+    (unless backends-after-with
+      (list prefix suffix len))))
+
+(defun company--multi-expand-common (backends min-length prefix suffix)
+  (let ((tuples
+         (cl-loop for backend in backends
+                  for bp = (let ((company-backend backend))
+                             (company-call-backend 'prefix))
+                  for expansion =
+                  (when (company--good-prefix-p bp min-length)
+                    (let ((inhibit-redisplay t)
+                          (company-backend backend))
+                      (company--expand-common (company--prefix-str bp)
+                                              (company--suffix-str bp))))
+                  when (consp expansion)
+                  collect
+                  (list backend bp expansion)))
+        replacements)
+    (dolist (tuple tuples)
+      (cl-assert (string-suffix-p (company--prefix-str (nth 1 tuple))
+                                  prefix))
+      (cl-assert (string-prefix-p (company--suffix-str (nth 1 tuple))
+                                  suffix)))
+    ;; We try to find the smallest possible edit for each backend's expansion
+    ;; (minimum prefix and suffix, beyond which the area is unchanged).
+    (setq replacements
+          (mapcar
+           (lambda (tuple)
+             (let* ((backend-prefix (company--prefix-str (nth 1 tuple)))
+                    (backend-suffix (company--suffix-str (nth 1 tuple)))
+                    (bplen (length backend-prefix))
+                    (bslen (length backend-suffix))
+                    (beg 0)
+                    (end 0)
+                    (rep-suffix-len (length (cdr (nth 2 tuple))))
+                    (max-beg (min bplen (length (car (nth 2 tuple)))))
+                    (max-end (min bslen rep-suffix-len)))
+               (while (and (< beg max-beg)
+                           (= (aref backend-prefix beg)
+                              (aref (car (nth 2 tuple)) beg)))
+                 (cl-incf beg))
+               (while (and (< end max-end)
+                           (= (aref suffix (- bslen end 1))
+                              (aref (cdr (nth 2 tuple))
+                                    (- rep-suffix-len end 1))))
+                 (cl-incf end))
+               (list (- bplen beg)
+                     (substring (car (nth 2 tuple)) beg)
+                     (- bslen end)
+                     (substring (cdr (nth 2 tuple)) 0 (- rep-suffix-len end))
+                     (nth 0 tuple))))
+           tuples))
+    (setq replacements (sort replacements
+                             (lambda (t1 t2) (< (- (length (nth 1 t1)) (nth 0 
t1))
+                                           (- (length (nth 1 t2)) (nth 0 
t2))))))
+    (or
+     (let ((choice (car replacements)))
+       ;; See if every replacement is similar enough to the one we selected:
+       ;; same suffix and beg/end and a prefix that starts with the proposed.
+       ;;
+       ;; More advanced checks seem possible, but with some backends reacting 
to
+       ;; buffer contents (not just string arguments) it seems we'd need to
+       ;; change the buffer contents first, then fetch `candidates' for each,
+       ;; and revert at the end.  Might be error-prone.
+       (and
+        choice
+        (cl-every
+         (lambda (replacement)
+           (and
+            (= (car replacement) (car choice))
+            (= (nth 2 replacement) (nth 2 choice))
+            (equal (nth 3 replacement) (nth 3 choice))
+            (string-prefix-p (nth 1 choice) (nth 1 replacement))))
+         (cdr replacements))
+        ;; Proposed edit applied to the group's prefix and suffix.
+        (cons (concat (substring prefix 0 (- (length prefix) (nth 0 choice)))
+                      (nth 1 choice))
+              (concat (nth 3 choice)
+                      (substring suffix (nth 2 choice))))))
+     (and (null replacements) 'no-match)
+     ;; Didn't find anything suitable - return entity parts unchanged.
+     (cons prefix suffix))))
+
+(defun company--multi-backend-adapter-candidates (backends min-length separate)
   (let* (backend-prefix suffix
          (pairs (cl-loop for backend in backends
                          when (let ((bp (let ((company-backend backend))
-                                              (company-call-backend 'prefix))))
-                                (and
-                                 ;; It's important that the lengths match.
-                                 (equal (company--prefix-str bp) prefix)
-                                 ;; One might override min-length, another not.
-                                 (if (company--good-prefix-p bp min-length)
-                                     (setq backend-prefix (company--prefix-str 
bp)
-                                           suffix (company--suffix-str bp))
-                                     t
-                                   (push backend 
company--multi-uncached-backends)
-                                   nil)))
+                                          (company-call-backend 'prefix))))
+                                ;; One might override min-length, another not.
+                                (if (company--good-prefix-p bp min-length)
+                                    (setq backend-prefix (company--prefix-str 
bp)
+                                          suffix (company--suffix-str bp))
+                                  (push backend 
company--multi-uncached-backends)
+                                  nil))
                          collect (cons (funcall backend 'candidates 
backend-prefix suffix)
                                        (company--multi-candidates-mapper
                                         backend
@@ -1647,9 +1771,8 @@ update if FORCE-UPDATE."
     (setq company-common
           (if (cdr company-candidates)
               (let ((common (try-completion "" company-candidates)))
-                (when (string-prefix-p company-prefix common
-                                       completion-ignore-case)
-                  common))
+                (and (stringp common)
+                     common))
             (car company-candidates)))))
 
 (defun company-calculate-candidates (prefix ignore-case suffix)
@@ -2928,6 +3051,46 @@ For use in the `select-mouse' frontend action.  
`let'-bound.")
     (let ((result (nth company-selection company-candidates)))
       (company-finish result))))
 
+(defun company--expand-common (prefix suffix)
+  (let ((expansion (company-call-backend 'expand-common prefix suffix)))
+    (unless expansion
+      ;; Backend doesn't implement this, try emulating.
+      (let* (;; XXX: We could also filter/group `company-candidates'.
+             (candidates (company-call-backend 'candidates prefix suffix))
+             ;; Assuming that boundaries don't vary between completions here.
+             ;; If they do, the backend should have a custom `expand-common'.
+             (boundaries-prefix (car (company--boundaries)))
+             (completion-ignore-case (company-call-backend 'ignore-case))
+             (trycmp (try-completion boundaries-prefix candidates))
+             (common (if (eq trycmp t) (car candidates) trycmp))
+             (max-len (when (and common
+                                 (cl-every (lambda (s) (string-suffix-p
+                                                   suffix s
+                                                   completion-ignore-case))
+                                           candidates))
+                        (-
+                         (apply #'min
+                                (mapcar #'length candidates))
+                         (length suffix))))
+             (common (if max-len
+                         (substring common 0
+                                    (min max-len (length common)))
+                       common)))
+        (setq expansion
+              (cond
+               ((null candidates)
+                'no-match)
+               ((string-prefix-p boundaries-prefix common t)
+                (cons (concat
+                       (substring prefix
+                                  0
+                                  (- (length prefix)
+                                     (length boundaries-prefix)))
+                       common)
+                      suffix))
+               (t (cons prefix suffix))))))
+    expansion))
+
 (defun company-complete-common ()
   "Insert the common part of all candidates."
   (interactive)
@@ -2935,22 +3098,19 @@ For use in the `select-mouse' frontend action.  
`let'-bound.")
     (if (and (not (cdr company-candidates))
              (equal company-common (car company-candidates)))
         (company-complete-selection)
-      ;; FIXME: Poor man's completion-try-completion.
-      (let* ((max-len (when (and company-common
-                                 (cl-every (lambda (s) (string-suffix-p 
company-suffix s))
-                                           company-candidates))
-                        (apply #'min
-                               (mapcar
-                                (lambda (s) (- (length s) (length 
company-suffix)))
-                                company-candidates))))
-             (company-common (if max-len
-                                 (substring company-common 0
-                                            (min max-len (length 
company-common)))
-                               company-common))
-             (company-suffix ""))
-        (company--insert-candidate company-common
-                                   (or (car (company--boundaries))
-                                       company-prefix))))))
+      (let ((expansion (company--expand-common company-prefix
+                                               company-suffix)))
+        (when (eq expansion 'no-match)
+          (user-error "No matches for the current input"))
+        (unless (equal (car expansion) company-prefix)
+          (if (eq (company-call-backend 'ignore-case) 'keep-prefix)
+              (insert (substring (car expansion) (length company-prefix)))
+            (delete-region (- (point) (length company-prefix)) (point))
+            (insert (car expansion))))
+        (unless (equal (cdr expansion) company-suffix)
+          (save-excursion
+            (delete-region (point) (+ (point) (length company-suffix)))
+            (insert (cdr expansion))))))))
 
 (defun company-complete-common-or-cycle (&optional arg)
   "Insert the common part of all candidates, or select the next one.
@@ -3510,13 +3670,6 @@ If SHOW-VERSION is non-nil, show the version in the echo 
area."
 
 (defun company--common-or-matches (value &optional suffix)
   (let ((matches (company-call-backend 'match value)))
-    (when (and matches
-               company-common
-               (listp matches)
-               (= 1 (length matches))
-               (= 0 (caar matches))
-               (> (length company-common) (cdar matches)))
-      (setq matches nil))
     (when (integerp matches)
       (setq matches `((0 . ,matches))))
     (or matches
diff --git a/test/async-tests.el b/test/async-tests.el
index b4d16ab62e..942fdc7f19 100644
--- a/test/async-tests.el
+++ b/test/async-tests.el
@@ -128,7 +128,7 @@
                                  (lambda (command)
                                    (should (eq command 'prefix))
                                    "foo"))))
-      (should (equal "foo" (company-call-backend-raw 'prefix))))
+      (should (equal '("foo" nil 3) (company-call-backend-raw 'prefix))))
     (let ((company-backend (list (lambda (_command)
                                    (cons :async
                                          (lambda (cb)
@@ -137,7 +137,7 @@
                                             (lambda () (funcall cb "bar"))))))
                                  (lambda (_command)
                                    "foo"))))
-      (should (equal "bar" (company-call-backend-raw 'prefix))))))
+      (should (equal '("bar" nil 3) (company-call-backend-raw 'prefix))))))
 
 (ert-deftest company-multi-backend-merges-deferred-candidates ()
   (with-temp-buffer
diff --git a/test/capf-tests.el b/test/capf-tests.el
index f1e446b9e9..06437c92a6 100644
--- a/test/capf-tests.el
+++ b/test/capf-tests.el
@@ -84,8 +84,8 @@
        (company--equal-including-properties
         render
         #("with-timeout-suspend"
-          0 12 (face (company-tooltip-common company-tooltip))   ; "with"
-          12 20 (face company-tooltip)))))))
+          0 7 (face (company-tooltip-common company-tooltip)) ; "with"
+          7 20 (face company-tooltip)))))))
 
 
 ;; Re. "perfect" highlighting of the non-prefix in company-capf matches, it is
diff --git a/test/core-tests.el b/test/core-tests.el
index 76e7a7bcff..0f8230f9ee 100644
--- a/test/core-tests.el
+++ b/test/core-tests.el
@@ -109,9 +109,9 @@
         company-candidates-cache
         company-common)
     (company-update-candidates '("abc" "def-abc"))
-    (should (null company-common))
+    (should (equal company-common ""))
     (company-update-candidates '("abc" "abe-c"))
-    (should (null company-common))
+    (should (equal company-common "ab"))
     (company-update-candidates '("abcd" "abcde" "abcdf"))
     (should (equal "abcd" company-common))))
 
@@ -128,22 +128,34 @@
     (company-call-backend 'set-min-prefix 1)
     (should (equal (company-call-backend 'candidates "z") '("a" "b" "c" 
"d")))))
 
-(ert-deftest company-multi-backend-filters-backends-by-prefix ()
+(ert-deftest company-multi-backend-with-empty-prefixes ()
   (let ((company-backend
          (list (lambda (command &optional _ &rest _r)
                  (cl-case command
-                   (prefix (cons "z" t))
+                   (prefix "")
                    (candidates '("a" "b"))))
                (lambda (command &optional _ &rest _r)
                  (cl-case command
-                   (prefix "t")
-                   (candidates '("c" "d"))))
-               (lambda (command &optional _ &rest _r)
+                   (prefix "")
+                   (candidates '("c" "d")))))))
+    (should (equal (company-call-backend 'prefix) '("" nil 0)))))
+
+(ert-deftest company-multi-backend-dispatches-separate-prefix-to-backends ()
+  (let ((company-backend
+         (list (lambda (command &optional arg &rest _r)
                  (cl-case command
-                   (prefix "z")
-                   (candidates '("e" "f")))))))
+                   (prefix (cons "z" t))
+                   (candidates
+                    (should (equal arg "z"))
+                    '("a" "b"))))
+               (lambda (command &optional arg &rest _r)
+                 (cl-case command
+                   (prefix "t")
+                   (candidates
+                    (should (equal arg "t"))
+                    '("c" "d")))))))
     (company-call-backend 'set-min-prefix 1)
-    (should (equal (company-call-backend 'candidates "z") '("a" "b" "e" 
"f")))))
+    (should (equal (company-call-backend 'candidates "z") '("a" "b" "c" 
"d")))))
 
 (ert-deftest company-multi-backend-remembers-candidate-backend ()
   (let ((company-backend
@@ -190,7 +202,7 @@
     (let ((company-backend (list 'ignore 'ignore :with secundo)))
       (should (null (company-call-backend 'prefix))))
     (let ((company-backend (list 'ignore primo :with secundo)))
-      (should (equal "a" (company-call-backend 'prefix)))
+      (should (equal '("a" nil 1) (company-call-backend 'prefix)))
       (company-call-backend 'set-min-prefix 1)
       (should (equal '("abb" "abc" "abd" "acc" "acd")
                      (company-call-backend 'candidates "a"))))))
@@ -233,7 +245,7 @@
     (let ((company-backend (list one two tri)))
       (should (equal '("bb" "ab")
                      (company-call-backend 'candidates "a"))))
-    (company-call-backend 'set-min-prefix 0)
+    (company-call-backend 'set-min-prefix 1)
     (let ((company-backend (list one two tri)))
       (should (equal '("aa" "ca" "ba" "bb" "ab")
                      (company-call-backend 'candidates "a"))))))
@@ -285,17 +297,17 @@
     (let ((company-backend (list one tri fur)))
       (should
        (equal
-        '("aa" . 3)
+        '("aa" nil 3)
         (company-call-backend 'prefix))))
     (let ((company-backend (list one two tri fur)))
       (should
        (equal
-        '("aa" . t)
+        '("aa" nil t)
         (company-call-backend 'prefix))))
     (let ((company-backend (list one fiv)))
       (should
        (equal
-        "aa"
+        '("aa" nil 2)
         (company-call-backend 'prefix))))))
 
 (ert-deftest company-multi-backend-supports-different-suffixes ()
@@ -319,7 +331,7 @@
                    '("a3")))))
          (company-backend (list one two tri)))
     (should
-     (equal '("a" "b")
+     (equal '("a" "b" 1)
             (company-call-backend 'prefix)))
     (should
      (equal '("a1b" "a2" "a3")
@@ -333,23 +345,81 @@
                    '("a1b")))))
          (tri (lambda (command &rest args)
                 (cl-case command
-                  (prefix '("a" "bcd"))
+                  (prefix '("aa" "bcd"))
                   (adjust-boundaries
                    (should (equal args
-                                  '("a3" "a" "bcd")))
+                                  '("a3" "aa" "bcd")))
                    (cons "a" "bc"))
                   (candidates
                    '("a3")))))
          (company-backend (list one tri))
+         (company-point (point))
          (candidates (company-call-backend 'candidates "a" "")))
     (should
-     (equal '("a" "")
+     (equal '("aa" "bcd" 2)
             (company-call-backend 'prefix)))
     (should
      (equal (cons "a" "bc")
             (company-call-backend 'adjust-boundaries
                                   (car (member "a3" candidates))
-                                  "a" "")))))
+                                  "aa" "bcd")))
+    (should
+     (equal (cons "a" "")
+            (company-call-backend 'adjust-boundaries
+                                  (car (member "a1b" candidates))
+                                  "aa" "bcd")))))
+
+(ert-deftest company-multi-backend-combines-expand-common ()
+  (let* ((one (lambda (command &rest _args)
+                (cl-case command
+                  (prefix '("a" ""))
+                  (expand-common (cons "ab" "")))))
+         (two (lambda (command &rest _args)
+                (cl-case command
+                  (prefix '("aa" "bcd"))
+                  (expand-common (cons "aab" "bcd")))))
+         (tri (lambda (command &rest _args)
+                (cl-case command
+                  (prefix '("aa" "bcd"))
+                  (expand-common 'no-match))))
+         (company-backend (list one two tri))
+         (company-point (point)))
+    (company-call-backend 'set-min-prefix 1)
+    (should
+     (equal '("aab" . "bcd")
+            (company-call-backend 'expand-common "aa" "bcd")))))
+
+(ert-deftest company-multi-backend-expand-common-returns-no-match ()
+  (let* ((one (lambda (command &rest _args)
+                (cl-case command
+                  (prefix '("a" ""))
+                  (expand-common 'no-match))))
+         (two (lambda (command &rest _args)
+                (cl-case command
+                  (prefix '("aa" "bcd"))
+                  (expand-common 'no-match))))
+         (company-backend (list one two))
+         (company-point (point)))
+    (company-call-backend 'set-min-prefix 1)
+    (should
+     (equal 'no-match
+            (company-call-backend 'expand-common "aa" "bcd")))))
+
+(ert-deftest company-multi-backend-expand-common-keeps-current ()
+  (let* ((one (lambda (command &rest _args)
+                (cl-case command
+                  (prefix '("a" ""))
+                  (expand-common (cons "ab" "")))))
+         (two (lambda (command &rest _args)
+                (cl-case command
+                  (prefix '("a" ""))
+                  (expand-common (cons "ac" "")))))
+         (company-backend (list one two))
+         (company-point (point)))
+    (company-call-backend 'set-min-prefix 1)
+    (should
+     (equal '("a" . "")
+            (company-call-backend 'expand-common "a" "")))))
 
 (ert-deftest company-begin-backend-failure-doesnt-break-company-backends ()
   (with-temp-buffer