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.
(list (read-number prompt (list default (point)))))))
\f
-(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))
-
-\f
;; 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.")
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))
\f
;;; Atomic change groups.
projects / emacs.git / commitdiff