bug#70968: 29.2.50; choose-completion on an emacs22-style completion deletes text after point

[Spencer Baugh via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

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

Eli Zaretskii <eliz@gnu.org> writes:
> I'm okay with adding a new style, per B, but why do we need to
> deprecate emacs22 at the same time?  Let users who want this new
> behavior customize their completion styles to use this new style
> instead of emacs22.  That'd be fully backward compatible, and will
> solve the problem for those who don't like the current behavior.

That's fair enough, we don't need to deprecate emacs22 at the same time,
we can wait until the new style has been battle-tested.

I think a new style should replace emacs22 in the default
completion-styles eventually, but that can wait.

And after working on this bug for a while, I now am convinced that the
new style approach is straightforward, and is the best way.  (Although
it would also work to make these changes in the emacs22 style)

Attached is a patch which adds a new ignore-after-point style.  The fix
for this bug is entirely contained in the differences between
completion-ignore-after-point-all-completions (c-iap-a-c) and
completion-emacs22-all-completions (c-e22-a-c).

c-e22-a-c always omits the text after point, which means
choose-completion always deletes that text, causing this bug.

c-iap-a-c includes the text after point in some cases.  Whenever the
text after point is included, it's grayed out with a new
completions-ignored face to indicate it was ignored.

The cases where c-iap-a-c includes the text after point are those where
the user will have further chances to edit or complete with that text:

- When we're doing minibuffer completion and choose-completion will
  immediately exit the minibuffer, the text after point is not included,
  since the user won't get any further changes to use it, and it's
  probably garbage.

- When we're doing completion-at-point (or certain kinds of minibuffer
  completion, e.g. completing a directory in filename completion), the
  text after point is included.  In such cases, the user can always
  delete it themselves later, or might want to actually use it.

To make this work consistently with completion-try-completion (which
keeps point before the ignored suffix in both the ignore-after-point and
emacs22 styles), choose-completion-string now checks a new
'completion-position-after-insert text property, and moves point to that
position.

(There are two other changes which are general improvements unrelated to
this bug:

- The behavior of keeping point before the ignored suffix is more
  consistent.

- Instead of hardcoding try-completion and all-completion,
  ignore-after-point uses the configured completion styles.)

Stefan, Dmitry, any comments?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-ignore-after-point-completion-style.patch --]
[-- Type: text/x-patch, Size: 12976 bytes --]

From cdc7ce4b9958a0ef36e911066ecce82a6da09c02 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh@janestreet.com>
Date: Mon, 16 Sep 2024 15:15:57 -0400
Subject: [PATCH] Add ignore-after-point completion style

* lisp/minibuffer.el (completion--twq-all): Use the original
completion faces where possible.
(completion-styles-alist, completion-ignore-after-point--force-nil)
(completions-ignored, completion-ignore-after-point-try-completion)
(completion-ignore-after-point-all-completions): Add
ignore-after-point completion style.  (bug#70968)
* lisp/simple.el (choose-completion-string--should-exit):
Add. (choose-completion-string): Call
choose-completion-string--should-exit.
---
 lisp/minibuffer.el | 142 ++++++++++++++++++++++++++++++++++++---------
 lisp/simple.el     |  47 +++++++++------
 2 files changed, 142 insertions(+), 47 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 72ee5d02002..e5d85ed6fc8 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -674,34 +674,42 @@ completion--twq-all
       ;; requote them, so that *Completions* can show nicer unquoted values
       ;; which only get quoted when needed by choose-completion.
       (nconc
-       (mapcar (lambda (completion)
-                 (cl-assert (string-prefix-p prefix completion 'ignore-case) t)
-                 (let* ((new (substring completion (length prefix)))
-                        (qnew (funcall qfun new))
- 			(qprefix
-                         (if (not completion-ignore-case)
-                             qprefix
-                           ;; Make qprefix inherit the case from `completion'.
-                           (let* ((rest (substring completion
-                                                   0 (length prefix)))
-                                  (qrest (funcall qfun rest)))
-                             (if (string-equal-ignore-case qprefix qrest)
-                                 (propertize qrest 'face
-                                             'completions-common-part)
-                               qprefix))))
-                        (qcompletion (concat qprefix qnew)))
-		   ;; FIXME: Similarly here, Cygwin's mapping trips this
-		   ;; assertion.
-                   ;;(cl-assert
-                   ;; (string-equal-ignore-case
-		   ;;  (funcall unquote
-		   ;;           (concat (substring string 0 qboundary)
-		   ;;                   qcompletion))
-		   ;;  (concat (substring ustring 0 boundary)
-		   ;;          completion))
-		   ;; t)
-                   qcompletion))
-               completions)
+       (mapcar
+        (if (string-equal qprefix prefix)
+            ;; There's no quoting in the prefix; quoting in the completions
+            ;; can be simpler and preserve the existing faces.
+            (lambda (completion)
+              (concat
+               (substring completion 0 (length prefix))
+               (funcall qfun (substring completion (length prefix)))))
+          (lambda (completion)
+            (cl-assert (string-prefix-p prefix completion 'ignore-case) t)
+            (let* ((new (substring completion (length prefix)))
+                   (qnew (funcall qfun new))
+                   (qprefix
+                    (if (not completion-ignore-case)
+                        qprefix
+                      ;; Make qprefix inherit the case from `completion'.
+                      (let* ((rest (substring completion
+                                              0 (length prefix)))
+                             (qrest (funcall qfun rest)))
+                        (if (string-equal-ignore-case qprefix qrest)
+                            (propertize qrest 'face
+                                        'completions-common-part)
+                          qprefix))))
+                   (qcompletion (concat qprefix qnew)))
+              ;; FIXME: Similarly here, Cygwin's mapping trips this
+              ;; assertion.
+              ;;(cl-assert
+              ;; (string-equal-ignore-case
+              ;;  (funcall unquote
+              ;;           (concat (substring string 0 qboundary)
+              ;;                   qcompletion))
+              ;;  (concat (substring ustring 0 boundary)
+              ;;          completion))
+              ;; t)
+              qcompletion)))
+        completions)
        qboundary))))
 
 ;;; Minibuffer completion
