[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master cd4a516: Add variables read-char-choice-use-read-key and y-or-n-p
From: |
Juri Linkov |
Subject: |
master cd4a516: Add variables read-char-choice-use-read-key and y-or-n-p-use-read-key |
Date: |
Wed, 30 Dec 2020 04:54:15 -0500 (EST) |
branch: master
commit cd4a51695fddf2a76ae9ed71efa8bfb4a515b32e
Author: Juri Linkov <juri@linkov.net>
Commit: Juri Linkov <juri@linkov.net>
Add variables read-char-choice-use-read-key and y-or-n-p-use-read-key
* lisp/subr.el (read-char-choice-use-read-key): New variable.
(read-char-choice): Use read-char-from-minibuffer when
read-char-choice-use-read-key is nil.
(y-or-n-p-use-read-key): New variable.
(y-or-n-p): Restore old code that calls read-key to use it when
y-or-n-p-use-read-key is non-nil.
* lisp/dired-aux.el (dired--no-subst-ask, dired-query):
* lisp/files.el (files--ask-user-about-large-file)
(hack-local-variables-confirm):
* lisp/userlock.el (ask-user-about-supersession-threat):
* lisp/wid-edit.el (widget-choose): Revert to use read-char-choice
instead of read-char-from-minibuffer.
https://lists.gnu.org/archive/html/emacs-devel/2020-12/msg01919.html
---
etc/NEWS | 5 +++
lisp/dired-aux.el | 4 +-
lisp/files.el | 4 +-
lisp/subr.el | 121 +++++++++++++++++++++++++++++++++++++-----------------
lisp/userlock.el | 2 +-
lisp/wid-edit.el | 2 +-
6 files changed, 94 insertions(+), 44 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 10a9259..765c032 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2020,6 +2020,11 @@ If you bind 'help-form' to a non-nil value while calling
these functions,
then pressing 'C-h' ('help-char') causes the function to evaluate 'help-form'
and display the result.
+---
+** New variables 'read-char-choice-use-read-key' and 'y-or-n-p-use-read-key'.
+When non-nil, then functions 'read-char-choice' and 'y-or-n-p' (respectively)
+use the function 'read-key' to read a character instead of using the
minibuffer.
+
+++
** 'set-window-configuration' now takes an optional 'dont-set-frame'
parameter which, when non-nil, instructs the function not to select
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 0f68b47..f83824a 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -145,7 +145,7 @@ substituted, and will be passed through normally to the
shell.
(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 @@ return t; if SYM is q or ESC, return nil."
(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 70d451c..637aaa1 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2141,7 +2141,7 @@ think it does, because \"free\" is pretty hard to define
in practice."
("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 @@ n -- to ignore the local variables list.")
", 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 384dbb25..ed0d697 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2626,6 +2626,10 @@ This function is used by the `interactive' code letter
`n'."
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,44 +2640,46 @@ keyboard-quit events while waiting for a 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)))
- (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))
- ((and executing-kbd-macro (= char -1))
- ;; read-event returns -1 if we are in a kbd macro and
- ;; there are no more events in the macro. Attempt to
- ;; get an event interactively.
- (setq executing-kbd-macro nil))
- ((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))
+ (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*"))
+ (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)))
+ (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))
+ ((and executing-kbd-macro (= char -1))
+ ;; read-event returns -1 if we are in a kbd macro and
+ ;; there are no more events in the macro. Attempt to
+ ;; get an event interactively.
+ (setq executing-kbd-macro nil))
+ ((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)))
(defun sit-for (seconds &optional nodisp obsolete)
"Redisplay, then wait for SECONDS seconds. Stop when input is available.
@@ -2920,6 +2926,10 @@ Also discard all previous input in the minibuffer."
(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 @@ is nil and `use-dialog-box' is non-nil."
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 ec76322..249f40e 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -159,7 +159,7 @@ really edit the buffer? (y, n, r or C-h) "
(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 8250316..bb5d26d 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -338,7 +338,7 @@ in the key vector, as in the argument of `define-key'."
'(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))))))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master cd4a516: Add variables read-char-choice-use-read-key and y-or-n-p-use-read-key,
Juri Linkov <=