read-multiple-choice: Add optional argument show-help
* lisp/emacs-lisp/rmc.el (rmc--show-help): Factor out new function from read-multiple-choice. (read-multiple-choice): Add new optional argument show-help. * doc/lispref/commands.texi (Reading One Event): Document above new optional argument.
This commit is contained in:
Stefan Kangas
parent
787030b021
commit
1e7786437d
3 changed files with 77 additions and 55 deletions
|
|
@ -59,8 +59,65 @@
|
|||
(substring name (1+ pos)))))))
|
||||
(cons (car elem) altered-name)))
|
||||
|
||||
(defun rmc--show-help (prompt help-string show-help choices altered-names)
|
||||
(let* ((buf-name (if (stringp show-help)
|
||||
show-help
|
||||
"*Multiple Choice Help*"))
|
||||
(buf (get-buffer-create buf-name)))
|
||||
(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)
|
||||
(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))))))))
|
||||
buf))
|
||||
|
||||
;;;###autoload
|
||||
(defun read-multiple-choice (prompt choices &optional help-string)
|
||||
(defun read-multiple-choice (prompt choices &optional help-string show-help)
|
||||
"Ask user to select an entry from CHOICES, promting with PROMPT.
|
||||
This function allows to ask the user a multiple-choice question.
|
||||
|
||||
|
|
@ -76,6 +133,9 @@ 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.
|
||||
If optional argument SHOW-HELP is non-nil, show the help screen
|
||||
immediately, before any user input. If SHOW-HELP is a string,
|
||||
use it as the name of the help buffer.
|
||||
|
||||
This function translates user input into responses by consulting
|
||||
the bindings in `query-replace-map'; see the documentation of
|
||||
|
|
@ -101,8 +161,8 @@ Usage example:
|
|||
\\='((?a \"always\")
|
||||
(?s \"session only\")
|
||||
(?n \"no\")))"
|
||||
(let* ((altered-names (mapcar #'rmc--add-key-description
|
||||
(append choices '((?? "?")))))
|
||||
(let* ((choices (if show-help choices (append choices '((?? "?")))))
|
||||
(altered-names (mapcar #'rmc--add-key-description choices))
|
||||
(full-prompt
|
||||
(format
|
||||
"%s (%s): "
|
||||
|
|
@ -111,6 +171,9 @@ Usage example:
|
|||
tchar buf wrong-char answer)
|
||||
(save-window-excursion
|
||||
(save-excursion
|
||||
(if show-help
|
||||
(setq buf (rmc--show-help prompt help-string show-help
|
||||
choices altered-names)))
|
||||
(while (not tchar)
|
||||
(message "%s%s"
|
||||
(if wrong-char
|
||||
|
|
@ -166,57 +229,8 @@ Usage example:
|
|||
tchar nil)
|
||||
(when wrong-char
|
||||
(ding))
|
||||
(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)
|
||||
(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))))))))))))
|
||||
(setq buf (rmc--show-help prompt help-string show-help
|
||||
choices altered-names))))))
|
||||
(when (buffer-live-p buf)
|
||||
(kill-buffer buf))
|
||||
(assq tchar choices)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue