master 6c4d767019: Fix navigation in the *Completions* buffer and enable more tests (bug#54374)

[Juri Linkov]

branch: master
commit 6c4d767019c69e0c3a6b464a5856eb7655022e38
Author: Juri Linkov <juri@linkov.net>
Commit: Juri Linkov <juri@linkov.net>

    Fix navigation in the *Completions* buffer and enable more tests (bug#54374)
    
    * lisp/ido.el: Use first-completion instead of next-completion.
    
    * lisp/minibuffer.el (completion--insert): Put completion--string
    text property on prefix and suffix as well.
    
    * lisp/simple.el (first-completion, last-completion): New commands.
    (next-completion): Rewrite to fix many bugs reported in
    bug#54374, bug#55289, bug#55430.
    (choose-completion): Use the text property completion--string that
    allows to select a completion when point is on its prefix or suffix.
    (switch-to-completions): Use first-completion instead of next-completion,
    and last-completion instead of previous-completion.
    
    * test/lisp/minibuffer-tests.el (completion-auto-select-test)
    (completion-auto-wrap-test, completions-header-format-test)
    (completions-affixation-navigation-test): Uncomment fixed lines.
---
 lisp/ido.el                   |   2 +-
 lisp/minibuffer.el            |   4 +-
 lisp/simple.el                | 116 +++++++++++++++++++++++-------------------
 test/lisp/minibuffer-tests.el |  69 +++++++++++++++----------
 4 files changed, 108 insertions(+), 83 deletions(-)

diff --git a/lisp/ido.el b/lisp/ido.el
index e5717d6e53..73cd163d46 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -3939,7 +3939,7 @@ If `ido-change-word-sub' cannot be found in WORD, return 
nil."
       ;; In the new buffer, go to the first completion.
       ;; FIXME: Perhaps this should be done in `ido-completion-help'.
       (when (bobp)
-       (next-completion 1)))))
+       (first-completion)))))
 
 (defun ido-completion-auto-help ()
   "Call `ido-completion-help' if `completion-auto-help' is non-nil."
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 6694340e02..6ae25b8def 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2074,11 +2074,11 @@ Runs of equal candidate strings are eliminated.  
GROUP-FUN is a
       (when prefix
         (let ((beg (point))
               (end (progn (insert prefix) (point))))
-          (put-text-property beg end 'mouse-face nil)))
+          (add-text-properties beg end `(mouse-face nil completion--string 
,(car str)))))
       (completion--insert (car str) group-fun)
       (let ((beg (point))
             (end (progn (insert suffix) (point))))
-        (put-text-property beg end 'mouse-face nil)
+        (add-text-properties beg end `(mouse-face nil completion--string ,(car 
str)))
         ;; Put the predefined face only when suffix
         ;; is added via annotation-function without prefix,
         ;; and when the caller doesn't use own face.
diff --git a/lisp/simple.el b/lisp/simple.el
index 420718869a..db52d83cea 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -9521,6 +9521,24 @@ the completions is popped up and down."
   :version "29.1"
   :group 'completion)
 
+(defun first-completion ()
+  "Move to the first item in the completion list."
+  (interactive)
+  (goto-char (point-min))
+  (unless (get-text-property (point) 'mouse-face)
+    (when-let ((pos (next-single-property-change (point) 'mouse-face)))
+      (goto-char pos))))
+
+(defun last-completion ()
+  "Move to the last item in the completion list."
+  (interactive)
+  (goto-char (previous-single-property-change
+              (point-max) 'mouse-face nil (point-min)))
+  ;; Move to the start of last one.
+  (unless (get-text-property (point) 'mouse-face)
+    (when-let ((pos (previous-single-property-change (point) 'mouse-face)))
+      (goto-char pos))))
+
 (defun previous-completion (n)
   "Move to the previous item in the completion list.
 With prefix argument N, move back N items (negative N means move
@@ -9537,60 +9555,51 @@ backward).
 
 Also see the `completion-wrap-movement' variable."
   (interactive "p")
-  (let ((prev (previous-single-property-change (point) 'mouse-face)))
-    (goto-char (cond
-                ((not prev)
-                 (1- (next-single-property-change (point) 'mouse-face)))
-                ((/= prev (point))
-                 (point))
-                (t prev))))
-
-  (let ((beg (point-min))
-        (end (point-max))
-        (tabcommand (member (this-command-keys) '("\t" [backtab])))
-        prop)
+  (let ((tabcommand (member (this-command-keys) '("\t" [backtab])))
+        pos)
     (catch 'bound
       (while (> n 0)
+        (setq pos (point))
         ;; If in a completion, move to the end of it.
-        (when (get-text-property (point) 'mouse-face)
-          (goto-char (next-single-property-change (point) 'mouse-face nil 
end)))
-        ;; If at the last completion option, wrap or skip to the
-        ;; minibuffer, if requested. We can't use (eobp) because some
-        ;; extra text may be after the last candidate: ex: when
-        ;; completion-detailed
-        (setq prop (next-single-property-change (point) 'mouse-face nil end))
-        (when (and completion-wrap-movement (eq end prop))
-          (if (and completion-auto-select tabcommand)
-              (throw 'bound nil)
-            (goto-char (point-min))))
-        ;; Move to start of next one.
-        (unless (get-text-property (point) 'mouse-face)
-          (goto-char (next-single-property-change (point) 'mouse-face nil 
end)))
+        (when (get-text-property pos 'mouse-face)
+          (setq pos (next-single-property-change pos 'mouse-face)))
+        (when pos (setq pos (next-single-property-change pos 'mouse-face)))
+        (if pos
+            ;; Move to the start of next one.
+            (goto-char pos)
+          ;; If at the last completion option, wrap or skip
+          ;; to the minibuffer, if requested.
+          (when completion-wrap-movement
+            (if (and (eq completion-auto-select t) tabcommand)
+                (throw 'bound nil)
+              (first-completion))))
         (setq n (1- n)))
 
-      (while (and (< n 0) (not (bobp)))
-        (setq prop (get-text-property (1- (point)) 'mouse-face))
+      (while (< n 0)
+        (setq pos (point))
         ;; If in a completion, move to the start of it.
-        (when (and prop (eq prop (get-text-property (point) 'mouse-face)))
-          (goto-char (previous-single-property-change
-                      (point) 'mouse-face nil beg)))
-        ;; Move to end of the previous completion.
-        (unless (or (bobp) (get-text-property (1- (point)) 'mouse-face))
-          (goto-char (previous-single-property-change
-                      (point) 'mouse-face nil beg)))
-        ;; If at the first completion option, wrap or skip to the
-        ;; minibuffer, if requested.
-        (setq prop (previous-single-property-change (point) 'mouse-face nil 
beg))
-        (when (and completion-wrap-movement (eq beg prop))
-          (if (and completion-auto-select tabcommand)
-              (progn
-                (goto-char (next-single-property-change (point) 'mouse-face 
nil end))
-                (throw 'bound nil))
-            (goto-char (point-max))))
-        ;; Move to the start of that one.
-        (goto-char (previous-single-property-change
-                    (point) 'mouse-face nil beg))
+        (when (and (get-text-property pos 'mouse-face)
+                   (not (bobp))
+                   (get-text-property (1- pos) 'mouse-face))
+          (setq pos (previous-single-property-change pos 'mouse-face)))
+        (when pos (setq pos (previous-single-property-change pos 'mouse-face)))
+        (if pos
+            (progn
+              (goto-char pos)
+              ;; Move to the start of that one.
+              (unless (get-text-property (point) 'mouse-face)
+                (goto-char (previous-single-property-change
+                            (point) 'mouse-face nil (point-min)))))
+          ;; If at the first completion option, wrap or skip
+          ;; to the minibuffer, if requested.
+          (when completion-wrap-movement
+            (if (and (eq completion-auto-select t) tabcommand)
+                (progn
+                  ;; (goto-char (next-single-property-change (point) 
'mouse-face))
+                  (throw 'bound nil))
+              (last-completion))))
         (setq n (1+ n))))
+
     (when (/= 0 n)
       (switch-to-minibuffer))))
 
@@ -9618,13 +9627,16 @@ minibuffer, but don't quit the completions window."
              (goto-char (posn-point (event-start event)))
              (let (beg)
                (cond
-                ((and (not (eobp)) (get-text-property (point) 'mouse-face))
+                ((and (not (eobp))
+                      (get-text-property (point) 'completion--string))
                  (setq beg (1+ (point))))
                 ((and (not (bobp))
-                      (get-text-property (1- (point)) 'mouse-face))
+                      (get-text-property (1- (point)) 'completion--string))
                  (setq beg (point)))
                 (t (error "No completion here")))
-               (setq beg (previous-single-property-change beg 'mouse-face))
+               (setq beg (or (previous-single-property-change
+                              beg 'completion--string)
+                             beg))
                (substring-no-properties
                 (get-text-property beg 'completion--string))))))
 
@@ -9830,8 +9842,8 @@ select the completion near point.\n\n")))))
        ((and (memq this-command '(completion-at-point minibuffer-complete))
              (equal (this-command-keys) [backtab]))
         (goto-char (point-max))
-        (previous-completion 1))
-       (t (next-completion 1))))))
+        (last-completion))
+       (t (first-completion))))))
 
 (defun read-expression-switch-to-completions ()
   "Select the completion list window while reading an expression."
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 9111b5f4a8..56db00a124 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -365,6 +365,12 @@
     (completing-read-with-minibuffer-setup
         '("aa" "ab" "ac")
       (execute-kbd-macro (kbd "a TAB"))
+      (should (and (get-buffer-window "*Completions*" 0)
+                   (eq (current-buffer) (get-buffer "*Completions*"))))
+      (execute-kbd-macro (kbd "TAB TAB TAB"))
+      (should (and (get-buffer-window "*Completions*" 0)
+                   (eq (current-buffer) (get-buffer " *Minibuf-1*"))))
+      (execute-kbd-macro (kbd "S-TAB"))
       (should (and (get-buffer-window "*Completions*" 0)
                    (eq (current-buffer) (get-buffer "*Completions*"))))))
   (let ((completion-auto-select 'second-tab))
@@ -386,11 +392,11 @@
       (should (equal "aa" (get-text-property (point) 'completion--string)))
       (next-completion 2)
       (should (equal "ac" (get-text-property (point) 'completion--string)))
-      ;; FIXME: bug#54374
-      ;; (next-completion 1)
-      ;; (should (equal "ac" (get-text-property (point) 'completion--string)))
-      (previous-completion 1)
-      (should (equal "ab" (get-text-property (point) 'completion--string)))))
+      ;; Fixed in bug#54374
+      (next-completion 5)
+      (should (equal "ac" (get-text-property (point) 'completion--string)))
+      (previous-completion 5)
+      (should (equal "aa" (get-text-property (point) 'completion--string)))))
   (let ((completion-wrap-movement t))
     (completing-read-with-minibuffer-setup
         '("aa" "ab" "ac")
@@ -406,30 +412,32 @@
       (should (equal "ac" (get-text-property (point) 'completion--string))))))
 
 (ert-deftest completions-header-format-test ()
-  (let ((completions-header-format nil)
-        (completion-show-help nil))
+  (let ((completion-show-help nil)
+        (completions-header-format nil))
     (completing-read-with-minibuffer-setup
         '("aa" "ab" "ac")
       (insert "a")
       (minibuffer-completion-help)
       (switch-to-completions)
-      ;; FIXME: bug#55430
-      ;; (should (equal "aa" (get-text-property (point) 'completion--string)))
-      ;; FIXME: bug#54374
-      ;; (previous-completion 1)
-      ;; (should (equal "ac" (get-text-property (point) 'completion--string)))
-      ;; (next-completion 1)
-      ;; (should (equal "aa" (get-text-property (point) 'completion--string)))
-      ;; FIXME: bug#55430
-      ;; (choose-completion nil t)
-      ;; (should (equal (minibuffer-contents) "aa"))
-      )
+      ;; Fixed in bug#55430
+      (should (equal "aa" (get-text-property (point) 'completion--string)))
+      (next-completion 2)
+      (should (equal "ac" (get-text-property (point) 'completion--string)))
+      (previous-completion 2)
+      (should (equal "aa" (get-text-property (point) 'completion--string)))
+      ;; Fixed in bug#54374
+      (previous-completion 1)
+      (should (equal "ac" (get-text-property (point) 'completion--string)))
+      (next-completion 1)
+      (should (equal "aa" (get-text-property (point) 'completion--string)))
+      ;; Fixed in bug#55430
+      (execute-kbd-macro (kbd "C-u RET"))
+      (should (equal (minibuffer-contents) "aa")))
     (completing-read-with-minibuffer-setup
         '("aa" "ab" "ac")
-      ;; FIXME: bug#55289
-      ;; (execute-kbd-macro (kbd "a M-<up> M-<down>"))
-      ;; (should (equal (minibuffer-contents) "aa"))
-      )))
+      ;; Fixed in bug#55289
+      (execute-kbd-macro (kbd "a M-<up> M-<down>"))
+      (should (equal (minibuffer-contents) "aa")))))
 
 (ert-deftest completions-affixation-navigation-test ()
   (let ((completion-extra-properties
@@ -445,14 +453,19 @@
       (switch-to-completions)
       (should (equal 'highlight (get-text-property (point) 'mouse-face)))
       (should (equal "aa" (get-text-property (point) 'completion--string)))
-      (next-completion 1)
+      (let ((completion-wrap-movement t))
+        (next-completion 3))
+      (should (equal 'highlight (get-text-property (point) 'mouse-face)))
+      (should (equal "aa" (get-text-property (point) 'completion--string)))
+      (let ((completion-wrap-movement nil))
+        (next-completion 3))
       (should (equal 'highlight (get-text-property (point) 'mouse-face)))
-      (should (equal "ab" (get-text-property (point) 'completion--string)))
+      (should (equal "ac" (get-text-property (point) 'completion--string)))
+      ;; Fixed in bug#54374
       (goto-char (1- (point-max)))
-      ;; FIXME: bug#54374
-      ;; (choose-completion nil t)
-      ;; (should (equal (minibuffer-contents) "ac"))
-      )))
+      (should-not (equal 'highlight (get-text-property (point) 'mouse-face)))
+      (execute-kbd-macro (kbd "C-u RET"))
+      (should (equal (minibuffer-contents) "ac")))))
 
 (provide 'minibuffer-tests)
 ;;; minibuffer-tests.el ends here