* bug#38076: Using minibuffer for y-or-n-p
2019-11-05 22:54 ` bug#38076: Using minibuffer for y-or-n-p Juri Linkov
@ 2019-11-06 22:25 ` Juri Linkov
0 siblings, 0 replies; 2+ messages in thread
From: Juri Linkov @ 2019-11-06 22:25 UTC (permalink / raw)
To: 38076; +Cc: Stefan Monnier
[-- Attachment #1: Type: text/plain, Size: 626 bytes --]
The previous patch fixes the problem with y-or-n-p reported in bug#17272.
But to fix the problem reported by Alan in
https://lists.gnu.org/archive/html/emacs-devel/2019-10/msg01020.html
for the prompt asking about local variables:
Please type y, n, or !, or C-v to scroll:
requires using read-char-from-minibuffer instead of read-char-choice.
A new arg CHARS was added to read-char-from-minibuffer to make it
a drop-in replacement for read-char-choice.
Here is a complete tested patch that solves all reported problems
in bug#17272 and bug#19064. More specific patches will be posted
now to these bug reports as well.
[-- Attachment #2: y-or-n-p-minibuffer-read-char-from-minibuffer.patch --]
[-- Type: text/x-diff, Size: 16735 bytes --]
diff --git a/lisp/files.el b/lisp/files.el
index 7690357058..8f7c7c2d04 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2120,7 +2120,7 @@ files--ask-user-about-large-file
("Yes" . ?y)
("No" . ?n)
("Open literally" . ?l)))
- (read-char-choice
+ (read-char-from-minibuffer
(concat prompt " (y)es or (n)o or (l)iterally ")
'(?y ?Y ?n ?N ?l ?L)))))
(cond ((memq choice '(?y ?Y)) nil)
@@ -3503,24 +3503,17 @@ hack-local-variables-confirm
;; Display the buffer and read a choice.
(save-window-excursion
(pop-to-buffer buf '(display-buffer--maybe-at-bottom))
- (let* ((exit-chars '(?y ?n ?\s ?\C-g ?\C-v))
+ (let* ((exit-chars '(?y ?n ?\s))
(prompt (format "Please type %s%s: "
(if offer-save "y, n, or !" "y or n")
(if (< (line-number-at-pos (point-max))
(window-body-height))
""
- (push ?\C-v exit-chars)
- ", or C-v to scroll")))
+ ", or C-v/M-v to scroll")))
char)
(if offer-save (push ?! exit-chars))
(while (null char)
- (setq char (read-char-choice prompt exit-chars t))
- (when (eq char ?\C-v)
- (condition-case nil
- (scroll-up)
- (error (goto-char (point-min))
- (recenter 1)))
- (setq char nil)))
+ (setq char (read-char-from-minibuffer 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/minibuffer.el b/lisp/minibuffer.el
index 43dd277a2e..741fab4f89 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -715,6 +715,11 @@ minibuffer-message
(message "%s" message))
(prog1 (sit-for (or minibuffer-message-timeout 1000000))
(message nil)))
+ ;; Record message in the *Messages* buffer
+ (let ((inhibit-message t))
+ (if args
+ (apply #'message message args)
+ (message "%s" message)))
;; Clear out any old echo-area message to make way for our new thing.
(message nil)
(setq message (if (and (null args)
@@ -2236,6 +2241,13 @@ completion-help-at-point
(let ((map minibuffer-local-map))
(define-key map "\C-g" 'abort-recursive-edit)
(define-key map "\M-<" 'minibuffer-beginning-of-buffer)
+
+ (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)
+
(define-key map "\r" 'exit-minibuffer)
(define-key map "\n" 'exit-minibuffer))
@@ -3670,6 +3682,46 @@ minibuffer-beginning-of-buffer
(when (and arg (not (consp arg)))
(forward-line 1)))
+(defmacro with-minibuffer-selected-window (&rest body)
+ "Execute the forms in BODY from the minibuffer in its original window.
+When used in a minibuffer window, select the window selected just before
+minibuffer window was selected, and execute the forms."
+ (declare (indent 0) (debug t))
+ `(let ((window (minibuffer-selected-window)))
+ (when window
+ (with-selected-window window
+ ,@body))))
+
+(defun minibuffer-recenter-top-bottom (&optional arg)
+ "Run `recenter-top-bottom' from minibuffer in original window."
+ (interactive "P")
+ (with-minibuffer-selected-window
+ (recenter-top-bottom arg)))
+
+(defun minibuffer-scroll-up-command (&optional arg)
+ "Run `scroll-up-command' from minibuffer in original window."
+ (interactive "^P")
+ (with-minibuffer-selected-window
+ (scroll-up-command arg)))
+
+(defun minibuffer-scroll-down-command (&optional arg)
+ "Run `scroll-down-command' from minibuffer in original window."
+ (interactive "^P")
+ (with-minibuffer-selected-window
+ (scroll-down-command arg)))
+
+(defun minibuffer-scroll-other-window (&optional arg)
+ "Run `scroll-other-window' from minibuffer in original window."
+ (interactive "P")
+ (with-minibuffer-selected-window
+ (scroll-other-window arg)))
+
+(defun minibuffer-scroll-other-window-down (&optional arg)
+ "Run `scroll-other-window-down' from minibuffer in original window."
+ (interactive "^P")
+ (with-minibuffer-selected-window
+ (scroll-other-window-down arg)))
+
(provide 'minibuffer)
;;; minibuffer.el ends here
diff --git a/lisp/simple.el b/lisp/simple.el
index 10aecd651f..7ea6c73d3e 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5171,46 +5171,84 @@ backward-delete-char-untabify
;; Avoid warning about delete-backward-char
(with-no-warnings (delete-backward-char n killp))))
-(defvar read-char-from-minibuffer-history nil
+(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-self-insert)
+ 'read-char-from-minibuffer-insert-char)
map)
"Keymap for the `read-char-from-minibuffer' function.")
-(defun read-char-from-minibuffer-self-insert ()
- "Insert the character you type in the minibuffer."
+(defconst read-char-from-minibuffer-map-hash
+ (make-hash-table :weakness 'key :test 'equal))
+
+(defun read-char-from-minibuffer-insert-char ()
+ "Insert the character you type in the minibuffer and exit.
+Discard all input in a minibuffer before inserting and exiting the minibuffer."
(interactive)
(delete-minibuffer-contents)
- (insert (event-basic-type last-command-event))
+ (insert last-command-event)
(exit-minibuffer))
-(defun read-char-from-minibuffer (prompt)
- "Read a character from the minibuffer, prompting with string PROMPT.
-Like `read-char', but allows navigating in a history. The navigation
-commands are `M-p' and `M-n', with `RET' to select a character from
-history."
- (let ((result
- (read-from-minibuffer prompt nil
- read-char-from-minibuffer-map nil
- 'read-char-from-minibuffer-history)))
- (if (> (length result) 0)
- ;; We have a string (with one character), so return the first one.
- (elt result 0)
- ;; The default value is RET.
- (push "\r" read-char-from-minibuffer-history)
- ?\r)))
+(defun read-char-from-minibuffer-insert-other ()
+ "Insert the character you type in the minibuffer and exit.
+Discard all input in a minibuffer before inserting and exiting the minibuffer."
+ (interactive)
+ (delete-minibuffer-contents)
+ (beep)
+ (minibuffer-message "Wrong answer")
+ (sit-for 2))
+
+(defvar empty-history)
+
+(defun read-char-from-minibuffer (prompt &optional chars history)
+ "Read a character from the minibuffer, prompting for PROMPT.
+Like `read-char', but uses the minibuffer to read and return a character.
+When CHARS is non-nil, any input that is not one of CHARS is ignored.
+When HISTORY is a symbol, then allows navigating in a history.
+The navigation commands are `M-p' and `M-n', with `RET' to select
+a character from history."
+ (discard-input)
+ (let* ((empty-history '())
+ (map (if (consp chars)
+ (or (gethash chars read-char-from-minibuffer-map-hash)
+ (puthash chars
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map read-char-from-minibuffer-map)
+ (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)
+ ;; (define-key map [remap t]
+ ;; 'read-char-from-minibuffer-insert-other)
+ map)
+ read-char-from-minibuffer-map-hash))
+ read-char-from-minibuffer-map))
+ (result
+ (read-from-minibuffer prompt nil map nil
+ (or history 'empty-history)))
+ (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.
+ (push "\r" read-char-history)
+ ?\r)))
+ ;; Display the question with the answer.
+ (message "%s%s" prompt (char-to-string char))
+ char))
(defun zap-to-char (arg char)
"Kill up to and including ARGth occurrence of CHAR.
Case is ignored if `case-fold-search' is non-nil in the current buffer.
Goes backward if ARG is negative; error if CHAR not found."
(interactive (list (prefix-numeric-value current-prefix-arg)
- (read-char-from-minibuffer "Zap to char: ")))
+ (read-char-from-minibuffer "Zap to char: "
+ nil 'read-char-history)))
;; Avoid "obsolete" warnings for translation-table-for-input.
(with-no-warnings
(if (char-table-p translation-table-for-input)
diff --git a/lisp/subr.el b/lisp/subr.el
index 03cf3da278..33464d6032 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2668,6 +2668,70 @@ sit-for
;; 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)
+
+ ;; (define-key map [t] 'y-or-n-p-insert-other)
+
+ (define-key map [remap act] 'y-or-n-p-insert-y)
+ (define-key map [remap act-and-show] 'y-or-n-p-insert-y)
+ (define-key map [remap act-and-exit] 'y-or-n-p-insert-y)
+ (define-key map [remap automatic] 'y-or-n-p-insert-y)
+
+ (define-key map [remap skip] 'y-or-n-p-insert-n)
+
+ (define-key map [remap help] 'y-or-n-p-insert-other)
+ (define-key map [remap backup] 'y-or-n-p-insert-other)
+ (define-key map [remap undo] 'y-or-n-p-insert-other)
+ (define-key map [remap undo-all] 'y-or-n-p-insert-other)
+ (define-key map [remap edit] 'y-or-n-p-insert-other)
+ (define-key map [remap edit-replacement] 'y-or-n-p-insert-other)
+ (define-key map [remap delete-and-edit] 'y-or-n-p-insert-other)
+ (define-key map [remap ignore] 'y-or-n-p-insert-other)
+ (define-key map [remap self-insert-command] 'y-or-n-p-insert-other)
+
+ (define-key map [remap recenter] 'minibuffer-recenter-top-bottom)
+
+ (define-key map [remap quit] 'abort-recursive-edit)
+ (define-key map [remap exit] 'abort-recursive-edit)
+ (define-key map [remap exit-prefix] 'abort-recursive-edit)
+ (define-key map [escape] 'abort-recursive-edit)
+
+ ;; (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 input in a minibuffer before inserting."
+ (interactive)
+ (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 input in a minibuffer before inserting."
+ (interactive)
+ (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'."
+ (interactive)
+ (delete-minibuffer-contents)
+ (ding)
+ (minibuffer-message "Please answer y or n")
+ (sit-for 2))
+
+(defvar empty-history)
+
(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\".
@@ -2683,16 +2747,13 @@ y-or-n-p
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 `keyboard-quit'.
+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.
Under a windowing system a dialog box will be used if `last-nonmenu-event'
is nil and `use-dialog-box' is non-nil."
- ;; ¡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.
(let ((answer 'recenter)
(padded (lambda (prompt &optional dialog)
(let ((l (length prompt)))
@@ -2718,36 +2779,14 @@ y-or-n-p
answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
(t
(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))))
+ (discard-input)
+ (let* ((empty-history '())
+ (str (read-from-minibuffer
+ prompt nil
+ (make-composed-keymap y-or-n-p-map query-replace-map)
+ nil
+ (or y-or-n-p-history-variable 'empty-history))))
+ (setq answer (if (member str '("y" "Y")) 'act 'skip)))))
(let ((ret (eq answer 'act)))
(unless noninteractive
(message "%s%c" prompt (if ret ?y ?n)))
diff --git a/lisp/userlock.el b/lisp/userlock.el
index 209768620c..1d3ac84584 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -152,7 +152,7 @@ ask-user-about-supersession-threat
(message "%s" prompt)
(error "Cannot resolve conflict in batch mode"))
(while (null answer)
- (setq answer (read-char-choice prompt choices))
+ (setq answer (read-char-from-minibuffer prompt choices))
(cond ((memq answer '(?? ?\C-h))
(ask-user-about-supersession-help)
(setq answer nil))
diff --git a/src/window.c b/src/window.c
index 0fa0bdf7b9..c01f5c4aa3 100644
--- a/src/window.c
+++ b/src/window.c
@@ -6253,12 +6253,12 @@ DEFUN ("other-window-for-scrolling", Fother_window_for_scrolling, Sother_window_
{
/* Nothing specified; look for a neighboring window on the same
frame. */
- window = Fnext_window (selected_window, Qnil, Qnil);
+ window = Fnext_window (selected_window, Qlambda, Qnil);
if (EQ (window, selected_window))
/* That didn't get us anywhere; look for a window on another
visible frame on the current terminal. */
- window = Fnext_window (window, Qnil, Qvisible);
+ window = Fnext_window (window, Qlambda, Qvisible);
}
CHECK_LIVE_WINDOW (window);
^ permalink raw reply related [flat|nested] 2+ messages in thread