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

[Dmitry Gutov <dmitry@gutov.dev>]

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

On 24/09/2024 03:03, Dmitry Gutov wrote:
> 
> The attached patch does not make a distinction for file name completion 
> - it just covers the core problem - but I think any UI could use the 
> addition and likewise lookup the 'file' category, and print the "hidden" 
> suffix in the Completions, and decide to drop the suffix in your first 
> scenario (file name completion with exit imminent).

Here's a halfway PoC of the UI printing the suffix based on the metadata 
property with emacs22 (without special behavior for files yet, but it 
should be straightforward to add the same set of conditions - the 
category, completion boundaries, etc).

[-- Attachment #2: completion--emacs22-adjust-metadata-with-shadow-suffix.diff --]
[-- Type: text/x-patch, Size: 4241 bytes --]

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 804afe9cb43..595fdcd2288 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2568,6 +2568,10 @@ completions--after-change
       (with-selected-window window
         (completions--deselect)))))
 
+(defface completions-ignored
+  '((t (:inherit shadow)))
+  "Face for text which was ignored by the completion style.")
+
 (defun minibuffer-completion-help (&optional start end)
   "Display a list of possible completions of the current minibuffer contents."
   (interactive)
@@ -2613,7 +2617,6 @@ minibuffer-completion-help
                                              (buffer-substring (point) end))))
                 (point)))
              (field-char (and (< field-end end) (char-after field-end)))
-             (base-position (list (+ start base-size) field-end))
              (all-md (completion--metadata (buffer-substring-no-properties
                                             start (point))
                                            base-size md
@@ -2623,6 +2626,13 @@ minibuffer-completion-help
              (aff-fun (completion-metadata-get all-md 'affixation-function))
              (sort-fun (completion-metadata-get all-md 'display-sort-function))
              (group-fun (completion-metadata-get all-md 'group-function))
+             (ignore-after-point (completion-metadata-get
+                                  all-md 'completion-ignore-after-point))
+             (base-position (list (+ start base-size)
+                                  (if ignore-after-point
+                                      (point)
+                                    field-end)))
+             (ignore-suffix (completion-metadata-get all-md 'completion-ignore-after-point))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
@@ -2668,6 +2678,14 @@ minibuffer-completion-help
                                             ('historical (minibuffer-sort-by-history completions))
                                             (_ (funcall completions-sort completions)))))
 
+                      (when ignore-suffix
+                        (let ((hidden-suffix (propertize (buffer-substring (point) end)
+                                                         'face
+                                                         'completions-ignored)))
+                          (setq completions
+                                (mapcar (lambda (s) (concat s hidden-suffix))
+                                        completions))))
+
                       ;; After sorting, group the candidates using the
                       ;; `group-function'.
                       (when group-fun
@@ -3778,6 +3796,13 @@ completion-emacs22-all-completions
      point
      (car (completion-boundaries beforepoint table pred "")))))
 
+(put 'emacs22 'completion--adjust-metadata 'completion--emacs22-adjust-metadata)
+
+(defun completion--emacs22-adjust-metadata (metadata)
+  `(metadata
+    (completion-ignore-after-point . t)
+    ,@(cdr metadata)))
+
 ;;; Basic completion.
 
 (defun completion--merge-suffix (completion point suffix)
diff --git a/lisp/simple.el b/lisp/simple.el
index e35cfe0479b..a495231c211 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -10264,6 +10264,7 @@ choose-completion
           (base-position completion-base-position)
           (insert-function completion-list-insert-choice-function)
           (completion-no-auto-exit (if no-exit t completion-no-auto-exit))
+          (ignore-face nil)
           (choice
            (if choose-completion-deselect-if-after
                (or (get-text-property (posn-point (event-start event))
@@ -10285,6 +10286,10 @@ choose-completion
                              beg))
                (get-text-property beg 'completion--string))))))
 
+      (when (get-text-property (1- (length choice)) 'face choice)
+        (setq ignore-face (previous-single-property-change (1- (length choice)) 'face choice))
+        (setq choice (substring choice 0 ignore-face)))
+
       (unless (buffer-live-p buffer)
         (error "Destination buffer is dead"))
       (unless no-quit