mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-15 18:40:39 -08:00
read-multiple-choice: Add optional argument show-help
* lisp/emacs-lisp/rmc.el (rmc--show-help): Factor out new function from read-multiple-choice. (read-multiple-choice): Add new optional argument show-help. * doc/lispref/commands.texi (Reading One Event): Document above new optional argument.
This commit is contained in:
parent
787030b021
commit
1e7786437d
3 changed files with 77 additions and 55 deletions
|
|
@ -3032,7 +3032,7 @@ causes it to evaluate @code{help-form} and display the result. It
|
||||||
then continues to wait for a valid input character, or keyboard-quit.
|
then continues to wait for a valid input character, or keyboard-quit.
|
||||||
@end defun
|
@end defun
|
||||||
|
|
||||||
@defun read-multiple-choice prompt choices &optional help-string
|
@defun read-multiple-choice prompt choices &optional help-string show-help
|
||||||
Ask user a multiple choice question. @var{prompt} should be a string
|
Ask user a multiple choice question. @var{prompt} should be a string
|
||||||
that will be displayed as the prompt.
|
that will be displayed as the prompt.
|
||||||
|
|
||||||
|
|
@ -3047,6 +3047,10 @@ a string with a more detailed description of all choices. It will be
|
||||||
displayed in a help buffer instead of the default auto-generated
|
displayed in a help buffer instead of the default auto-generated
|
||||||
description when the user types @kbd{?}.
|
description when the user types @kbd{?}.
|
||||||
|
|
||||||
|
If optional argument @var{show-help} is non-@code{nil}, the help
|
||||||
|
buffer will be displayed immediately, before any user input. If it is
|
||||||
|
a string, use it as the name of the help buffer.
|
||||||
|
|
||||||
The return value is the matching value from @var{choices}.
|
The return value is the matching value from @var{choices}.
|
||||||
|
|
||||||
@lisp
|
@lisp
|
||||||
|
|
|
||||||
4
etc/NEWS
4
etc/NEWS
|
|
@ -937,6 +937,10 @@ If non-nil, remove the definition from the keymap. This is subtly
|
||||||
different from setting a definition to nil (when the keymap has a
|
different from setting a definition to nil (when the keymap has a
|
||||||
parent).
|
parent).
|
||||||
|
|
||||||
|
+++
|
||||||
|
*** 'read-multiple-choice' now takes an optional SHOW-HELP argument.
|
||||||
|
If non-nil, show the help buffer immediately, before any user input.
|
||||||
|
|
||||||
+++
|
+++
|
||||||
*** New function 'key-valid-p'.
|
*** New function 'key-valid-p'.
|
||||||
The 'kbd' function is quite permissive, and will try to return
|
The 'kbd' function is quite permissive, and will try to return
|
||||||
|
|
|
||||||
|
|
@ -59,8 +59,65 @@
|
||||||
(substring name (1+ pos)))))))
|
(substring name (1+ pos)))))))
|
||||||
(cons (car elem) altered-name)))
|
(cons (car elem) altered-name)))
|
||||||
|
|
||||||
|
(defun rmc--show-help (prompt help-string show-help choices altered-names)
|
||||||
|
(let* ((buf-name (if (stringp show-help)
|
||||||
|
show-help
|
||||||
|
"*Multiple Choice Help*"))
|
||||||
|
(buf (get-buffer-create buf-name)))
|
||||||
|
(if (stringp help-string)
|
||||||
|
(with-help-window buf
|
||||||
|
(with-current-buffer buf
|
||||||
|
(insert help-string)))
|
||||||
|
(with-help-window buf
|
||||||
|
(with-current-buffer buf
|
||||||
|
(erase-buffer)
|
||||||
|
(pop-to-buffer buf)
|
||||||
|
(insert prompt "\n\n")
|
||||||
|
(let* ((columns (/ (window-width) 25))
|
||||||
|
(fill-column 21)
|
||||||
|
(times 0)
|
||||||
|
(start (point)))
|
||||||
|
(dolist (elem choices)
|
||||||
|
(goto-char start)
|
||||||
|
(unless (zerop times)
|
||||||
|
(if (zerop (mod times columns))
|
||||||
|
;; Go to the next "line".
|
||||||
|
(goto-char (setq start (point-max)))
|
||||||
|
;; Add padding.
|
||||||
|
(while (not (eobp))
|
||||||
|
(end-of-line)
|
||||||
|
(insert (make-string (max (- (* (mod times columns)
|
||||||
|
(+ fill-column 4))
|
||||||
|
(current-column))
|
||||||
|
0)
|
||||||
|
?\s))
|
||||||
|
(forward-line 1))))
|
||||||
|
(setq times (1+ times))
|
||||||
|
(let ((text
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert (format
|
||||||
|
"%c: %s\n"
|
||||||
|
(car elem)
|
||||||
|
(cdr (assq (car elem) altered-names))))
|
||||||
|
(fill-region (point-min) (point-max))
|
||||||
|
(when (nth 2 elem)
|
||||||
|
(let ((start (point)))
|
||||||
|
(insert (nth 2 elem))
|
||||||
|
(unless (bolp)
|
||||||
|
(insert "\n"))
|
||||||
|
(fill-region start (point-max))))
|
||||||
|
(buffer-string))))
|
||||||
|
(goto-char start)
|
||||||
|
(dolist (line (split-string text "\n"))
|
||||||
|
(end-of-line)
|
||||||
|
(if (bolp)
|
||||||
|
(insert line "\n")
|
||||||
|
(insert line))
|
||||||
|
(forward-line 1))))))))
|
||||||
|
buf))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun read-multiple-choice (prompt choices &optional help-string)
|
(defun read-multiple-choice (prompt choices &optional help-string show-help)
|
||||||
"Ask user to select an entry from CHOICES, promting with PROMPT.
|
"Ask user to select an entry from CHOICES, promting with PROMPT.
|
||||||
This function allows to ask the user a multiple-choice question.
|
This function allows to ask the user a multiple-choice question.
|
||||||
|
|
||||||
|
|
@ -76,6 +133,9 @@ the optional argument HELP-STRING. This argument is a string that
|
||||||
should contain a more detailed description of all of the possible
|
should contain a more detailed description of all of the possible
|
||||||
choices. `read-multiple-choice' will display that description in a
|
choices. `read-multiple-choice' will display that description in a
|
||||||
help buffer if the user requests that.
|
help buffer if the user requests that.
|
||||||
|
If optional argument SHOW-HELP is non-nil, show the help screen
|
||||||
|
immediately, before any user input. If SHOW-HELP is a string,
|
||||||
|
use it as the name of the help buffer.
|
||||||
|
|
||||||
This function translates user input into responses by consulting
|
This function translates user input into responses by consulting
|
||||||
the bindings in `query-replace-map'; see the documentation of
|
the bindings in `query-replace-map'; see the documentation of
|
||||||
|
|
@ -101,8 +161,8 @@ Usage example:
|
||||||
\\='((?a \"always\")
|
\\='((?a \"always\")
|
||||||
(?s \"session only\")
|
(?s \"session only\")
|
||||||
(?n \"no\")))"
|
(?n \"no\")))"
|
||||||
(let* ((altered-names (mapcar #'rmc--add-key-description
|
(let* ((choices (if show-help choices (append choices '((?? "?")))))
|
||||||
(append choices '((?? "?")))))
|
(altered-names (mapcar #'rmc--add-key-description choices))
|
||||||
(full-prompt
|
(full-prompt
|
||||||
(format
|
(format
|
||||||
"%s (%s): "
|
"%s (%s): "
|
||||||
|
|
@ -111,6 +171,9 @@ Usage example:
|
||||||
tchar buf wrong-char answer)
|
tchar buf wrong-char answer)
|
||||||
(save-window-excursion
|
(save-window-excursion
|
||||||
(save-excursion
|
(save-excursion
|
||||||
|
(if show-help
|
||||||
|
(setq buf (rmc--show-help prompt help-string show-help
|
||||||
|
choices altered-names)))
|
||||||
(while (not tchar)
|
(while (not tchar)
|
||||||
(message "%s%s"
|
(message "%s%s"
|
||||||
(if wrong-char
|
(if wrong-char
|
||||||
|
|
@ -166,57 +229,8 @@ Usage example:
|
||||||
tchar nil)
|
tchar nil)
|
||||||
(when wrong-char
|
(when wrong-char
|
||||||
(ding))
|
(ding))
|
||||||
(setq buf (get-buffer-create "*Multiple Choice Help*"))
|
(setq buf (rmc--show-help prompt help-string show-help
|
||||||
(if (stringp help-string)
|
choices altered-names))))))
|
||||||
(with-help-window buf
|
|
||||||
(with-current-buffer buf
|
|
||||||
(insert help-string)))
|
|
||||||
(with-help-window buf
|
|
||||||
(with-current-buffer buf
|
|
||||||
(erase-buffer)
|
|
||||||
(pop-to-buffer buf)
|
|
||||||
(insert prompt "\n\n")
|
|
||||||
(let* ((columns (/ (window-width) 25))
|
|
||||||
(fill-column 21)
|
|
||||||
(times 0)
|
|
||||||
(start (point)))
|
|
||||||
(dolist (elem choices)
|
|
||||||
(goto-char start)
|
|
||||||
(unless (zerop times)
|
|
||||||
(if (zerop (mod times columns))
|
|
||||||
;; Go to the next "line".
|
|
||||||
(goto-char (setq start (point-max)))
|
|
||||||
;; Add padding.
|
|
||||||
(while (not (eobp))
|
|
||||||
(end-of-line)
|
|
||||||
(insert (make-string (max (- (* (mod times columns)
|
|
||||||
(+ fill-column 4))
|
|
||||||
(current-column))
|
|
||||||
0)
|
|
||||||
?\s))
|
|
||||||
(forward-line 1))))
|
|
||||||
(setq times (1+ times))
|
|
||||||
(let ((text
|
|
||||||
(with-temp-buffer
|
|
||||||
(insert (format
|
|
||||||
"%c: %s\n"
|
|
||||||
(car elem)
|
|
||||||
(cdr (assq (car elem) altered-names))))
|
|
||||||
(fill-region (point-min) (point-max))
|
|
||||||
(when (nth 2 elem)
|
|
||||||
(let ((start (point)))
|
|
||||||
(insert (nth 2 elem))
|
|
||||||
(unless (bolp)
|
|
||||||
(insert "\n"))
|
|
||||||
(fill-region start (point-max))))
|
|
||||||
(buffer-string))))
|
|
||||||
(goto-char start)
|
|
||||||
(dolist (line (split-string text "\n"))
|
|
||||||
(end-of-line)
|
|
||||||
(if (bolp)
|
|
||||||
(insert line "\n")
|
|
||||||
(insert line))
|
|
||||||
(forward-line 1))))))))))))
|
|
||||||
(when (buffer-live-p buf)
|
(when (buffer-live-p buf)
|
||||||
(kill-buffer buf))
|
(kill-buffer buf))
|
||||||
(assq tchar choices)))
|
(assq tchar choices)))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue