From: Juri Linkov Date: Wed, 30 Dec 2020 09:54:01 +0000 (+0200) Subject: Add variables read-char-choice-use-read-key and y-or-n-p-use-read-key X-Git-Tag: emacs-28.0.90~4485 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=cd4a51695fddf2a76ae9ed71efa8bfb4a515b32e;p=emacs.git 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 --- diff --git a/etc/NEWS b/etc/NEWS index 10a925972f5..765c032dc47 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 0f68b470733..f83824a2727 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 70d451cccfa..637aaa130a4 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 384dbb25cf8..ed0d6978d03 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 ec763223379..249f40e9af9 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 8250316bcc7..bb5d26d29e9 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))))))