From f8ead5c60afccb1b2c46dbfedb41de09dadaf90f Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Mon, 1 Jul 2024 11:57:47 +0200 Subject: [PATCH] (read-char-choice,y-or-n-p): Simplify, use 'r-m-c' --- doc/lispref/commands.texi | 18 +- lisp/misc.el | 3 +- lisp/simple.el | 3 +- lisp/subr.el | 418 +---------------------------------- test/lisp/dired-aux-tests.el | 2 +- 5 files changed, 14 insertions(+), 430 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 425497674cb..28916df935d 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -3620,24 +3620,10 @@ unspecified, the only fallback disabled is downcasing of the last event. @end defun -@vindex read-char-choice-use-read-key -@defun read-char-choice prompt chars &optional inhibit-quit +@defun read-char-choice prompt chars This function uses @code{read-from-minibuffer} to read and return a single character that is a member of @var{chars}, which should be a -list of single characters. It discards any input characters that are -not members of @var{chars}, and shows a message to that effect. - -The optional argument @var{inhibit-quit} is by default ignored, but if -the variable @code{read-char-choice-use-read-key} is non-@code{nil}, -this function uses @code{read-key} instead of -@code{read-from-minibuffer}, and in that case @var{inhibit-quit} -non-@code{nil} means ignore keyboard-quit events while waiting for -valid input. In addition, if @code{read-char-choice-use-read-key} is -non-@code{nil}, binding @code{help-form} (@pxref{Help Functions}) to a -non-@code{nil} value while calling this function causes it to evaluate -@code{help-form} and display the result when the user presses -@code{help-char}; it then continues to wait for a valid input -character, or for keyboard-quit. +list of single characters. @end defun @defun read-multiple-choice prompt choices &optional help-string show-help long-form diff --git a/lisp/misc.el b/lisp/misc.el index fb40d1c16a3..cfb7076dde9 100644 --- a/lisp/misc.el +++ b/lisp/misc.el @@ -180,8 +180,7 @@ Ignores CHAR at point. If called interactively, do a case sensitive search if CHAR is an upper-case character." (interactive (list (prefix-numeric-value current-prefix-arg) - (read-char-from-minibuffer "Zap up to char: " - nil 'read-char-history) + (read-char "Zap up to char: ") t)) (let ((direction (if (>= arg 0) 1 -1)) (case-fold-search (if (and interactive (char-uppercase-p char)) diff --git a/lisp/simple.el b/lisp/simple.el index ad20ef3156d..ca44f1c5ea5 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6482,8 +6482,7 @@ See also `zap-up-to-char'. If called interactively, do a case sensitive search if CHAR is an upper-case character." (interactive (list (prefix-numeric-value current-prefix-arg) - (read-char-from-minibuffer "Zap to char: " - nil 'read-char-history) + (read-char "Zap to char: ") t)) ;; Avoid "obsolete" warnings for translation-table-for-input. (with-no-warnings diff --git a/lisp/subr.el b/lisp/subr.el index 7ece0f79a8d..b39e863120e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3438,80 +3438,13 @@ This function is used by the `interactive' code letter \"n\"." t))) n)) -(defvar read-char-choice-use-read-key nil - "If non-nil, use `read-key' when reading a character by `read-char-choice'. -Otherwise, use the minibuffer (this is the default). - -When reading via the minibuffer, you can use the normal commands -available in the minibuffer, and can, for instance, temporarily -switch to another buffer, do things there, and then switch back -to the minibuffer before entering the character. This is not -possible when using `read-key', but using `read-key' may be less -confusing to some users.") - -(defun read-char-choice (prompt chars &optional inhibit-keyboard-quit) +(defun read-char-choice (prompt chars) "Read and return one of the characters in CHARS, prompting with PROMPT. -CHARS should be a list of single characters. -The function discards any input character that is not one of CHARS, -and by default shows a message to the effect that it is not one of -the expected characters. - -By default, this function uses the minibuffer to read the key -non-modally (see `read-char-from-minibuffer'), and the optional -argument INHIBIT-KEYBOARD-QUIT is ignored. However, if -`read-char-choice-use-read-key' is non-nil, the modal `read-key' -function is used instead (see `read-char-choice-with-read-key'), -and INHIBIT-KEYBOARD-QUIT is passed to it." - (if (not read-char-choice-use-read-key) - (read-char-from-minibuffer prompt chars) - (read-char-choice-with-read-key prompt chars inhibit-keyboard-quit))) - -(defun read-char-choice-with-read-key (prompt chars &optional inhibit-keyboard-quit) - "Read and return one of the characters in CHARS, prompting with PROMPT. -CHARS should be a list of single characters. -Any input that is not one of CHARS is ignored. - -If optional argument INHIBIT-KEYBOARD-QUIT is non-nil, ignore -`keyboard-quit' events while waiting for valid input. - -If you bind the variable `help-form' to a non-nil value -while calling this function, then pressing `help-char' -causes it to evaluate `help-form' and display the result." - (unless (consp chars) - (error "Called `read-char-choice' without valid char choices")) - (let (char done show-help (helpbuf " *Char Help*")) - (let ((cursor-in-echo-area t) - (executing-kbd-macro executing-kbd-macro) - (esc-flag nil)) - (save-window-excursion ; in case we call help-form-show - (while (not done) - (unless (get-text-property 0 'face prompt) - (setq prompt (propertize prompt 'face 'minibuffer-prompt))) - ;; Display the on screen keyboard if it exists. - (frame-toggle-on-screen-keyboard (selected-frame) nil) - (setq char (let ((inhibit-quit inhibit-keyboard-quit)) - (read-key prompt))) - (and show-help (buffer-live-p (get-buffer helpbuf)) - (kill-buffer helpbuf)) - (cond - ((not (numberp char))) - ;; If caller has set help-form, that's enough. - ;; They don't explicitly have to add help-char to chars. - ((and help-form - (eq char help-char) - (setq show-help t) - (help-form-show))) - ((memq char chars) - (setq done t)) - ((not inhibit-keyboard-quit) - (cond - ((and (null esc-flag) (eq char ?\e)) - (setq esc-flag t)) - ((memq char '(?\C-g ?\e)) - (keyboard-quit)))))))) - ;; Display the question with the answer. But without cursor-in-echo-area. - (message "%s%s" prompt (char-to-string char)) - char)) +CHARS should be a list of single characters." + (car (read-multiple-choice prompt + (mapcar (lambda (c) + (list c (char-to-string c))) + chars)))) (defun sit-for (seconds &optional nodisp) "Redisplay, then wait for SECONDS seconds. Stop when input is available. @@ -3581,210 +3514,12 @@ If there is a natural number at point, use it as default." (list (read-number prompt (list default (point))))))) -(defvar read-char-history nil - "The default history for the `read-char-from-minibuffer' function.") - -(defvar read-char-from-minibuffer-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-map) - - ;; (define-key map [remap self-insert-command] #'read-char-from-minibuffer-insert-char) - (define-key map [remap exit-minibuffer] #'read-char-from-minibuffer-insert-other) - - (define-key map [remap recenter-top-bottom] #'minibuffer-recenter-top-bottom) - (define-key map [remap scroll-up-command] #'minibuffer-scroll-up-command) - (define-key map [remap scroll-down-command] #'minibuffer-scroll-down-command) - (define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window) - (define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down) - - map) - "Keymap for the `read-char-from-minibuffer' function.") - -(defconst read-char-from-minibuffer-map-hash - (make-hash-table :test 'equal)) - -(defun read-char-from-minibuffer-insert-char () - "Insert the character you type into the minibuffer and exit minibuffer. -Discard all previous input before inserting and exiting the minibuffer." - (interactive) - (when (minibufferp) - (delete-minibuffer-contents) - (insert last-command-event) - (exit-minibuffer))) - -(defun read-char-from-minibuffer-insert-other () - "Reject a disallowed character typed into the minibuffer. -This command is intended to be bound to keys that users are not -allowed to type into the minibuffer. When the user types any -such key, this command discard all minibuffer input and displays -an error message." - (interactive) - (when (minibufferp) ;;FIXME: Why? - (delete-minibuffer-contents) - (ding) - (discard-input) - (minibuffer-message "Wrong answer") - (sit-for 2))) - ;; Defined in textconv.c. (defvar overriding-text-conversion-style) -(defun read-char-from-minibuffer (prompt &optional chars history) - "Read a character from the minibuffer, prompting for it with PROMPT. -Like `read-char', but uses the minibuffer to read and return a character. -Optional argument CHARS, if non-nil, should be a list of characters; -the function will ignore any input that is not one of CHARS. -Optional argument HISTORY, if non-nil, should be a symbol that -specifies the history list variable to use for navigating in input -history using \\`M-p' and \\`M-n', with \\`RET' to select a character from -history. -If you bind the variable `help-form' to a non-nil value -while calling this function, then pressing `help-char' -causes it to evaluate `help-form' and display the result. -There is no need to explicitly add `help-char' to CHARS; -`help-char' is bound automatically to `help-form-show'." - - ;; If text conversion is enabled in this buffer, then it will only - ;; be disabled the next time `force-mode-line-update' happens. - (when (and (bound-and-true-p overriding-text-conversion-style) - (bound-and-true-p text-conversion-style)) - (force-mode-line-update)) - - (let* ((overriding-text-conversion-style nil) - (map (if (consp chars) - (or (gethash (list help-form (cons help-char chars)) - read-char-from-minibuffer-map-hash) - (let ((map (make-sparse-keymap)) - (msg help-form)) - (set-keymap-parent map read-char-from-minibuffer-map) - ;; If we have a dynamically bound `help-form' - ;; here, then the `C-h' (i.e., `help-char') - ;; character should output that instead of - ;; being a command char. - (when help-form - (define-key map (vector help-char) - (lambda () - (interactive) - (let ((help-form msg)) ; lexically bound msg - (help-form-show))))) - ;; FIXME: We use `read-char-from-minibuffer-insert-char' - ;; here only as a kind of alias of `self-insert-command' - ;; to prevent those keys from being remapped to - ;; `read-char-from-minibuffer-insert-other'. - (dolist (char chars) - (define-key map (vector char) - #'read-char-from-minibuffer-insert-char)) - (define-key map [remap self-insert-command] - #'read-char-from-minibuffer-insert-other) - (puthash (list help-form (cons help-char chars)) - map read-char-from-minibuffer-map-hash) - map)) - read-char-from-minibuffer-map)) - ;; Protect this-command when called from pre-command-hook (bug#45029) - (this-command this-command) - (result (minibuffer-with-setup-hook - (lambda () - (setq-local post-self-insert-hook nil) - (add-hook 'post-command-hook - (lambda () - (if (<= (1+ (minibuffer-prompt-end)) - (point-max)) - (exit-minibuffer))) - nil 'local)) - ;; Disable text conversion if it is enabled. - ;; (bug#65370) - (when (fboundp 'set-text-conversion-style) - (set-text-conversion-style text-conversion-style)) - (read-from-minibuffer prompt nil map nil (or history t)))) - (char - (if (> (length result) 0) - ;; We have a string (with one character), so return the first one. - (elt result 0) - ;; The default value is RET. - (when history (push "\r" (symbol-value history))) - ?\r))) - ;; Display the question with the answer. - (message "%s%s" prompt (char-to-string char)) - char)) - - ;; Behind display-popup-menus-p test. (declare-function x-popup-dialog "menu.c" (position contents &optional header)) -(defvar y-or-n-p-history-variable nil - "History list symbol to add `y-or-n-p' answers to.") - -(defvar y-or-n-p-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-map) - - (dolist (symbol '(act act-and-show act-and-exit automatic)) - (define-key map (vector 'remap symbol) #'y-or-n-p-insert-y)) - - (define-key map [remap skip] #'y-or-n-p-insert-n) - - (dolist (symbol '(backup undo undo-all edit edit-replacement - delete-and-edit ignore self-insert-command help)) - (define-key map (vector 'remap symbol) #'y-or-n-p-insert-other)) - - (define-key map [remap recenter] #'minibuffer-recenter-top-bottom) - (define-key map [remap scroll-up] #'minibuffer-scroll-up-command) - (define-key map [remap scroll-down] #'minibuffer-scroll-down-command) - (define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window) - (define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down) - - (define-key map [remap exit] #'y-or-n-p-insert-other) - (dolist (symbol '(exit-prefix quit)) - (define-key map (vector 'remap symbol) #'abort-recursive-edit)) - (define-key map [escape] #'abort-recursive-edit) - - ;; FIXME: try catch-all instead of explicit bindings: - ;; (define-key map [remap t] #'y-or-n-p-insert-other) - - map) - "Keymap that defines additional bindings for `y-or-n-p' answers.") - -(defun y-or-n-p-insert-y () - "Insert the answer \"y\" and exit the minibuffer of `y-or-n-p'. -Discard all previous input before inserting and exiting the minibuffer." - (interactive) - (when (minibufferp) - (delete-minibuffer-contents) - (insert "y") - (exit-minibuffer))) - -(defun y-or-n-p-insert-n () - "Insert the answer \"n\" and exit the minibuffer of `y-or-n-p'. -Discard all previous input before inserting and exiting the minibuffer." - (interactive) - (when (minibufferp) - (delete-minibuffer-contents) - (insert "n") - (exit-minibuffer))) - -(defun y-or-n-p-insert-other () - "Handle inserting of other answers in the minibuffer of `y-or-n-p'. -Display an error on trying to insert a disallowed character. -Also discard all previous input in the minibuffer." - (interactive) - (when (minibufferp) - (delete-minibuffer-contents) - (ding) - (discard-input) - (minibuffer-message "Please answer y or n") - (sit-for 2))) - -(defvar y-or-n-p-use-read-key nil - "Use `read-key' when reading answers to \"y or n\" questions by `y-or-n-p'. -Otherwise, use the `read-from-minibuffer' to read the answers. - -When reading via the minibuffer, you can use the normal commands -available in the minibuffer, and can, for instance, temporarily -switch to another buffer, do things there, and then switch back -to the minibuffer before entering the character. This is not -possible when using `read-key', but using `read-key' may be less -confusing to some users.") - (defvar from--tty-menu-p nil "Non-nil means the current command was invoked from a TTY menu.") @@ -3808,144 +3543,9 @@ confusing to some users.") use-dialog-box))) (defun y-or-n-p (prompt) - "Ask user a \"y or n\" question. -Return t if answer is \"y\" and nil if it is \"n\". - -PROMPT is the string to display to ask the question; `y-or-n-p' -adds \"(y or n) \" to it. If PROMPT is a non-empty string, and -it ends with a non-space character, a space character will be -appended to it. - -If you bind the variable `help-form' to a non-nil value -while calling this function, then pressing `help-char' -causes it to evaluate `help-form' and display the result. -PROMPT is also updated to show `help-char' like \"(y, n or C-h) \", -where `help-char' is automatically bound to `help-form-show'. - -No confirmation of the answer is requested; a single character is -enough. SPC also means yes, and DEL means no. - -To be precise, this function translates user input into responses -by consulting the bindings in `query-replace-map'; see the -documentation of that variable for more information. In this -case, the useful bindings are `act', `skip', `recenter', -`scroll-up', `scroll-down', and `quit'. -An `act' response means yes, and a `skip' response means no. -A `quit' response means to invoke `abort-recursive-edit'. -If the user enters `recenter', `scroll-up', or `scroll-down' -responses, perform the requested window recentering or scrolling -and ask again. - -If dialog boxes are supported, this function will use a dialog box -if `use-dialog-box' is non-nil and the last input event was produced -by a mouse, or by some window-system gesture, or via a menu. - -By default, this function uses the minibuffer to read the key. -If `y-or-n-p-use-read-key' is non-nil, `read-key' is used -instead (which means that the user can't change buffers (and the -like) while `y-or-n-p' is running)." - (let ((answer 'recenter) - (padded (lambda (prompt &optional dialog) - (let ((l (length prompt))) - (concat prompt - (if (or (zerop l) (eq ?\s (aref prompt (1- l)))) - "" " ") - (if dialog "" - ;; Don't clobber caller's match data. - (save-match-data - (substitute-command-keys - (if help-form - (format "(\\`y', \\`n' or \\`%s') " - (key-description - (vector help-char))) - "(\\`y' or \\`n') ")))))))) - ;; Preserve the actual command that eventually called - ;; `y-or-n-p' (otherwise `repeat' will be repeating - ;; `exit-minibuffer'). - (real-this-command real-this-command)) - (cond - (noninteractive - (setq prompt (funcall padded prompt)) - (let ((temp-prompt prompt)) - (while (not (memq answer '(act skip))) - (let ((str (read-string temp-prompt))) - (cond ((member str '("y" "Y")) (setq answer 'act)) - ((member str '("n" "N")) (setq answer 'skip)) - ((and (member str '("h" "H")) help-form) (print help-form)) - (t (setq temp-prompt (concat "Please answer y or n. " - prompt)))))))) - ((use-dialog-box-p) - (setq prompt (funcall padded prompt t) - answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip))))) - (y-or-n-p-use-read-key - ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state - ;; where all the keys were unbound (i.e. it somehow got triggered - ;; within read-key, apparently). I had to kill it. - (setq prompt (funcall padded prompt)) - (while - (let* ((scroll-actions '(recenter scroll-up scroll-down - scroll-other-window scroll-other-window-down)) - (key - (let ((cursor-in-echo-area t)) - (when minibuffer-auto-raise - (raise-frame (window-frame (minibuffer-window)))) - (read-key (propertize (if (memq answer scroll-actions) - prompt - (concat "Please answer y or n. " - prompt)) - 'face 'minibuffer-prompt))))) - (setq answer (lookup-key query-replace-map (vector key) t)) - (cond - ((memq answer '(skip act)) nil) - ((eq answer 'recenter) - (recenter) t) - ((eq answer 'scroll-up) - (ignore-errors (scroll-up-command)) t) - ((eq answer 'scroll-down) - (ignore-errors (scroll-down-command)) t) - ((eq answer 'scroll-other-window) - (ignore-errors (scroll-other-window)) t) - ((eq answer 'scroll-other-window-down) - (ignore-errors (scroll-other-window-down)) t) - ((or (memq answer '(exit-prefix quit)) (eq key ?\e)) - (signal 'quit nil) t) - (t t))) - (ding) - (discard-input))) - (t - (setq prompt (funcall padded prompt)) - (let* ((enable-recursive-minibuffers t) - (msg help-form) - ;; Disable text conversion so that real Y or N events are - ;; sent. - (overriding-text-conversion-style nil) - (keymap (let ((map (make-composed-keymap - y-or-n-p-map query-replace-map))) - (when help-form - ;; Create a new map before modifying - (setq map (copy-keymap map)) - (define-key map (vector help-char) - (lambda () - (interactive) - (let ((help-form msg)) ; lexically bound msg - (help-form-show))))) - map)) - ;; Protect this-command when called from pre-command-hook (bug#45029) - (this-command this-command) - (str (progn - ;; If the minibuffer is already active, the - ;; selected window might not change. Disable - ;; text conversion by hand. - (when (fboundp 'set-text-conversion-style) - (set-text-conversion-style text-conversion-style)) - (read-from-minibuffer - prompt nil keymap nil - (or y-or-n-p-history-variable t))))) - (setq answer (if (member str '("y" "Y")) 'act 'skip))))) - (let ((ret (eq answer 'act))) - (unless noninteractive - (message "%s%c" prompt (if ret ?y ?n))) - ret))) + "Ask user a \"y or n\" question, prompting with PROMPT. +Return t if answer is \"y\" and nil if it is \"n\"." + (= (car (read-multiple-choice prompt '((?y "y") (?n "n")))) ?y)) ;;; Atomic change groups. diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index f1542cb5e83..60a4414ea10 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -28,7 +28,7 @@ (skip-unless (executable-find shell-file-name)) (ert-with-temp-file foo (let* ((files (list foo))) - (cl-letf (((symbol-function 'read-char-from-minibuffer) 'error)) + (cl-letf (((symbol-function 'read-char-choice) 'error)) (dired temporary-file-directory) (dired-goto-file foo) ;; `dired-do-shell-command' returns nil on success. -- 2.39.2