bug#70217: [PATCH] Add substring-partial-completion style

[Spencer Baugh <sbaugh@janestreet.com>]

[-- Attachment #1: Type: text/plain, Size: 1458 bytes --]

Tags: patch


The substring completion style completes "foo-bar" as "*foo-bar*".
The partial-completion completion style completes "foo-bar" as
"foo*bar*".

It is currently not possible to get completion as "*foo*bar*",
e.g. combining the two.

This patch adds a completion style that combines the two.  (It's a bit
rough right now, just a quick implementation, will clean it up with
feedback)

It's preferable for this to be a separate style from partial-completion
rather than a customization for partial-completion, because completing
with a leading glob is inefficient: it doesn't allow the completion
table to do any filtering at all.  So, for example, one might want the
regular partial-completion style to run first, and if it doesn't find
anything then the substring-partial-completion style can run.

Further claim: I think the substring completion style should be replaced
with the substring-partial-completion style in most places.  But that
may be a bit more controversial.

In GNU Emacs 29.2.50 (build 6, x86_64-pc-linux-gnu, X toolkit, cairo
 version 1.15.12, Xaw scroll bars) of 2024-03-25 built on
 igm-qws-u22796a
Repository revision: 5d867aca5ea016c07fe9e8b60f55345f83012333
Repository branch: emacs-29
Windowing system distributor 'The X.Org Foundation', version 11.0.12011000
System Description: Rocky Linux 8.9 (Green Obsidian)

Configured using:
 'configure -C --with-x-toolkit=lucid --with-native-compilation
 --with-gif=ifavailable'


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-substring-partial-completion-style.patch --]
[-- Type: text/patch, Size: 4926 bytes --]

From 6446dfddb240e206ae24d0a3124325121fd1ffe5 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh@janestreet.com>
Date: Fri, 5 Apr 2024 08:34:59 -0400
Subject: [PATCH] Add substring-partial-completion style

---
 lisp/minibuffer.el | 46 ++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 40 insertions(+), 6 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index a1df6f4c5ab..76de97e0ad9 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1061,6 +1061,14 @@ 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-partial-completion
+     completion-substring-pcm-try-completion completion-substring-pcm-all-completions
+     "A combination of the partial-completion and substring styles.
+This is like the partial-completion style, but it will also
+expand at the start of a completion string.
+I.e. when completing \"l-co_h\" (where _ is the position of point),
+it will consider all completions candidates matching the glob
+pattern \"*l*-co*h*\".")
     (flex
      completion-flex-try-completion completion-flex-all-completions
      "Completion of an in-order subset of characters.
@@ -3727,10 +3735,13 @@ completion-pcm--pattern-trivial-p
 	     (setq trivial nil)))
 	 trivial)))
 
-(defun completion-pcm--string->pattern (string &optional point)
+(defun completion-pcm--string->pattern (string &optional point startglob)
   "Split STRING into a pattern.
 A pattern is a list where each element is either a string
-or a symbol, see `completion-pcm--merge-completions'."
+or a symbol, see `completion-pcm--merge-completions'.
+
+If STARTGLOB is non-nil, the pattern will start with the symbol
+`prefix' if it would otherwise start with a string."
   (if (and point (< point (length string)))
       (let ((prefix (substring string 0 point))
             (suffix (substring string point)))
@@ -3777,7 +3788,10 @@ completion-pcm--string->pattern
       (when (> (length string) p0)
         (if pending (push pending pattern))
         (push (substring string p0) pattern))
-      (nreverse pattern))))
+      (setq pattern (nreverse pattern))
+      (if (not (stringp (car pattern)))
+          pattern
+        (cons 'prefix pattern)))))
 
 (defun completion-pcm--optimize-pattern (p)
   ;; Remove empty strings in a separate phase since otherwise a ""
@@ -3976,11 +3990,12 @@ completion-pcm--hilit-commonality
    (t completions)))
 
 (defun completion-pcm--find-all-completions (string table pred point
-                                                    &optional filter)
+                                                    &optional filter startglob)
   "Find all completions for STRING at POINT in TABLE, satisfying PRED.
 POINT is a position inside STRING.
 FILTER is a function applied to the return value, that can be used, e.g. to
-filter out additional entries (because TABLE might not obey PRED)."
+filter out additional entries (because TABLE might not obey PRED).
+STARTGLOB controls whether there's a leading glob in the pattern."
   (unless filter (setq filter 'identity))
   (let* ((beforepoint (substring string 0 point))
          (afterpoint (substring string point))
@@ -3991,7 +4006,7 @@ completion-pcm--find-all-completions
     (setq string (substring string (car bounds) (+ point (cdr bounds))))
     (let* ((relpoint (- point (car bounds)))
            (pattern (completion-pcm--optimize-pattern
-                     (completion-pcm--string->pattern string relpoint)))
+                     (completion-pcm--string->pattern string relpoint startglob)))
            (all (condition-case-unless-debug err
                     (funcall filter
                              (completion-pcm--all-completions
@@ -4255,6 +4270,25 @@ completion-pcm-try-completion
                     'completion-pcm--filename-try-filter))))
     (completion-pcm--merge-try pattern all prefix suffix)))
 
+;; Substring-pcm completion
+;; A trivial copy of pcm completion, passing startglob=t
+
+(defun completion-substring-pcm-all-completions (string table pred point)
+  (pcase-let ((`(,pattern ,all ,prefix ,_suffix)
+               (completion-pcm--find-all-completions string table pred point nil t)))
+    (when all
+      (nconc (completion-pcm--hilit-commonality pattern all)
+             (length prefix)))))
+
+(defun completion-substring-pcm-try-completion (string table pred point)
+  (pcase-let ((`(,pattern ,all ,prefix ,suffix)
+               (completion-pcm--find-all-completions
+                string table pred point
+                (if minibuffer-completing-file-name
+                    'completion-pcm--filename-try-filter)
+                t)))
+    (completion-pcm--merge-try pattern all prefix suffix)))
+
 ;;; Substring completion
 ;; Mostly derived from the code of `basic' completion.
 
-- 
2.39.3