[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Emacs-diffs] emacs-26 03bb7a8: Avoid clearing echo-area message by
From: |
Eric Abrahamsen |
Subject: |
Re: [Emacs-diffs] emacs-26 03bb7a8: Avoid clearing echo-area message by auto-save-visited-file-name |
Date: |
Mon, 26 Nov 2018 12:11:46 -0800 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) |
Eli Zaretskii <address@hidden> writes:
>> From: Eric Abrahamsen <address@hidden>
>> Date: Mon, 26 Nov 2018 11:20:21 -0800
>>
>> Isn't this what `with-temp-message' is for?
>
> I concluded with-temp-message won't fit the bill here (we prompt the
> user for responses), but maybe I misunderstood something. Take a look
> at the code, and if you can propose a cleaner solution, please do.
>
> Thanks.
Well... I highly doubt I've seen something you haven't, but the
following seems to work correctly, doesn't it?
(setq lexical-binding t)
(defun tst ()
(interactive)
(let ((msg "Hi!")
(lst '("one" "two" "three")))
(message msg)
(sit-for 1)
(my-map-y-or-n-p "Upcase %s? " #'upcase lst)))
(defun my-map-y-or-n-p (prompter actor list &optional help action-alist
no-cursor-in-echo-area)
"Ask a series of boolean questions.
Takes args PROMPTER ACTOR LIST, and optional args HELP and ACTION-ALIST.
LIST is a list of objects, or a function of no arguments to return the next
object or nil.
If PROMPTER is a string, the prompt is \(format PROMPTER OBJECT). If not
a string, PROMPTER is a function of one arg (an object from LIST), which
returns a string to be used as the prompt for that object. If the return
value is not a string, it may be nil to ignore the object or non-nil to act
on the object without asking the user.
ACTOR is a function of one arg (an object from LIST),
which gets called with each object that the user answers `yes' for.
If HELP is given, it is a list (OBJECT OBJECTS ACTION),
where OBJECT is a string giving the singular noun for an elt of LIST;
OBJECTS is the plural noun for elts of LIST, and ACTION is a transitive
verb describing ACTOR. The default is \(\"object\" \"objects\" \"act on\").
At the prompts, the user may enter y, Y, or SPC to act on that object;
n, N, or DEL to skip that object; ! to act on all following objects;
ESC or q to exit (skip all following objects); . (period) to act on the
current object and then exit; or \\[help-command] to get help.
If ACTION-ALIST is given, it is an alist (KEY FUNCTION HELP) of extra keys
that will be accepted. KEY is a character; FUNCTION is a function of one
arg (an object from LIST); HELP is a string. When the user hits KEY,
FUNCTION is called. If it returns non-nil, the object is considered
\"acted upon\", and the next object from LIST is processed. If it returns
nil, the prompt is repeated for the same object.
Final optional argument NO-CURSOR-IN-ECHO-AREA non-nil says not to set
`cursor-in-echo-area' while prompting.
This function uses `query-replace-map' to define the standard responses,
but not all of the responses which `query-replace' understands
are meaningful here.
Returns the number of actions taken."
(let* ((actions 0)
user-keys mouse-event map prompt char elt def
;; Non-nil means we should use mouse menus to ask.
use-menus
delayed-switch-frame
;; Rebind other-window-scroll-buffer so that subfunctions can set
;; it temporarily, without risking affecting the caller.
(other-window-scroll-buffer other-window-scroll-buffer)
(next (if (functionp list)
(lambda () (setq elt (funcall list)))
(lambda () (when list
(setq elt (pop list))
t))))
(try-again (lambda ()
(let ((x next))
(setq next (lambda () (setq next x) elt))))))
(if (and (listp last-nonmenu-event)
use-dialog-box)
;; Make a list describing a dialog box.
(let ((objects (if help (capitalize (nth 1 help))))
(action (if help (capitalize (nth 2 help)))))
(setq map `(("Yes" . act) ("No" . skip)
,@(mapcar (lambda (elt)
(cons (with-syntax-table
text-mode-syntax-table
(capitalize (nth 2 elt)))
(vector (nth 1 elt))))
action-alist)
(,(if help (concat action " This But No More")
"Do This But No More") . act-and-exit)
(,(if help (concat action " All " objects)
"Do All") . automatic)
("No For All" . exit))
use-menus t
mouse-event last-nonmenu-event))
(setq user-keys (if action-alist
(concat (mapconcat (lambda (elt)
(key-description
(vector (car elt))))
action-alist ", ")
" ")
"")
;; Make a map that defines each user key as a vector containing
;; its definition.
map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map query-replace-map)
(dolist (elt action-alist)
(define-key map (vector (car elt)) (vector (nth 1 elt))))
map)))
(with-temp-message ""
(unwind-protect
(progn
(if (stringp prompter)
(setq prompter (let ((prompter prompter))
(lambda (object)
(format prompter object)))))
(while (funcall next)
(setq prompt (funcall prompter elt))
(cond ((stringp prompt)
;; Prompt the user about this object.
(setq quit-flag nil)
(if use-menus
(setq def (or (x-popup-dialog (or mouse-event use-menus)
(cons prompt map))
'quit))
;; Prompt in the echo area.
(let ((cursor-in-echo-area (not no-cursor-in-echo-area)))
(message (apply 'propertize "%s(y, n, !, ., q, %sor %s)
"
minibuffer-prompt-properties)
prompt user-keys
(key-description (vector help-char)))
(if minibuffer-auto-raise
(raise-frame (window-frame (minibuffer-window))))
(while (progn
(setq char (read-event))
;; If we get -1, from end of keyboard
;; macro, try again.
(equal char -1)))
;; Show the answer to the question.
(message "%s(y, n, !, ., q, %sor %s) %s"
prompt user-keys
(key-description (vector help-char))
(single-key-description char)))
(setq def (lookup-key map (vector char))))
(cond ((eq def 'exit)
(setq next (lambda () nil)))
((eq def 'act)
;; Act on the object.
(funcall actor elt)
(setq actions (1+ actions)))
((eq def 'skip)
;; Skip the object.
)
((eq def 'act-and-exit)
;; Act on the object and then exit.
(funcall actor elt)
(setq actions (1+ actions)
next (lambda () nil)))
((eq def 'quit)
(setq quit-flag t)
(funcall try-again))
((eq def 'automatic)
;; Act on this and all following objects.
(if (funcall prompter elt)
(progn
(funcall actor elt)
(setq actions (1+ actions))))
(while (funcall next)
(if (funcall prompter elt)
(progn
(funcall actor elt)
(setq actions (1+ actions))))))
((eq def 'help)
(with-output-to-temp-buffer "*Help*"
(princ
(let ((object (if help (nth 0 help) "object"))
(objects (if help (nth 1 help) "objects"))
(action (if help (nth 2 help) "act on")))
(concat
(format-message "\
Type SPC or `y' to %s the current %s;
DEL or `n' to skip the current %s;
RET or `q' to give up on the %s (skip all remaining %s);
C-g to quit (cancel the whole command);
! to %s all remaining %s;\n"
action object object action
objects action
objects)
(mapconcat (function
(lambda (elt)
(format "%s to %s"
(single-key-description
(nth 0 elt))
(nth 2 elt))))
action-alist
";\n")
(if action-alist ";\n")
(format "or . (period) to %s \
the current %s and exit."
action object))))
(with-current-buffer standard-output
(help-mode)))
(funcall try-again))
((and (symbolp def) (commandp def))
(call-interactively def)
;; Regurgitated; try again.
(funcall try-again))
((vectorp def)
;; A user-defined key.
(if (funcall (aref def 0) elt) ;Call its function.
;; The function has eaten this object.
(setq actions (1+ actions))
;; Regurgitated; try again.
(funcall try-again)))
((and (consp char)
(eq (car char) 'switch-frame))
;; switch-frame event. Put it off until we're done.
(setq delayed-switch-frame char)
(funcall try-again))
(t
;; Random char.
(message "Type %s for help."
(key-description (vector help-char)))
(beep)
(sit-for 1)
(funcall try-again))))
(prompt
(funcall actor elt)
(setq actions (1+ actions))))))
(if delayed-switch-frame
(setq unread-command-events
(cons delayed-switch-frame unread-command-events)))))
;; Clear the last prompt from the minibuffer, and restore the
;; previous echo-area message, if any.
;; Return the number of actions that were taken.
actions))
- Re: [Emacs-diffs] emacs-26 03bb7a8: Avoid clearing echo-area message by auto-save-visited-file-name, Stefan Monnier, 2018/11/26
- Re: [Emacs-diffs] emacs-26 03bb7a8: Avoid clearing echo-area message by auto-save-visited-file-name, Eli Zaretskii, 2018/11/26
- Re: [Emacs-diffs] emacs-26 03bb7a8: Avoid clearing echo-area message by auto-save-visited-file-name, Eric Abrahamsen, 2018/11/26
- Re: [Emacs-diffs] emacs-26 03bb7a8: Avoid clearing echo-area message by auto-save-visited-file-name, Eli Zaretskii, 2018/11/26
- Re: [Emacs-diffs] emacs-26 03bb7a8: Avoid clearing echo-area message by auto-save-visited-file-name,
Eric Abrahamsen <=
- Re: [Emacs-diffs] emacs-26 03bb7a8: Avoid clearing echo-area message by auto-save-visited-file-name, Eli Zaretskii, 2018/11/26
- Re: [Emacs-diffs] emacs-26 03bb7a8: Avoid clearing echo-area message by auto-save-visited-file-name, Eric Abrahamsen, 2018/11/26
- Re: [Emacs-diffs] emacs-26 03bb7a8: Avoid clearing echo-area message by auto-save-visited-file-name, Eli Zaretskii, 2018/11/27
- Re: [Emacs-diffs] emacs-26 03bb7a8: Avoid clearing echo-area message by auto-save-visited-file-name, Eric Abrahamsen, 2018/11/27