From d6c124930a7b54f222d3cef79e11b66eb4a188f5 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 | 119 ++++++++++++++++++++++------------------- 1 file changed, 65 insertions(+), 54 deletions(-) diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el index bedf598d44..2c4c13ae1c 100644 --- a/lisp/emacs-lisp/rmc.el +++ b/lisp/emacs-lisp/rmc.el @@ -26,7 +26,7 @@ (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. @@ -35,15 +35,18 @@ read-multiple-choice 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. +help. This help description has a fixed format in columns, but +the user can control the text that is displayed and how it is +formatted with optional argument HELP-STRING. 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', a recursive edit is +started. 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 +136,10 @@ 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-excursion + (save-window-excursion + (recursive-edit)))) (t tchar))) (when (eq tchar t) (setq wrong-char nil @@ -141,57 +148,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)))) - (goto-char start) - (dolist (line (split-string text "\n")) - (end-of-line) - (if (bolp) - (insert line "\n") - (insert line)) - (forward-line 1))))))))))) + (let ((buf (get-buffer-create "*Multiple Choice Help*"))) + (if 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))))))))))))) (when (buffer-live-p buf) (kill-buffer buf)) (assq tchar choices))) -- 2.31.0