Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-06-14 12:31:25 +00:00
Code Issues Projects Releases Packages Wiki Activity

Read a key sequence instead of a single key in 'map-y-or-n-p'

Browse source 
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'.
This commit is contained in:
Juri Linkov 2026-06-07 21:56:47 +03:00
parent 2755f171fc
commit 9e37c94079
3 changed files with 105 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
doc/lispref/minibuf.texi
View file

@ -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 convenient facilities such as the ability to answer the whole series at
once. 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 @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 This function asks the user a series of questions, reading a
single-character answer in the minibuffer for each one. However, if single-character answer in the minibuffer for each one. However, if
@code{read-char-choice-use-read-key} is non-@code{nil} (@pxref{Reading @code{y-or-n-p-use-read-key} is non-@code{nil} (@pxref{Key Sequence
One Event}), it reads single keys from the echo area. Input}), it reads a key sequence from the echo area.
The value of @var{list} specifies the objects to ask questions about. 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 It should be either a list of objects or a generator function. If it

47
lisp/emacs-lisp/map-ynp.el
View file

@ -105,7 +105,7 @@ function is used instead.
The function's value is the number of actions taken." The function's value is the number of actions taken."
(let* ((actions 0) (let* ((actions 0)
(msg (current-message)) (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. ;; Non-nil means we should use mouse menus to ask.
use-menus use-menus
delayed-switch-frame delayed-switch-frame
@ -174,14 +174,15 @@ The function's value is the number of actions taken."
'quit))) 'quit)))
(y-or-n-p-use-read-key (y-or-n-p-use-read-key
;; Prompt in the echo area using `read-key'. ;; Prompt in the echo area using `read-key'.
(let ((cursor-in-echo-area (not no-cursor-in-echo-area))) (let ((cursor-in-echo-area (not no-cursor-in-echo-area))
(message "%s" (substitute-command-keys (full-prompt
(format (substitute-command-keys
(apply #'propertize (format
"%s(\\`y', \\`n', \\`!', \\`.', \\`q', %sor \\`%s') " (apply #'propertize
minibuffer-prompt-properties) "%s(\\`y', \\`n', \\`!', \\`.', \\`q', %sor \\`%s') "
prompt user-keys minibuffer-prompt-properties)
(help-key)))) prompt user-keys
(help-key)))))
(if minibuffer-auto-raise (if minibuffer-auto-raise
(raise-frame (window-frame (minibuffer-window)))) (raise-frame (window-frame (minibuffer-window))))
(unwind-protect (unwind-protect
@ -196,8 +197,8 @@ The function's value is the number of actions taken."
;; Do NOT use read-event here. That ;; Do NOT use read-event here. That
;; function does not consult ;; function does not consult
;; input-decode-map (bug#75886). ;; input-decode-map (bug#75886).
(setq char (read-key)) (setq chars (read-key-sequence-vector full-prompt))
(when (eq char ?\C-g) (when (member chars '([?\C-g] [?\C-\[ ?\C-\[ ?\C-\[]))
(signal 'quit nil))) (signal 'quit nil)))
(when (fboundp 'set-text-conversion-style) (when (fboundp 'set-text-conversion-style)
(set-text-conversion-style 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" "%s(\\`y', \\`n', \\`!', \\`.', \\`q', %sor \\`%s') %s"
prompt user-keys prompt user-keys
(help-key) (help-key)
(if (equal char -1) (if (equal chars [-1])
"[end-of-keyboard-macro]" "[end-of-keyboard-macro]"
(single-key-description char)))))) (key-description chars))))))
(setq def (lookup-key map (vector char)))) (setq def (and chars (lookup-key map chars))))
(t (t
;; Read from the minibuffer. ;; Read from the minibuffer.
(let* ((full-prompt (let* ((full-prompt
@ -224,7 +225,7 @@ The function's value is the number of actions taken."
(cmd-char (cmd-char
(lambda () (lambda ()
(interactive) (interactive)
(setq char last-command-event) (setq chars (this-command-keys-vector))
(exit-minibuffer))) (exit-minibuffer)))
(cmd-help (cmd-help
(lambda () (lambda ()
@ -250,8 +251,8 @@ The function's value is the number of actions taken."
(read-from-minibuffer (read-from-minibuffer
full-prompt nil remap nil full-prompt nil remap nil
(or y-or-n-p-history-variable t)) (or y-or-n-p-history-variable t))
(message "%s%s" full-prompt (single-key-description char))) (message "%s%s" full-prompt (key-description chars)))
(setq def (lookup-key map (vector char))))) (setq def (and chars (lookup-key map chars)))))
(cond ((eq def 'exit) (cond ((eq def 'exit)
(setq next (lambda () nil))) (setq next (lambda () nil)))
((eq def 'act) ((eq def 'act)
@ -318,12 +319,16 @@ Type \\`SPC' or \\`y' to %s the current %s;
(setq actions (1+ actions)) (setq actions (1+ actions))
;; Regurgitated; try again. ;; Regurgitated; try again.
(funcall try-again))) (funcall try-again)))
((and (consp char) ((eq chars '[switch-frame])
(eq (car char) 'switch-frame))
;; switch-frame event. Put it off until we're done. ;; switch-frame event. Put it off until we're done.
(setq delayed-switch-frame char) (setq delayed-switch-frame chars)
(funcall try-again)) (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")) (error "Can't use in a kmacro in batch mode"))
(t (t
;; Random char. ;; Random char.

78
test/lisp/emacs-lisp/map-ynp-tests.el
View file

@ -31,8 +31,7 @@
(defun map-ynp-tests-simple-call () (defun map-ynp-tests-simple-call ()
(map-y-or-n-p "" #'ignore '(1))) (map-y-or-n-p "" #'ignore '(1)))
(ert-deftest test-map-ynp-kmacro () (defun test-map-ynp-kmacro-1 ()
"Test that `map-y-or-n-p' in a kmacro terminates on end of input."
(let ((eval-expression-debug-on-error nil)) ;; bug#67836 (let ((eval-expression-debug-on-error nil)) ;; bug#67836
(execute-kbd-macro (read-kbd-macro "M-: (map-ynp-tests-simple-call) RET y")) (execute-kbd-macro (read-kbd-macro "M-: (map-ynp-tests-simple-call) RET y"))
(should-error (should-error
@ -43,5 +42,80 @@
(should-error (should-error
(execute-kbd-macro (read-kbd-macro "M-: (map-ynp-tests-simple-call) RET"))))))) (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) (provide 'map-ynp-tests)
;;; map-ynp-tests.el ends here ;;; map-ynp-tests.el ends here