From 6eafdd855948e0e39fcb33fba97c5a2788ac1b07 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 9 Nov 2023 18:20:14 +0200 Subject: [PATCH] Improve 'next-line-completion' and add more tests * lisp/simple.el (next-line-completion): Improve (bug#59486). Better handle the case when completion-auto-wrap is nil. * test/lisp/minibuffer-tests.el (completion-auto-wrap-test) (completions-header-format-test) (completions-affixation-navigation-test): Add calls to 'next-line-completion' and 'previous-line-completion'. (completions-group-navigation-test): New test. --- lisp/simple.el | 44 +++++++++-------- test/lisp/minibuffer-tests.el | 90 +++++++++++++++++++++++++++++++++++ 2 files changed, 114 insertions(+), 20 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 266a66500cb..f86b3f9e208 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10051,18 +10051,20 @@ Also see the `completion-auto-wrap' variable." (eq (move-to-column column) column)) (when (get-text-property (point) 'mouse-face) (setq found t))) - (when (and (not found) completion-auto-wrap) - (save-excursion - (goto-char (point-min)) - (when (and (eq (move-to-column column) column) - (get-text-property (point) 'mouse-face)) - (setq pos (point))) - (while (and (not pos) (> line (line-number-at-pos))) - (forward-line 1) + (when (not found) + (if (not completion-auto-wrap) + (last-completion) + (save-excursion + (goto-char (point-min)) (when (and (eq (move-to-column column) column) (get-text-property (point) 'mouse-face)) - (setq pos (point))))) - (if pos (goto-char pos))) + (setq pos (point))) + (while (and (not pos) (> line (line-number-at-pos))) + (forward-line 1) + (when (and (eq (move-to-column column) column) + (get-text-property (point) 'mouse-face)) + (setq pos (point))))) + (if pos (goto-char pos)))) (setq n (1- n))) (while (< n 0) @@ -10072,18 +10074,20 @@ Also see the `completion-auto-wrap' variable." (eq (move-to-column column) column)) (when (get-text-property (point) 'mouse-face) (setq found t))) - (when (and (not found) completion-auto-wrap) - (save-excursion - (goto-char (point-max)) - (when (and (eq (move-to-column column) column) - (get-text-property (point) 'mouse-face)) - (setq pos (point))) - (while (and (not pos) (< line (line-number-at-pos))) - (forward-line -1) + (when (not found) + (if (not completion-auto-wrap) + (first-completion) + (save-excursion + (goto-char (point-max)) (when (and (eq (move-to-column column) column) (get-text-property (point) 'mouse-face)) - (setq pos (point))))) - (if pos (goto-char pos))) + (setq pos (point))) + (while (and (not pos) (< line (line-number-at-pos))) + (forward-line -1) + (when (and (eq (move-to-column column) column) + (get-text-property (point) 'mouse-face)) + (setq pos (point))))) + (if pos (goto-char pos)))) (setq n (1+ n))))) (defun choose-completion (&optional event no-exit no-quit) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 4f92d7f841c..27d71805502 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -420,6 +420,21 @@ (next-completion 5) (should (equal "ac" (get-text-property (point) 'completion--string))) (previous-completion 5) + (should (equal "aa" (get-text-property (point) 'completion--string))) + + (first-completion) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (next-line-completion 2) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (next-line-completion 5) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (previous-line-completion 5) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (goto-char (point-min)) + (next-line-completion 5) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (goto-char (point-min)) + (previous-line-completion 5) (should (equal "aa" (get-text-property (point) 'completion--string))))) (let ((completion-auto-wrap t)) (completing-read-with-minibuffer-setup @@ -433,6 +448,21 @@ (next-completion 1) (should (equal "aa" (get-text-property (point) 'completion--string))) (previous-completion 1) + (should (equal "ac" (get-text-property (point) 'completion--string))) + + (first-completion) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (next-line-completion 2) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (next-line-completion 1) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (previous-line-completion 1) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (goto-char (point-min)) + (next-line-completion 4) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (goto-char (point-min)) + (previous-line-completion 4) (should (equal "ac" (get-text-property (point) 'completion--string)))))) (ert-deftest completions-header-format-test () @@ -454,6 +484,16 @@ (should (equal "ac" (get-text-property (point) 'completion--string))) (next-completion 1) (should (equal "aa" (get-text-property (point) 'completion--string))) + + (next-line-completion 2) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (previous-line-completion 2) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (previous-line-completion 1) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (next-line-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"))) @@ -488,8 +528,58 @@ ;; Fixed in bug#54374 (goto-char (1- (point-max))) (should-not (equal 'highlight (get-text-property (point) 'mouse-face))) + + (first-completion) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (let ((completion-auto-wrap t)) + (next-line-completion 3)) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (let ((completion-auto-wrap nil)) + (next-line-completion 3)) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (execute-kbd-macro (kbd "C-u RET")) (should (equal (minibuffer-contents) "ac"))))) +(ert-deftest completions-group-navigation-test () + (completing-read-with-minibuffer-setup + (lambda (string pred action) + (if (eq action 'metadata) + `(metadata + (group-function + . ,(lambda (name transform) + (if transform + name + (pcase name + (`"aa" "Group 1") + (`"ab" "Group 2") + (`"ac" "Group 3"))))) + (category . unicode-name)) + (complete-with-action action '("aa" "ab" "ac") string pred))) + (insert "a") + (minibuffer-completion-help) + (switch-to-completions) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (let ((completion-auto-wrap t)) + (next-completion 3)) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (let ((completion-auto-wrap nil)) + (next-completion 3)) + (should (equal "ac" (get-text-property (point) 'completion--string))) + + (first-completion) + (let ((completion-auto-wrap t)) + (next-line-completion 1) + (should (equal "ab" (get-text-property (point) 'completion--string))) + (next-line-completion 2) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (previous-line-completion 2) + (should (equal "ab" (get-text-property (point) 'completion--string)))) + (let ((completion-auto-wrap nil)) + (next-line-completion 3) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (previous-line-completion 3) + (should (equal "aa" (get-text-property (point) 'completion--string)))))) + (provide 'minibuffer-tests) ;;; minibuffer-tests.el ends here -- 2.39.2