From: Stefan Kangas Date: Sun, 26 Dec 2021 00:27:39 +0000 (+0100) Subject: read-multiple-choice: Add optional argument show-help X-Git-Tag: emacs-29.0.90~3430 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=1e7786437d3d471bffe48d91a067556f9223e9cf;p=emacs.git 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. --- diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 31e4c5411cc..b833b5bf856 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 c9466d0fef1..cfea513cca3 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 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)))