Subject: Re: bug#77718: 31.0.50; completion styles substring and flex are broken

From: Stephen Berman <[email-masked]>
Date: Mon, 30 Jun 2025 14:44:49 +0200

On Tue, 24 Jun 2025 16:00:51 -0400 Stefan Monnier <[email-masked]> wrote:

> BTW, if we want to fix the problem with a user-config, there is one part
> that would make sense to be user-configurable, which is whether
> `substring` completion should try and complete suffixes at all:
> Depending on your habits and typing style, having a suffix inserted
> after point can be a hindrance rather than a help because it can be
> easier for you to type that suffix than to skip over it.
> The "right" way to make this configurable (IMO) would be to have a new
> completion style that's like `substring` but without the insertion of
> common suffixes.
> [ In my ideal UI, completion styles would not be limited to symbols, so
>   you could have `(substring nil)` and `(substring t)` be the two
>   alternatives, where `substring` would be a style that takes an
>   (optional) `inhibit-common-suffixes` arg.  ]

Building on my previous patch, I've implemented a new style (but not
your ideal UI...) called, for want of a better shortish name,
`substring-emacs30'.  You can see the difference between the current
substring style and the new style by hitting TAB twice after each of the
inputs "C-x f //" and "C-x f //us" when you start emacs as follows:

For the current substring style:

emacs -Q --eval "(custom-set-variables '(completion-category-overrides '((file (styles substring)))))"

For the proposed new style:

emacs -Q --eval "(custom-set-variables '(completion-category-overrides '((file (styles substring-emacs30)))))"

I expect you'll consider the implementation an ugly hack, but it does
seem to yield the results I want, and with my limited understanding of
the completion code, I couldn't think of anything better; but no doubt
you or someone else who knows the code well can.  The patch is attached.

Steve Berman

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 122459be062..d469482b518 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1119,6 +1119,10 @@ completion-styles-alist
 I.e. when completing \"foo_bar\" (where _ is the position of point),
 it will consider all completions candidates matching the glob
 pattern \"*foo*bar*\".")
+    (substring-emacs30
+     completion-substring-emacs30-try-completion
+     completion-substring-all-completions
+     "Like `substring' style but without insertion of common suffixes.")
     (flex
      completion-flex-try-completion completion-flex-all-completions
      "Completion of an in-order subset of characters.
@@ -4516,7 +4520,8 @@ completion--common-suffix
   "Return the common suffix of the strings STRS."
   (nreverse (try-completion "" (mapcar #'reverse strs))))
 
-(defun completion-pcm--merge-completions (strs pattern)
+(defun completion-pcm--merge-completions (strs pattern
+                                               &optional no-common-suffix)
   "Extract the commonality in STRS, with the help of PATTERN.
 PATTERN can contain strings and symbols chosen among `star', `any', `point',
 and `prefix'.  They all match anything (aka \".*\") but are merged differently:
@@ -4603,26 +4608,40 @@ completion-pcm--merge-completions
                   (when (seq-some (lambda (elem) (eq elem 'prefix)) wildcards)
                     (setq prefix fixed))
                   (push prefix res)
-                  ;; Push all the wildcards in this stretch, to preserve `point' and
-                  ;; `star' wildcards before ELEM.
+                  ;; Push all the wildcards in this stretch, to preserve
+                  ;; `point' and `star' wildcards before ELEM.
                   (setq res (append wildcards res))
                   ;; Extract common suffix additionally to common prefix.
                   ;; Don't do it for `any' since it could lead to a merged
                   ;; completion that doesn't itself match the candidates.
-                  (when (and (seq-some (lambda (elem) (memq elem '(star point prefix))) wildcards)
+                  (when (and (seq-some (lambda (elem)
+                                         (memq elem '(star point prefix)))
+                                       wildcards)
                              ;; If prefix is one of the completions, there's no
                              ;; suffix left to find.
                              (not (assoc-string prefix comps t)))
-                    (let ((suffix
-                           (completion--common-suffix
-                            (if (zerop (length prefix)) comps
-                              ;; Ignore the chars in the common prefix, so we
-                              ;; don't merge '("abc" "abbc") as "ab*bc".
-                              (let ((skip (length prefix)))
-                                (mapcar (lambda (str) (substring str skip))
-                                        comps))))))
+                    (let* ((suffix
+                            (completion--common-suffix
+                             (if (zerop (length prefix)) comps
+                               ;; Ignore the chars in the common prefix, so we
+                               ;; don't merge '("abc" "abbc") as "ab*bc".
+                               (let ((skip (length prefix)))
+                                 (mapcar (lambda (str) (substring str skip))
+                                         comps)))))
+                           (prefres (when no-common-suffix
+                                      (completion-pcm--pattern->string
+                                       (reverse (cons prefix res)))))
+                           (bounds (when prefres
+                                     (completion-boundaries
+                                      prefres comps
+                                      minibuffer-completion-predicate suffix)))
+                           (sep (when bounds
+                                  (substring suffix (max 0 (1- (cdr bounds)))
+                                             (cdr bounds)))))
                       (cl-assert (stringp suffix))
-                      (unless (equal suffix "")
+                      (unless (if no-common-suffix
+                                  (and (equal prefres "") (equal suffix sep))
+                                (equal suffix ""))
                         (push suffix res))))
                   ;; We pushed these wildcards on RES, so we're done with them.
                   (setq wildcards nil))
@@ -4660,7 +4679,8 @@ completion-pcm--filename-try-filter
       (or (nreverse try) all))))

-(defun completion-pcm--merge-try (pattern all prefix suffix)
+(defun completion-pcm--merge-try (pattern all prefix suffix
+                                          &optional no-common-suffix)
   (cond
    ((not (consp all)) all)
    ((and (not (consp (cdr all)))        ;Only one completion.
@@ -4668,7 +4688,8 @@ completion-pcm--merge-try
          (equal (completion-pcm--pattern->string pattern) (car all)))
     t)
    (t
-    (let* ((mergedpat (completion-pcm--merge-completions all pattern))
+    (let* ((mergedpat (completion-pcm--merge-completions all pattern
+                                                         no-common-suffix))
            ;; `mergedpat' is in reverse order.  Place new point (by
            ;; order of preference) either at the old point, or at
            ;; the last place where there's something to choose, or
@@ -4737,6 +4758,14 @@ completion-substring-try-completion
         (setq all (completion-pcm--filename-try-filter all)))
     (completion-pcm--merge-try pattern all prefix suffix)))
 
+(defun completion-substring-emacs30-try-completion (string table pred point)
+  (pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds)
+               (completion-substring--all-completions
+                string table pred point)))
+    (if minibuffer-completing-file-name
+        (setq all (completion-pcm--filename-try-filter all)))
+    (completion-pcm--merge-try pattern all prefix suffix t)))
+
 (defun completion-substring-all-completions (string table pred point)
   (pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
                (completion-substring--all-completions