1
Fork 0
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:
Stefan Kangas 2021-12-26 01:27:39 +01:00
parent 787030b021
commit 1e7786437d
3 changed files with 77 additions and 55 deletions

View file

@ -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

View file

@ -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

View file

@ -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)))