[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 4531b03: New function read-multiple-choice
From: |
Lars Ingebrigtsen |
Subject: |
[Emacs-diffs] master 4531b03: New function read-multiple-choice |
Date: |
Thu, 04 Feb 2016 08:52:12 +0000 |
branch: master
commit 4531b03ec98b50fc61baad2b75f6faf439894583
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>
New function read-multiple-choice
* doc/lispref/commands.texi (Reading One Event): Document
read-multiple-choice.
* lisp/faces.el (read-multiple-choice-face): New face.
* lisp/subr.el (read-multiple-choice): New function.
---
doc/lispref/commands.texi | 21 ++++++++
etc/NEWS | 4 ++
lisp/faces.el | 6 ++
lisp/subr.el | 114 +++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 145 insertions(+), 0 deletions(-)
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 9c1df89..1964ec8 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -2617,6 +2617,27 @@ causes it to evaluate @code{help-form} and display the
result. It
then continues to wait for a valid input character, or keyboard-quit.
@end defun
address@hidden read-multiple-choice prompt choices
+Ask user a multiple choice question. @var{prompt} should be a string
+that will be displayed as the prompt.
+
address@hidden is an alist where the first element in each entry is a
+character to be entered, the second element is a short name for the
+entry to be displayed while prompting (if there's room, it might be
+shortened), and the third, optional entry is a longer explanation that
+will be displayed in a help buffer if the user requests more help.
+
+The return value is the matching value from @var{choices}.
+
address@hidden
+(read-multiple-choice
+ "Continue connecting?"
+ '((?a "always" "Accept this certificate this session and for all future
sessions.")
+ (?s "session only" "Accept this certificate this session only.")
+ (?n "no" "Refuse to use this certificate, and close the connection.")))
address@hidden lisp
address@hidden defun
+
@node Event Mod
@subsection Modifying and Translating Input Events
@cindex modifiers of events
diff --git a/etc/NEWS b/etc/NEWS
index 1f4f989..3b520ec 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -283,6 +283,10 @@ selected window is strongly dedicated to its buffer.
`even-window-sizes' and now handles window widths as well.
+++
+** New function `read-multiple-choice' use to prompt for
+multiple-choice questions, with a handy way to display help texts.
+
++++
** terpri gets an optional arg ENSURE to conditionally output a newline.
+++
diff --git a/lisp/faces.el b/lisp/faces.el
index 612bd16..d80a557 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -2670,6 +2670,12 @@ It is used for characters of no fonts too."
:version "24.1"
:group 'basic-faces)
+(defface read-multiple-choice-face
+ '((t (:inherit bold)))
+ "Face for the symbol name in Apropos output."
+ :group 'basic-faces
+ :version "25.2")
+
;; Faces for TTY menus.
(defface tty-menu-enabled-face
'((t
diff --git a/lisp/subr.el b/lisp/subr.el
index c685f95..db1baf0 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2233,6 +2233,120 @@ keyboard-quit events while waiting for a valid input."
(message "%s%s" prompt (char-to-string char))
char))
+(defun read-multiple-choice (prompt choices)
+ "Ask user a multiple choice question.
+PROMPT should be a string that will be displayed as the prompt.
+
+CHOICES is an alist where the first element in each entry is a
+character to be entered, the second element is a short name for
+the entry to be displayed while prompting (if there's room, it
+might be shortened), and the third, optional entry is a longer
+explanation that will be displayed in a help buffer if the user
+requests more help.
+
+The return value is the matching entry from the CHOICES list.
+
+Usage example:
+
+\(read-multiple-choice \"Continue connecting?\"
+ '((?a \"always\")
+ (?s \"session only\")
+ (?n \"no\")))"
+ (let* ((altered-names nil)
+ (full-prompt
+ (format
+ "%s (%s, ?): "
+ prompt
+ (mapconcat
+ (lambda (elem)
+ (let* ((name (cadr elem))
+ (pos (seq-position name (car elem)))
+ (altered-name
+ (cond
+ ;; Not in the name string.
+ ((not pos)
+ (format "[%c] %s" (car elem) name))
+ ;; The prompt character is in the name, so highlight
+ ;; it on graphical terminals...
+ ((display-graphic-p)
+ (setq name (copy-sequence name))
+ (put-text-property pos (1+ pos)
+ 'face 'read-multiple-choice-face
+ name)
+ name)
+ ;; And put it in [bracket] on non-graphical terminals.
+ (t
+ (concat
+ (substring name 0 pos)
+ "["
+ (upcase (substring name pos (1+ pos)))
+ "]"
+ (substring name (1+ pos)))))))
+ (push (cons (car elem) altered-name)
+ altered-names)
+ altered-name))
+ choices ", ")))
+ tchar buf)
+ (save-window-excursion
+ (save-excursion
+ (while (not tchar)
+ (message "%s" full-prompt)
+ (setq tchar (condition-case nil
+ (read-char)
+ (error nil)))
+ ;; The user has entered an invalid choice, so display the
+ ;; help messages.
+ (when (not (assq tchar choices))
+ (setq tchar nil)
+ (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 (- (* (mod times columns)
+ (+ fill-column 4))
+ (current-column))
+ ?\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)
+ (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)))
+
(defun sit-for (seconds &optional nodisp obsolete)
"Redisplay, then wait for SECONDS seconds. Stop when input is available.
SECONDS may be a floating-point value.
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 4531b03: New function read-multiple-choice,
Lars Ingebrigtsen <=