Package: emacs;
Reported by: Spencer Baugh <sbaugh <at> janestreet.com>
Date: Fri, 5 Apr 2024 12:43:02 UTC
Severity: wishlist
Tags: patch
Done: Eli Zaretskii <eliz <at> gnu.org>
Bug is archived. No further changes may be made.
Message #23 received at 70217 <at> debbugs.gnu.org (full text, mbox):
From: Spencer Baugh <sbaugh <at> janestreet.com> To: Stefan Monnier <monnier <at> iro.umontreal.ca> Cc: 70217 <at> debbugs.gnu.org Subject: Re: bug#70217: [PATCH] Add substring-partial-completion style Date: Wed, 08 May 2024 12:46:32 -0400
[Message part 1 (text/plain, inline)]
Spencer Baugh <sbaugh <at> janestreet.com> writes: > But, also, I realized that I basically always want PCM for both the > substring and emacs22 completion styles. So what about having two > customizations, defaulting to nil? > > completion-substring-use-pcm > completion-emacs22-use-pcm Here is a patch implementing this approach for both substring and emacs22.
[0001-Support-using-partial-completion-in-emacs22-and-subs.patch (text/x-patch, inline)]
From 1a10582f1d41109a8a84451fe847fd0ab685cacb Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh <at> janestreet.com>
Date: Wed, 8 May 2024 12:45:19 -0400
Subject: [PATCH] Support using partial-completion in emacs22 and substring
styles
The partial-completion completion style is useful, and so are the
emacs22 and substring completion styles. Now they can be used at the
same time.
* lisp/minibuffer.el (completion-emacs22-use-pcm)
(completion-substring-use-pcm): Add. (bug#70217)
(completion-emacs22-try-completion)
(completion-emacs22-all-completions): Check completion-emacs22-use-pcm.
(completion-pcm--string->pattern, completion-pcm--find-all-completions)
(completion-pcm-all-completions, completion-pcm--merge-try)
(completion-pcm-try-completion): Add "startglob" optional argument and
pass through.
(completion-substring-try-completion)
(completion-substring-all-completions): Check
completion-substring-use-pcm and pass startglob=t.
---
lisp/minibuffer.el | 93 ++++++++++++++++++++++++++++++++--------------
1 file changed, 65 insertions(+), 28 deletions(-)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index ad6a0928cda..d80cd91320c 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3738,9 +3738,25 @@ completion-emacs21-all-completions
(length string)
(car (completion-boundaries string table pred ""))))
+(defcustom completion-emacs22-use-pcm nil
+ "If non-nil, the emacs22 completion style performs partial-completion.
+
+This means that in addition to ignoring the text after point
+during completion, the text before point is expanded following
+the partial-completion rules.")
+
(defun completion-emacs22-try-completion (string table pred point)
- (let ((suffix (substring string point))
- (completion (try-completion (substring string 0 point) table pred)))
+ (let* ((suffix (substring string point))
+ (prefix (substring string 0 point))
+ (completion
+ (if completion-emacs22-use-pcm
+ (let ((ret (completion-pcm-try-completion prefix table pred point)))
+ (if (consp ret)
+ ;; Ignore any changes to point; that would change
+ ;; what text we're ignoring
+ (car ret)
+ ret))
+ (try-completion prefix table pred))))
(cond
((eq completion t)
(if (equal "" suffix)
@@ -3765,10 +3781,12 @@ completion-emacs22-try-completion
(defun completion-emacs22-all-completions (string table pred point)
(let ((beforepoint (substring string 0 point)))
- (completion-hilit-commonality
- (all-completions beforepoint table pred)
- point
- (car (completion-boundaries beforepoint table pred "")))))
+ (if completion-emacs22-use-pcm
+ (completion-pcm-all-completions beforepoint table pred point)
+ (completion-hilit-commonality
+ (all-completions beforepoint table pred)
+ point
+ (car (completion-boundaries beforepoint table pred ""))))))
;;; Basic completion.
@@ -3875,10 +3893,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)))
@@ -3925,7 +3946,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))
+ (when (and startglob (stringp (car pattern)))
+ (push 'prefix pattern))
+ pattern)))
(defun completion-pcm--optimize-pattern (p)
;; Remove empty strings in a separate phase since otherwise a ""
@@ -4218,11 +4242,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))
@@ -4233,7 +4258,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
@@ -4311,9 +4336,9 @@ completion-pcm--find-all-completions
(signal (car firsterror) (cdr firsterror))
(list pattern all prefix suffix)))))
-(defun completion-pcm-all-completions (string table pred point)
+(defun completion-pcm-all-completions (string table pred point &optional startglob)
(pcase-let ((`(,pattern ,all ,prefix ,_suffix)
- (completion-pcm--find-all-completions string table pred point)))
+ (completion-pcm--find-all-completions string table pred point nil startglob)))
(when all
(nconc (completion-pcm--hilit-commonality pattern all)
(length prefix)))))
@@ -4489,17 +4514,25 @@ completion-pcm--merge-try
merged (max 0 (1- (length merged))) suffix))
(cons (concat prefix merged suffix) (+ newpos (length prefix)))))))
-(defun completion-pcm-try-completion (string table pred point)
+(defun completion-pcm-try-completion (string table pred point &optional startglob)
(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))))
+ 'completion-pcm--filename-try-filter)
+ startglob)))
(completion-pcm--merge-try pattern all prefix suffix)))
;;; Substring completion
;; Mostly derived from the code of `basic' completion.
+(defcustom completion-substring-use-pcm nil
+ "If non-nil, the substring completion style performs partial-completion.
+
+This means that in addition to expanding at the start of the
+completion region, all text will be expanded following the
+partial-completion rules.")
+
(defun completion-substring--all-completions
(string table pred point &optional transform-pattern-fn)
"Match the presumed substring STRING to the entries in TABLE.
@@ -4524,20 +4557,24 @@ completion-substring--all-completions
(list all pattern prefix suffix (car bounds))))
(defun completion-substring-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)))
+ (if completion-substring-use-pcm
+ (completion-pcm-try-completion string table pred point t)
+ (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))))
(defun completion-substring-all-completions (string table pred point)
- (pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
- (completion-substring--all-completions
- string table pred point)))
- (when all
- (nconc (completion-pcm--hilit-commonality pattern all)
- (length prefix)))))
+ (if completion-substring-use-pcm
+ (completion-pcm-all-completions string table pred point t)
+ (pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
+ (completion-substring--all-completions
+ string table pred point)))
+ (when all
+ (nconc (completion-pcm--hilit-commonality pattern all)
+ (length prefix))))))
;;; "flex" completion, also known as flx/fuzzy/scatter completion
;; Completes "foo" to "frodo" and "farfromsober"
--
2.39.3
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.