From b5a49005af33d8fcd35ca034949920f3ff8c36d6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Mart=C3=ADn?= Date: Wed, 21 Apr 2021 23:14:27 +0200 Subject: [PATCH 1/2] 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(-) diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el index bedf598d44..6aa169c032 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 @@ read-multiple-choice (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 @@ read-multiple-choice ;; 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))) -- 2.31.0