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.

1 files changed, 68 insertions, 54 deletions

diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
index 6264220cd09..90fd8b370e8 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)))