then continues to wait for a valid input character, or keyboard-quit.
@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
that will be displayed as the prompt.
displayed in a help buffer instead of the default auto-generated
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}.
@lisp
(substring name (1+ pos)))))))
(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
-(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.
This function allows to ask the user a multiple-choice question.
should contain a more detailed description of all of the possible
choices. `read-multiple-choice' will display that description in a
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
the bindings in `query-replace-map'; see the documentation of
\\='((?a \"always\")
(?s \"session only\")
(?n \"no\")))"
- (let* ((altered-names (mapcar #'rmc--add-key-description
- (append choices '((?? "?")))))
+ (let* ((choices (if show-help choices (append choices '((?? "?")))))
+ (altered-names (mapcar #'rmc--add-key-description choices))
(full-prompt
(format
"%s (%s): "
tchar buf wrong-char answer)
(save-window-excursion
(save-excursion
+ (if show-help
+ (setq buf (rmc--show-help prompt help-string show-help
+ choices altered-names)))
(while (not tchar)
(message "%s%s"
(if wrong-char
tchar nil)
(when wrong-char
(ding))
- (setq buf (get-buffer-create "*Multiple Choice Help*"))
- (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))))))))))))
+ (setq buf (rmc--show-help prompt help-string show-help
+ choices altered-names))))))
(when (buffer-live-p buf)
(kill-buffer buf))
(assq tchar choices)))