@@ -1038,6 +1046,12 @@ completion-styles-alist
      "Prefix completion that only operates on the text before point.
 I.e. when completing \"foo_bar\" (where _ is the position of point),
 it will consider all completions candidates matching the glob
+pattern \"foo*\" and will add back \"bar\" to the end of it.")
+    (ignore-after-point
+     completion-ignore-after-point-try-completion completion-ignore-after-point-all-completions
+     "Prefix completion that only operates on the text before point.
+I.e. when completing \"foo_bar\" (where _ is the position of point),
+it will consider all completions candidates matching the glob
 pattern \"foo*\" and will add back \"bar\" to the end of it.")
     (basic
      completion-basic-try-completion completion-basic-all-completions
@@ -3692,6 +3706,78 @@ completion-emacs22-all-completions
      point
      (car (completion-boundaries beforepoint table pred "")))))
 
+;;; ignore-after-point completion style.
+
+(defvar completion-ignore-after-point--force-nil nil
+  "When non-nil, the ignore-after-point style always returns nil.")
+
+(defface completions-ignored
+  '((t (:inherit shadow)))
+  "Face for text which was ignored by the completion style.")
+
+(defun completion-ignore-after-point-try-completion (string table pred point)
+  "Run `completion-try-completion' ignoring the part of STRING after POINT.
+
+We add the part of STRING after POINT back to the result."
+  (let ((prefix (substring string 0 point))
+        (suffix (substring string point)))
+    (when-let ((completion
+                (unless completion-ignore-after-point--force-nil
+                  (let ((completion-ignore-after-point--force-nil t))
+                    (completion-try-completion prefix table pred point)))))
+      ;; Add SUFFIX back to COMPLETION.  However, previous completion styles failed and
+      ;; this one succeeded by ignoring SUFFIX.  The success of future completion depends
+      ;; on ignoring SUFFIX.  We mostly do that by keeping point right before SUFFIX.
+      (if (eq completion t)
+          ;; Keep point in the same place, right before SUFFIX.
+          (cons string point)
+        (let ((newstring (car completion))
+              (newpoint (cdr completion)))
+          (cond
+           ((= (length newstring) newpoint)
+            ;; NEWPOINT is already right before SUFFIX.
+            (cons (concat newstring suffix) newpoint))
+           ((minibufferp completion-reference-buffer)
+            ;; Don't allow moving point, keep it right before SUFFIX.
+            (cons (concat newstring suffix) (length newstring)))
+           (t
+            ;; If we're not in a minibuffer, then we're using `completion-at-point', which
+            ;; calculates a completion region to complete over.  We can allow point to
+            ;; move and still cause SUFFIX to be omitted from the completion region, by
+            ;; including a space right before SUFFIX.
+            (cons (concat newstring
+                          ;; Don't add another space if SUFFIX already starts with one.
+                          (when (/= (aref suffix 0) ? ) " ") suffix)
+                  newpoint))))))))
+
+(defun completion-ignore-after-point-all-completions (string table pred point)
+  "Run `completion-all-completions' ignoring the part of STRING after POINT."
+  (let ((prefix (substring string 0 point))
+        (suffix (propertize (substring string point) 'face 'completions-ignored)))
+    (when-let ((completions
+                (unless completion-ignore-after-point--force-nil
+                  (let ((completion-ignore-after-point--force-nil t))
+                    (completion-all-completions prefix table pred point)))))
+      ;; Add SUFFIX back to each completion.  COMPLETIONS may be an improper list (with
+      ;; the base position in its last cdr) so we can't use `mapcar'.
+      (let ((tail completions))
+        (while (consp tail)
+          (let* ((completion (car tail))
+                 (choose-completion-will-exit
+                  (and (minibufferp completion-reference-buffer)
+                       (choose-completion-string--should-exit completion))))
+            ;; Include the suffix if, after `choose-completion' runs on COMPLETION, the
+            ;; user is still able to use and edit the suffix.
+            (unless choose-completion-will-exit
+              (let ((end-of-real-completion (length completion)))
+                (setcar tail (concat completion suffix))
+                ;; When chosen, point should go before SUFFIX.
+                (put-text-property
+                 0 1 'completion-position-after-insert end-of-real-completion
+                 (car tail)))))
+          (setq tail (cdr tail))))
+      completions)))
+
 ;;; Basic completion.
 
 (defun completion--merge-suffix (completion point suffix)
diff --git a/lisp/simple.el b/lisp/simple.el
index 1dd6bfe5b22..fe68f23c4da 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -10083,6 +10083,20 @@ choose-completion-string-functions
 If all functions in the list return nil, that means to use
 the default method of inserting the completion in BUFFER.")
 
+(defun choose-completion-string--should-exit (result)
+  "Should `choose-completion-string' exit the minibuffer if RESULT is chosen?"
+  (and
+   (not completion-no-auto-exit)
+   minibuffer-completion-table
+   ;; If this is reading a file name, and the file name chosen
+   ;; is a directory, don't exit the minibuffer.
+   (let ((bounds (completion-boundaries
+                  result minibuffer-completion-table
+                  minibuffer-completion-predicate "")))
+     ;; The completion chosen leads to a new set of completions
+     ;; (e.g. it's a directory): don't exit the minibuffer yet.
+     (not (eq (car bounds) (length result))))))
+
 (defun choose-completion-string (choice &optional
                                         buffer base-position insert-function)
   "Switch to BUFFER and insert the completion choice CHOICE.
@@ -10116,10 +10130,13 @@ choose-completion-string
         ;; comes from buffer-substring-no-properties.
         ;;(remove-text-properties 0 (length choice) '(mouse-face nil) choice)
 	;; Insert the completion into the buffer where it was requested.
-        (funcall (or insert-function completion-list-insert-choice-function)
-                 (or (car base-position) (point))
-                 (or (cadr base-position) (point))
-                 choice)
+        (let ((beg (or (car base-position) (point)))
+              (end (or (cadr base-position) (point))))
+          (funcall (or insert-function completion-list-insert-choice-function)
+                   beg end choice)
+          (unless (string-empty-p choice)
+            (when-let ((pos (get-text-property 0 'completion-position-after-insert choice)))
+              (goto-char (+ pos beg)))))
         ;; Update point in the window that BUFFER is showing in.
 	(let ((window (get-buffer-window buffer t)))
 	  (set-window-point window (point)))
@@ -10127,21 +10144,13 @@ choose-completion-string
 	(and (not completion-no-auto-exit)
              (minibufferp buffer)
 	     minibuffer-completion-table
-	     ;; If this is reading a file name, and the file name chosen
-	     ;; is a directory, don't exit the minibuffer.
-             (let* ((result (buffer-substring (field-beginning) (point)))
-                    (bounds
-                     (completion-boundaries result minibuffer-completion-table
-                                            minibuffer-completion-predicate
-                                            "")))
-               (if (eq (car bounds) (length result))
-                   ;; The completion chosen leads to a new set of completions
-                   ;; (e.g. it's a directory): don't exit the minibuffer yet.
-                   (let ((mini (active-minibuffer-window)))
-                     (select-window mini)
-                     (when minibuffer-auto-raise
-                       (raise-frame (window-frame mini))))
-                 (exit-minibuffer))))))))
+             (if (choose-completion-string--should-exit
+                  (buffer-substring (field-beginning) (point)))
+                 (exit-minibuffer)
+               (let ((mini (active-minibuffer-window)))
+                 (select-window mini)
+                 (when minibuffer-auto-raise
+                   (raise-frame (window-frame mini))))))))))
 
 (define-derived-mode completion-list-mode nil "Completion List"
   "Major mode for buffers showing lists of possible completions.
-- 
2.39.3