diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 0f68b47073..f83824a272 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -145,7 +145,7 @@ dired--no-subst-explain (defun dired--no-subst-ask (char nb-occur details) (let ((hilit-char (propertize (string char) 'face 'warning)) (choices `(?y ?n ?? ,@(when details '(?^))))) - (read-char-from-minibuffer + (read-char-choice (format-message (ngettext "%d occurrence of `%s' will not be substituted. Proceed? (%s) " @@ -1380,7 +1380,7 @@ dired-query (format " [Type yn!q or %s] " (key-description (vector help-char))) " [Type y, n, q or !] "))) - (set sym (setq char (read-char-from-minibuffer prompt char-choices))) + (set sym (setq char (read-char-choice prompt char-choices))) (if (memq char '(?y ?\s ?!)) t))))) diff --git a/lisp/files.el b/lisp/files.el index 70d451cccf..637aaa130a 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2141,7 +2141,7 @@ files--ask-user-about-large-file ("Yes" . ?y) ("No" . ?n) ("Open literally" . ?l))) - (read-char-from-minibuffer + (read-char-choice (concat prompt " (y)es or (n)o or (l)iterally ") '(?y ?Y ?n ?N ?l ?L))))) (cond ((memq choice '(?y ?Y)) nil) @@ -3538,7 +3538,7 @@ hack-local-variables-confirm ", or C-v/M-v to scroll"))) char) (if offer-save (push ?! exit-chars)) - (setq char (read-char-from-minibuffer prompt exit-chars)) + (setq char (read-char-choice prompt exit-chars)) (when (and offer-save (= char ?!) unsafe-vars) (customize-push-and-save 'safe-local-variable-values unsafe-vars)) (prog1 (memq char '(?! ?\s ?y)) diff --git a/lisp/subr.el b/lisp/subr.el index 384dbb25cf..592c633a35 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2626,6 +2626,10 @@ read-number t))) n)) +(defvar read-char-choice-use-read-key nil + "Prefer `read-key' when reading a character by `read-char-choice'. +Otherwise, use the minibuffer.") + (defun read-char-choice (prompt chars &optional inhibit-keyboard-quit) "Read and return one of CHARS, prompting for PROMPT. Any input that is not one of CHARS is ignored. @@ -2636,6 +2640,8 @@ read-char-choice 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." + (if (not read-char-choice-use-read-key) + (read-char-from-minibuffer prompt chars) (unless (consp chars) (error "Called `read-char-choice' without valid char choices")) (let (char done show-help (helpbuf " *Char Help*")) @@ -2673,7 +2679,7 @@ read-char-choice (keyboard-quit)))))))) ;; Display the question with the answer. But without cursor-in-echo-area. (message "%s%s" prompt (char-to-string char)) - char)) + char))) (defun sit-for (seconds &optional nodisp obsolete) "Redisplay, then wait for SECONDS seconds. Stop when input is available. @@ -2920,6 +2926,10 @@ y-or-n-p-insert-other (minibuffer-message "Please answer y or n") (sit-for 2))) +(defvar y-or-n-p-use-read-key nil + "Prefer `read-key' when answering a \"y or n\" question by `y-or-n-p'. +Otherwise, use the minibuffer.") + (defvar empty-history) (defun y-or-n-p (prompt) @@ -2980,6 +2990,41 @@ y-or-n-p use-dialog-box) (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* ((empty-history '()) diff --git a/lisp/userlock.el b/lisp/userlock.el index ec76322337..249f40e9af 100644 --- a/lisp/userlock.el +++ b/lisp/userlock.el @@ -159,7 +159,7 @@ ask-user-about-supersession-threat (message "%s" prompt) (error "Cannot resolve conflict in batch mode")) (while (null answer) - (setq answer (read-char-from-minibuffer prompt choices)) + (setq answer (read-char-choice prompt choices)) (cond ((memq answer '(?? ?\C-h)) (ask-user-about-supersession-help) (setq answer nil)) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 8250316bcc..bb5d26d29e 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -338,7 +338,7 @@ widget-choose '(display-buffer-in-direction (direction . bottom) (window-height . fit-window-to-buffer))) - (setq value (read-char-from-minibuffer + (setq value (read-char-choice (format "%s: " title) (mapcar #'car alist))))) (cdr (assoc value alist))))))