From 2705fc4ab05bb81ba8c6fd6469499be32a4ac420 Mon Sep 17 00:00:00 2001 From: Daniel Martín Date: Thu, 6 May 2021 10:21:59 +0200 Subject: Extend read-multiple-choice to support free-form help descriptions * lisp/emacs-lisp/rmc.el (read-multiple-choice): Add a new argument to override the default help description in `read-multiple-choice'. Use the `help-char' variable instead of ?\C-h. Also support the `edit' action from `query-replace-map', so that help links can be visited by entering a recursive edit. --- lisp/emacs-lisp/rmc.el | 129 ++++++++++++++++++++++++++++--------------------- 1 file changed, 74 insertions(+), 55 deletions(-) (limited to 'lisp/emacs-lisp/rmc.el') diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el index bedf598d442..6aa169c0323 100644 --- a/lisp/emacs-lisp/rmc.el +++ b/lisp/emacs-lisp/rmc.el @@ -26,24 +26,32 @@ (require 'seq) ;;;###autoload -(defun read-multiple-choice (prompt choices) +(defun read-multiple-choice (prompt choices &optional help-string) "Ask user a multiple choice question. PROMPT should be a string that will be displayed as the prompt. CHOICES is a list of (KEY NAME [DESCRIPTION]). KEY is a character to be entered. NAME is a short name for the entry to be displayed while prompting (if there's room, it might be -shortened). DESCRIPTION is an optional longer explanation that -will be displayed in a help buffer if the user requests more -help. +shortened). DESCRIPTION is an optional longer explanation for +the entry that will be displayed in a help buffer if the user +requests more help. This help description has a fixed format in +columns, but, for greater flexibility, instead of passing a +DESCRIPTION, the user can use the optional argument HELP-STRING. +This argument is a string that contains the text with the +complete description of all choices. `read-multiple-choice' will +display that description in a help buffer if the user requests +it. This function translates user input into responses by consulting the bindings in `query-replace-map'; see the documentation of that variable for more information. In this case, the useful -bindings are `recenter', `scroll-up', and `scroll-down'. If the -user enters `recenter', `scroll-up', or `scroll-down' responses, -perform the requested window recentering or scrolling and ask -again. +bindings are `recenter', `scroll-up', `scroll-down', and `edit'. +If the user enters `recenter', `scroll-up', or `scroll-down' +responses, perform the requested window recentering or scrolling +and ask again. If the user enters `edit', start a recursive +edit. When the user exit the recursive edit, the multiple choice +prompt gains focus again. When `use-dialog-box' is t (the default), this function can pop up a dialog window to collect the user input. That functionality @@ -133,6 +141,13 @@ Usage example: (ignore-errors (scroll-other-window)) t) ((eq answer 'scroll-other-window-down) (ignore-errors (scroll-other-window-down)) t) + ((eq answer 'edit) + (save-match-data + (save-excursion + (message "%s" + (substitute-command-keys + "Recursive edit. Resume with \\[exit-recursive-edit]")) + (recursive-edit)))) (t tchar))) (when (eq tchar t) (setq wrong-char nil @@ -141,57 +156,61 @@ Usage example: ;; help messages. (when (and (not (eq tchar nil)) (not (assq tchar choices))) - (setq wrong-char (not (memq tchar '(?? ?\C-h))) + (setq wrong-char (not (memq tchar `(?? ,help-char))) tchar nil) (when wrong-char (ding)) - (with-help-window (setq buf (get-buffer-create - "*Multiple Choice Help*")) - (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)))) + (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) - (dolist (line (split-string text "\n")) - (end-of-line) - (if (bolp) - (insert line "\n") - (insert line)) - (forward-line 1))))))))))) + (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) (kill-buffer buf)) (assq tchar choices))) -- cgit v1.2.3 From 615cf550f22f78d123acb1e8e90be6c69699dbee Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 7 May 2021 17:09:44 +0300 Subject: Fix a recent change in rmc.el * lisp/emacs-lisp/rmc.el (read-multiple-choice): Doc fix. Improve the message when entering recursive-edit. --- lisp/emacs-lisp/rmc.el | 57 +++++++++++++++++++++++++------------------------- 1 file changed, 29 insertions(+), 28 deletions(-) (limited to 'lisp/emacs-lisp/rmc.el') diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el index 6aa169c0323..8abe570e64b 100644 --- a/lisp/emacs-lisp/rmc.el +++ b/lisp/emacs-lisp/rmc.el @@ -27,36 +27,37 @@ ;;;###autoload (defun read-multiple-choice (prompt choices &optional help-string) - "Ask user a multiple choice question. -PROMPT should be a string that will be displayed as the prompt. - -CHOICES is a list of (KEY NAME [DESCRIPTION]). KEY is a -character to be entered. NAME is a short name for the entry to -be displayed while prompting (if there's room, it might be -shortened). DESCRIPTION is an optional longer explanation for -the entry that will be displayed in a help buffer if the user -requests more help. This help description has a fixed format in -columns, but, for greater flexibility, instead of passing a -DESCRIPTION, the user can use the optional argument HELP-STRING. -This argument is a string that contains the text with the -complete description of all choices. `read-multiple-choice' will -display that description in a help buffer if the user requests -it. + "Ask user to select an entry from CHOICES, promting with PROMPT. +This function allows to ask the user a multiple-choice question. + +CHOICES should be a list of the form (KEY NAME [DESCRIPTION]). +KEY is a character the user should type to select the entry. +NAME is a short name for the entry to be displayed while prompting +\(if there's no room, it might be shortened). +DESCRIPTION is an optional longer description of the entry; it will +be displayed in a help buffer if the user requests more help. This +help description has a fixed format in columns. For greater +flexibility, instead of passing a DESCRIPTION, the caller can pass +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. This function translates user input into responses by consulting the bindings in `query-replace-map'; see the documentation of -that variable for more information. In this case, the useful -bindings are `recenter', `scroll-up', `scroll-down', and `edit'. -If the user enters `recenter', `scroll-up', or `scroll-down' -responses, perform the requested window recentering or scrolling -and ask again. If the user enters `edit', start a recursive -edit. When the user exit the recursive edit, the multiple choice -prompt gains focus again. - -When `use-dialog-box' is t (the default), this function can pop -up a dialog window to collect the user input. That functionality -requires `display-popup-menus-p' to return t. Otherwise, a -text dialog will be used. +that variable for more information. The relevant bindings for the +purposes of this function are `recenter', `scroll-up', `scroll-down', +and `edit'. +If the user types the `recenter', `scroll-up', or `scroll-down' +responses, the function performs the requested window recentering or +scrolling, and then asks the question again. If the user enters `edit', +the function starts a recursive edit. When the user exit the recursive +edit, the multiple-choice prompt gains focus again. + +When `use-dialog-box' is t (the default), and the command using this +function was invoked via the mouse, this function pops up a GUI dialog +to collect the user input, but only if Emacs is capable of using GUI +dialogs. Otherwise, the function will always use text-mode dialogs. The return value is the matching entry from the CHOICES list. @@ -146,7 +147,7 @@ Usage example: (save-excursion (message "%s" (substitute-command-keys - "Recursive edit. Resume with \\[exit-recursive-edit]")) + "Recursive edit; type \\[exit-recursive-edit] to return to help screen")) (recursive-edit)))) (t tchar))) (when (eq tchar t) -- cgit v1.2.3