From: Juri Linkov <juri@linkov.net>
To: 38076@debbugs.gnu.org
Cc: stefan monnier <monnier@iro.umontreal.ca>
Subject: bug#38076: Using minibuffer for y-or-n-p
Date: Wed, 06 Nov 2019 00:54:37 +0200 [thread overview]
Message-ID: <87r22m53yq.fsf_-_@mail.linkov.net> (raw)
In-Reply-To: <jwvd0edwuaw.fsf-monnier+emacs@gnu.org> (Stefan Monnier's message of "Wed, 30 Oct 2019 22:00:40 -0400")
[-- Attachment #1: Type: text/plain, Size: 1191 bytes --]
X-Debbugs-CC: Stefan Monnier <monnier@iro.umontreal.ca>
Tags: patch
>> query-replace-map needs to be translated to another keymap
>> where the same characters from 'query-replace-map'
>> run real commands, not intermediate symbols.
>
> E.g.
>
> (defvar foo-remapping-map
> (let ((map (make-sparse-keymap)))
> (define-key map [remap ask] '...)
> ...
> map))
>
> and then
>
> ... (make-composed-keymap query-replace-map foo-remapping-map) ..
This also required adding the same feature that supported recentering/scrolling
in y-or-n-p to the minibuffer as well. A large part of old implementation
of y-or-n-p handled recentering/scrolling. Now the minibuffer supports
the same commands by using the new macro 'with-minibuffer-selected-window'.
window.c was changed to use the 'lambda' value for MINIBUF arg of 'next-window',
so minibuffer-scroll-other-window/minibuffer-scroll-other-window-down
doesn't try to scroll the minibuffer window.
A new history variable 'y-or-n-p-history-variable' is nil by default,
so no history is used in 'y-or-n-p' minibuffer.
This patch was tested with various commands that use 'y-or-n-p'
and seems to work fine:
[-- Attachment #2: y-or-n-p-minibuffer.patch --]
[-- Type: text/x-diff, Size: 8881 bytes --]
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 43dd277a2e..0c55954b02 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2236,6 +2236,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 +3677,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/subr.el b/lisp/subr.el
index 03cf3da278..0a8a505b70 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2668,6 +2668,66 @@ 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 [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)
+
+ 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 +2743,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 +2775,13 @@ 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))))
+ (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/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);
next prev parent reply other threads:[~2019-11-05 22:54 UTC|newest]
Thread overview: 26+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-10-26 10:14 Strange use of (run-with-timer 0 nil #'foo args) in do-after-load-evaluation Alan Mackenzie
2019-10-26 12:41 ` Stefan Monnier
2019-10-26 13:16 ` Lars Ingebrigtsen
2019-10-26 16:38 ` Stefan Monnier
2019-10-27 1:01 ` HaiJun Zhang
2019-10-27 21:57 ` Juri Linkov
2019-10-27 22:29 ` Juri Linkov
2019-10-28 9:41 ` martin rudalics
2019-10-28 2:13 ` Stefan Monnier
2019-10-28 10:45 ` Lars Ingebrigtsen
2019-10-28 22:19 ` Juri Linkov
2019-10-28 23:20 ` Stefan Kangas
2019-10-29 23:39 ` Juri Linkov
2019-10-29 11:38 ` Lars Ingebrigtsen
2019-10-29 23:45 ` Juri Linkov
2019-10-29 23:58 ` Lars Ingebrigtsen
2019-10-30 8:22 ` martin rudalics
2019-10-30 22:10 ` Juri Linkov
2019-10-31 2:00 ` Stefan Monnier
2019-11-03 20:50 ` Juri Linkov
2019-11-05 22:54 ` Juri Linkov [this message]
2019-11-06 22:25 ` bug#38076: Using minibuffer for y-or-n-p Juri Linkov
2019-10-26 14:18 ` Strange use of (run-with-timer 0 nil #'foo args) in do-after-load-evaluation Alan Mackenzie
2019-10-26 15:27 ` Juanma Barranquero
2019-10-27 21:51 ` Juri Linkov
2019-10-28 3:34 ` Eli Zaretskii
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87r22m53yq.fsf_-_@mail.linkov.net \
--to=juri@linkov.net \
--cc=38076@debbugs.gnu.org \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.