From 9e37c94079c7db1543dbae00415165841c10359a Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 7 Jun 2026 21:56:47 +0300 Subject: [PATCH] Read a key sequence instead of a single key in 'map-y-or-n-p' This is necessary to correctly read keys like 'M-~' used by 'save-some-buffers' that is two keys 'ESC ~' on a tty. * doc/lispref/minibuf.texi (Multiple Queries): Index 'y-or-n-p-use-read-key' for 'map-y-or-n-p'. Mention using a key sequence instead of single keys. * lisp/emacs-lisp/map-ynp.el (map-y-or-n-p): In the 'y-or-n-p-use-read-key' cond-branch, use 'read-key-sequence-vector' instead of 'read-key'. In the default cond-branch, use 'this-command-keys-vector' instead of 'last-command-event'. In both cond-branches use 'key-description' instead of 'single-key-description' (bug#81168). Instead of '(eq def nil)' check if chars are either nil or an empty vector in noninteractive mode (bug#67836). * test/lisp/emacs-lisp/map-ynp-tests.el (test-map-ynp-kmacro): Test separately nil/non-nil 'y-or-n-p-use-read-key'. (test-map-ynp-keys): New test for complete coverage of 'map-y-or-n-p'. --- doc/lispref/minibuf.texi | 6 +-- lisp/emacs-lisp/map-ynp.el | 47 ++++++++-------- test/lisp/emacs-lisp/map-ynp-tests.el | 78 ++++++++++++++++++++++++++- 3 files changed, 105 insertions(+), 26 deletions(-) diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 44cd74b7011..6b914da9a86 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -2380,12 +2380,12 @@ asking each question individually. This gives the user certain convenient facilities such as the ability to answer the whole series at once. -@vindex read-char-choice-use-read-key@r{, and} map-y-or-n-p +@vindex y-or-n-p-use-read-key@r{, and} map-y-or-n-p @defun map-y-or-n-p prompter actor list &optional help action-alist no-cursor-in-echo-area This function asks the user a series of questions, reading a single-character answer in the minibuffer for each one. However, if -@code{read-char-choice-use-read-key} is non-@code{nil} (@pxref{Reading -One Event}), it reads single keys from the echo area. +@code{y-or-n-p-use-read-key} is non-@code{nil} (@pxref{Key Sequence +Input}), it reads a key sequence from the echo area. The value of @var{list} specifies the objects to ask questions about. It should be either a list of objects or a generator function. If it diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 7522d465d61..d4191e3c8cb 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -105,7 +105,7 @@ function is used instead. The function's value is the number of actions taken." (let* ((actions 0) (msg (current-message)) - user-keys mouse-event map prompt char elt def + user-keys mouse-event map prompt chars elt def ;; Non-nil means we should use mouse menus to ask. use-menus delayed-switch-frame @@ -174,14 +174,15 @@ The function's value is the number of actions taken." 'quit))) (y-or-n-p-use-read-key ;; Prompt in the echo area using `read-key'. - (let ((cursor-in-echo-area (not no-cursor-in-echo-area))) - (message "%s" (substitute-command-keys - (format - (apply #'propertize - "%s(\\`y', \\`n', \\`!', \\`.', \\`q', %sor \\`%s') " - minibuffer-prompt-properties) - prompt user-keys - (help-key)))) + (let ((cursor-in-echo-area (not no-cursor-in-echo-area)) + (full-prompt + (substitute-command-keys + (format + (apply #'propertize + "%s(\\`y', \\`n', \\`!', \\`.', \\`q', %sor \\`%s') " + minibuffer-prompt-properties) + prompt user-keys + (help-key))))) (if minibuffer-auto-raise (raise-frame (window-frame (minibuffer-window)))) (unwind-protect @@ -196,8 +197,8 @@ The function's value is the number of actions taken." ;; Do NOT use read-event here. That ;; function does not consult ;; input-decode-map (bug#75886). - (setq char (read-key)) - (when (eq char ?\C-g) + (setq chars (read-key-sequence-vector full-prompt)) + (when (member chars '([?\C-g] [?\C-\[ ?\C-\[ ?\C-\[])) (signal 'quit nil))) (when (fboundp 'set-text-conversion-style) (set-text-conversion-style text-conversion-style))) @@ -207,10 +208,10 @@ The function's value is the number of actions taken." "%s(\\`y', \\`n', \\`!', \\`.', \\`q', %sor \\`%s') %s" prompt user-keys (help-key) - (if (equal char -1) + (if (equal chars [-1]) "[end-of-keyboard-macro]" - (single-key-description char)))))) - (setq def (lookup-key map (vector char)))) + (key-description chars)))))) + (setq def (and chars (lookup-key map chars)))) (t ;; Read from the minibuffer. (let* ((full-prompt @@ -224,7 +225,7 @@ The function's value is the number of actions taken." (cmd-char (lambda () (interactive) - (setq char last-command-event) + (setq chars (this-command-keys-vector)) (exit-minibuffer))) (cmd-help (lambda () @@ -250,8 +251,8 @@ The function's value is the number of actions taken." (read-from-minibuffer full-prompt nil remap nil (or y-or-n-p-history-variable t)) - (message "%s%s" full-prompt (single-key-description char))) - (setq def (lookup-key map (vector char))))) + (message "%s%s" full-prompt (key-description chars))) + (setq def (and chars (lookup-key map chars))))) (cond ((eq def 'exit) (setq next (lambda () nil))) ((eq def 'act) @@ -318,12 +319,16 @@ Type \\`SPC' or \\`y' to %s the current %s; (setq actions (1+ actions)) ;; Regurgitated; try again. (funcall try-again))) - ((and (consp char) - (eq (car char) 'switch-frame)) + ((eq chars '[switch-frame]) ;; switch-frame event. Put it off until we're done. - (setq delayed-switch-frame char) + (setq delayed-switch-frame chars) (funcall try-again)) - ((eq def nil) ;; Special case for bug#67836 + ((and noninteractive (member chars '(nil []))) + ;; Special case for kmacro in batch mode (bug#67836). + ;; When 'y-or-n-p-use-read-key' is non-nil, + ;; 'read-key-sequence-vector' returns []. + ;; When 'y-or-n-p-use-read-key' is nil, + ;; 'chars' is nil. (error "Can't use in a kmacro in batch mode")) (t ;; Random char. diff --git a/test/lisp/emacs-lisp/map-ynp-tests.el b/test/lisp/emacs-lisp/map-ynp-tests.el index bf89e972d8b..6f4f1cd2d75 100644 --- a/test/lisp/emacs-lisp/map-ynp-tests.el +++ b/test/lisp/emacs-lisp/map-ynp-tests.el @@ -31,8 +31,7 @@ (defun map-ynp-tests-simple-call () (map-y-or-n-p "" #'ignore '(1))) -(ert-deftest test-map-ynp-kmacro () - "Test that `map-y-or-n-p' in a kmacro terminates on end of input." +(defun test-map-ynp-kmacro-1 () (let ((eval-expression-debug-on-error nil)) ;; bug#67836 (execute-kbd-macro (read-kbd-macro "M-: (map-ynp-tests-simple-call) RET y")) (should-error @@ -43,5 +42,80 @@ (should-error (execute-kbd-macro (read-kbd-macro "M-: (map-ynp-tests-simple-call) RET"))))))) +(ert-deftest test-map-ynp-kmacro () + "Test that `map-y-or-n-p' in a kmacro terminates on end of input." + (let ((y-or-n-p-use-read-key nil)) + (test-map-ynp-kmacro-1)) + (let ((y-or-n-p-use-read-key t)) + (test-map-ynp-kmacro-1))) + +(defvar map-ynp-tests-result nil) + +(defvar-keymap map-ynp-tests-map + "C-x s" 'map-ynp-tests-command) + +(defun map-ynp-tests-command-symbol (obj) + (interactive) + (push obj map-ynp-tests-result)) + +(defun map-ynp-tests-command () + (interactive) + (should (equal (map-y-or-n-p + "Prompt " + (lambda (obj) + (push obj map-ynp-tests-result)) + '(1 2 3 4) + nil + `((?\C-r map-ynp-tests-command-symbol "C-r") + (?\M-~ ,(lambda (obj) + (push obj map-ynp-tests-result)) + "M-~"))) + (length map-ynp-tests-result)))) + +(defun map-ynp-tests-run (keys result) + (setq map-ynp-tests-result nil) + (execute-kbd-macro (read-kbd-macro (concat "C-x s " keys))) + (should (equal (nreverse map-ynp-tests-result) result))) + +(defun test-map-ynp-keys-1 () + (with-temp-buffer + (save-window-excursion + ;; `execute-kbd-macro' applied to window only + (set-window-buffer nil (current-buffer)) + (use-local-map map-ynp-tests-map) + + (map-ynp-tests-run "y Y SPC n" '(1 2 3)) + (map-ynp-tests-run "n N DEL y" '(4)) + (map-ynp-tests-run "n !" '(2 3 4)) + (map-ynp-tests-run "." '(1)) + (map-ynp-tests-run "y q" '(1)) + (map-ynp-tests-run "y RET" '(1)) + (map-ynp-tests-run "C-r M-~ ESC ~ q" '(1 2 3)) + + (map-ynp-tests-run "x q" nil) ;; x - random char + + (kill-buffer (help-buffer)) + (if y-or-n-p-use-read-key + (map-ynp-tests-run "? q" nil) + (map-ynp-tests-run "C-h q" nil)) + (should (get-buffer (help-buffer))) + + (should (equal 'quit + (condition-case err + (map-ynp-tests-run "C-g" nil) + (quit (car err))))) + + (should (equal 'quit + (condition-case err + (map-ynp-tests-run "ESC ESC ESC" nil) + (quit (car err)))))))) + +(ert-deftest test-map-ynp-keys () + "Test keys for `map-y-or-n-p'." + (let ((y-or-n-p-use-read-key nil)) + (test-map-ynp-keys-1)) + (let ((y-or-n-p-use-read-key t)) + (test-map-ynp-keys-1))) + (provide 'map-ynp-tests) ;;; map-ynp-tests.el ends here