[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 2705fc4 1/2: Extend read-multiple-choice to support free-form hel
|
From: |
Lars Ingebrigtsen |
|
Subject: |
master 2705fc4 1/2: Extend read-multiple-choice to support free-form help descriptions |
|
Date: |
Thu, 6 May 2021 04:28:41 -0400 (EDT) |
branch: master
commit 2705fc4ab05bb81ba8c6fd6469499be32a4ac420
Author: Daniel MartÃn <mardani29@yahoo.es>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
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 bedf598..6aa169c 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)))