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.
This commit is contained in:
Juri Linkov
parent
4df20e2f14
commit
6c4d767019
4 changed files with 108 additions and 83 deletions
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
116
lisp/simple.el
116
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."
|
||||
|
|
|
|||
|
|
@ -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 "ab" (get-text-property (point) 'completion--string)))
|
||||
(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 "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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue