emacs-30 713069dd7a8 2/2: [Eglot] Stricter "expand common" behavior

[Dmitry Gutov]

branch: emacs-30
commit 713069dd7a87cff8388c25f1bc2c2c1b5217b1ca
Author: Dmitry Gutov <dmitry@gutov.dev>
Commit: Dmitry Gutov <dmitry@gutov.dev>

    [Eglot] Stricter "expand common" behavior
    
    * lisp/progmodes/eglot.el (eglot--dumb-tryc): Check that the
    expanded string matches every completion strictly (bug#72705).
    And in the fallback case, check whether the table matches the
    original prefix at all.  Return nil otherwise.
    
    * test/lisp/progmodes/eglot-tests.el
    (eglot-test-stop-completion-on-nonprefix)
    (eglot-test-try-completion-nomatch): Corresponding tests.
    
    * etc/EGLOT-NEWS: New entry.
---
 etc/EGLOT-NEWS                     |  6 ++++++
 lisp/progmodes/eglot.el            | 14 ++++++++++++--
 test/lisp/progmodes/eglot-tests.el | 30 ++++++++++++++++++++++++++++++
 3 files changed, 48 insertions(+), 2 deletions(-)

diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS
index ff9a53bd242..b39e52af8e4 100644
--- a/etc/EGLOT-NEWS
+++ b/etc/EGLOT-NEWS
@@ -36,6 +36,12 @@ documentation snippets.
 These affect mostly the "vanilla" frontend to completions (invoked with
 C-M-i).
 
+** More strict completion expansion (bug#72705).
+
+It ensures that "expand common" commands (such as C-M-i or TAB in
+third-party frontends) don't result in fewer completions than before
+they are called.
+
 ** Experimental support for Eglot-only subprojects (github#1337)
 
 Useful for complex projects with subprojects needing different language
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 6fc8e60f90f..844fc634be9 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -3149,8 +3149,18 @@ for which LSP on-type-formatting should be requested."
 (defun eglot--dumb-tryc (pat table pred point)
   (let ((probe (funcall table pat pred nil)))
     (cond ((eq probe t) t)
-          (probe (cons probe (length probe)))
-          (t (cons pat point)))))
+          (probe
+           (if (and (not (equal probe pat))
+                    (cl-every
+                     (lambda (s) (string-prefix-p probe s 
completion-ignore-case))
+                     (funcall table pat pred t)))
+               (cons probe (length probe))
+             (cons pat point)))
+          (t
+           ;; Match ignoring suffix: if there are any completions for
+           ;; the current prefix at least, keep the current input.
+           (and (funcall table (substring pat 0 point) pred t)
+                (cons pat point))))))
 
 (add-to-list 'completion-category-defaults '(eglot-capf (styles 
eglot--dumb-flex)))
 (add-to-list 'completion-styles-alist '(eglot--dumb-flex eglot--dumb-tryc 
eglot--dumb-allc))
diff --git a/test/lisp/progmodes/eglot-tests.el 
b/test/lisp/progmodes/eglot-tests.el
index 3b67045122f..e0168baee54 100644
--- a/test/lisp/progmodes/eglot-tests.el
+++ b/test/lisp/progmodes/eglot-tests.el
@@ -645,6 +645,36 @@ directory hierarchy."
         (forward-line -1)
         (should (looking-at "Complete, but not unique")))))))
 
+(ert-deftest eglot-test-stop-completion-on-nonprefix ()
+  "Test completion also resulting in 'Complete, but not unique'."
+  (skip-unless (executable-find "clangd"))
+  (eglot--with-fixture
+      `(("project" . (("coiso.c" .
+                       ,(concat "int foot; int footer; int fo_obar;"
+                                "int main() {foo")))))
+    (with-current-buffer
+        (eglot--find-file-noselect "project/coiso.c")
+      (eglot--wait-for-clangd)
+      (goto-char (point-max))
+      (completion-at-point)
+      (should (looking-back "foo")))))
+
+(ert-deftest eglot-test-try-completion-nomatch ()
+  "Test completion table with non-matching input, returning nil."
+  (skip-unless (executable-find "clangd"))
+  (eglot--with-fixture
+      `(("project" . (("coiso.c" .
+                       ,(concat "int main() {abc")))))
+    (with-current-buffer
+        (eglot--find-file-noselect "project/coiso.c")
+      (eglot--wait-for-clangd)
+      (goto-char (point-max))
+      (should
+       (null
+        (completion-try-completion
+         "abc"
+         (nth 2 (eglot-completion-at-point)) nil 3))))))
+
 (ert-deftest eglot-test-try-completion-inside-symbol ()
   "Test completion table inside symbol, with only prefix matching."
   (skip-unless (executable-find "clangd"))