procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Extend read-multiple-choice to support free-form help descriptions

Browse source 
* 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.
This commit is contained in:
Daniel Martín 2021-05-06 10:21:59 +02:00 • committed by Lars Ingebrigtsen
parent b8bdf64377
commit 2705fc4ab0
1 changed files with 74 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

129
lisp/emacs-lisp/rmc.el
View file

@ -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)))