master 1e7786437d 3/5: read-multiple-choice: Add optional argument show-help

[Stefan Kangas]

branch: master
commit 1e7786437d3d471bffe48d91a067556f9223e9cf
Author: Stefan Kangas <stefan@marxist.se>
Commit: Stefan Kangas <stefan@marxist.se>

    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.
---
 doc/lispref/commands.texi |   6 ++-
 etc/NEWS                  |   4 ++
 lisp/emacs-lisp/rmc.el    | 122 ++++++++++++++++++++++++++--------------------
 3 files changed, 77 insertions(+), 55 deletions(-)

diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 31e4c5411c..b833b5bf85 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -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.
 @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.
 
@@ -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
 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
diff --git a/etc/NEWS b/etc/NEWS
index c9466d0fef..cfea513cca 100644
--- a/etc/NEWS
+++ b/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
 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'.
 The 'kbd' function is quite permissive, and will try to return
diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
index 6264220cd0..90fd8b370e 100644
--- a/lisp/emacs-lisp/rmc.el
+++ b/lisp/emacs-lisp/rmc.el
@@ -59,8 +59,65 @@
              (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.
 
@@ -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
 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
@@ -101,8 +161,8 @@ Usage example:
                       \\='((?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): "
@@ -111,6 +171,9 @@ Usage example:
          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
@@ -166,57 +229,8 @@ Usage example:
                   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)))