From 6c4d767019c69e0c3a6b464a5856eb7655022e38 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 27 May 2022 19:13:09 +0300 Subject: [PATCH] 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 e5717d6e53c..73cd163d465 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 6694340e021..6ae25b8def3 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 420718869a4..db52d83cea4 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 9111b5f4a83..56db00a124f 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- M-")) - ;; (should (equal (minibuffer-contents) "aa")) - ))) + ;; Fixed in bug#55289 + (execute-kbd-macro (kbd "a M- M-")) + (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 -- 2.39.2