branch: externals/compat
commit a18351d539ac85ae31cd71520afff650ee5856b9
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
compat-26: Add read-answer
---
NEWS.org | 1 +
compat-27.el | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
compat-tests.el | 19 +++++++++++++++++++
compat.texi | 45 +++++++++++++++++++++++++++++++++++++++++++--
4 files changed, 119 insertions(+), 2 deletions(-)
diff --git a/NEWS.org b/NEWS.org
index f1d75124ec..ed6425d2a2 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -6,6 +6,7 @@
- compat-25: Add ~macroexp-parse-body~ and ~macroexp-quote~.
- compat-25: Add ~region-noncontiguous-p~.
- compat-25: Add ~save-mark-and-excursion~.
+- compat-26: Add ~read-answer~.
- compat-26: Add ~region-bounds~.
- compat-27: Add ~date-ordinal-to-time~.
- compat-27: Add ~major-mode-suspend~ and ~major-mode-restore~.
diff --git a/compat-27.el b/compat-27.el
index 0fad7943a7..8c06a5aabb 100644
--- a/compat-27.el
+++ b/compat-27.el
@@ -775,5 +775,61 @@ discarded."
(aset new-vec j (aref old-vec (mod (+ copy-hd j) old-size))))
(setcar ring 0))))))
+;;;; Defined in map-ynp.el
+
+(compat-declare-version "26.2")
+
+(compat-defvar read-answer-short 'auto ;; <compat-tests:read-answer>
+ "If non-nil, the `read-answer' function accepts single-character answers.
+If t, accept short (single key-press) answers to the question.
+If nil, require long answers. If `auto', accept short answers if
+`use-short-answers' is non-nil, or the function cell of `yes-or-no-p'
+is set to `y-or-n-p'.
+
+Note that this variable does not affect calls to the more
+commonly-used `yes-or-no-p' function; it only affects calls to
+the `read-answer' function. To control whether `yes-or-no-p'
+requires a long or a short answer, see the `use-short-answers'
+variable.")
+
+(compat-defun read-answer (question answers) ;; <compat-tests:read-answer>
+ "Read an answer either as a complete word or its character abbreviation.
+Ask user a question and accept an answer from the list of possible answers.
+
+QUESTION should end in a space; this function adds a list of answers to it.
+
+ANSWERS is an alist with elements in the following format:
+ (LONG-ANSWER SHORT-ANSWER HELP-MESSAGE)
+where
+ LONG-ANSWER is a complete answer,
+ SHORT-ANSWER is an abbreviated one-character answer,
+ HELP-MESSAGE is a string describing the meaning of the answer.
+
+SHORT-ANSWER is not necessarily a single character answer. It can be
+also a function key like F1, a character event such as C-M-h, or
+a control character like C-h.
+
+Example:
+ \\='((\"yes\" ?y \"perform the action\")
+ (\"no\" ?n \"skip to the next\")
+ (\"all\" ?! \"accept all remaining without more questions\")
+ (\"help\" ?h \"show help\")
+ (\"quit\" ?q \"exit\"))
+
+When `read-answer-short' is non-nil, accept short answers.
+
+Return a long answer even in case of accepting short ones.
+
+When `use-dialog-box' is t, pop up a dialog window to get user input."
+ ;; NOTE: For simplicity we provide a primitive implementation based on
+ ;; `read-multiple-choice', which does neither support long answers nor the
the
+ ;; gui dialog box.
+ (cadr (read-multiple-choice
+ (string-trim-right question)
+ (delq nil
+ (mapcar (lambda (x) (unless (equal "help" (car x))
+ (list (cadr x) (car x) (caddr x))))
+ answers)))))
+
(provide 'compat-27)
;;; compat-27.el ends here
diff --git a/compat-tests.el b/compat-tests.el
index bb22dbc0ad..431a7ffcc8 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -325,6 +325,25 @@
(setf (image-property image :width) nil)
(should-equal image '(image))))
+(ert-deftest read-answer ()
+ (let ((orig-re (symbol-function #'read-event))
+ (orig-rc (symbol-function #'read-char))
+ (orig-rm (symbol-function #'read-from-minibuffer)))
+ (unwind-protect
+ (dolist (test '(("Choose "
+ ("first" ?a "first description")
+ ("second" ?b "second description")
+ ("third" ?c))
+ ("Do it? " ("yes" ?y) ("no" ?n))))
+ (dolist (choice (cdr test))
+ (fset #'read-char (lambda (&rest _) (cadr choice)))
+ (fset #'read-event (lambda (&rest _) (cadr choice)))
+ (fset #'read-from-minibuffer (lambda (&rest _) (car choice)))
+ (should-equal (car choice) (read-answer (car test) (cdr test)))))
+ (fset #'read-event orig-re)
+ (fset #'read-char orig-rc)
+ (fset #'read-from-minibuffer orig-rm))))
+
(ert-deftest read-multiple-choice ()
(let ((orig-re (symbol-function #'read-event))
(orig-rc (symbol-function #'read-char))
diff --git a/compat.texi b/compat.texi
index 04b8d25788..60528cc3e5 100644
--- a/compat.texi
+++ b/compat.texi
@@ -556,6 +556,49 @@ The following functions and macros are implemented in Emacs
26.1. These functions are made available by Compat on Emacs versions
older than 26.1.
+@c copied from lispref/minibuf.texi
+@defun read-answer question answers
+This function prompts the user with text in @var{question}, which
+should end in the @samp{SPC} character. The function includes in the
+prompt the possible responses in @var{answers} by appending them to
+the end of @var{question}. The possible responses are provided in
+@var{answers} as an alist whose elements are of the following form:
+
+@lisp
+(@var{long-answer} @var{short-answer} @var{help-message})
+@end lisp
+
+@noindent
+where @var{long-answer} is the complete text of the user response, a
+string; @var{short-answer} is a short form of the same response, a
+single character or a function key; and @var{help-message} is the text
+that describes the meaning of the answer. If the variable
+@code{read-answer-short} is non-@code{nil}, the prompt will show the
+short variants of the possible answers and the user is expected to
+type the single characters/keys shown in the prompt; otherwise the
+prompt will show the long variants of the answers, and the user is
+expected to type the full text of one of the answers and end by
+pressing @key{RET}. If @code{use-dialog-box} is non-@code{nil}, and
+this function was invoked by mouse events, the question and the
+answers will be displayed in a GUI dialog box.
+
+The function returns the text of the @var{long-answer} selected by the
+user, regardless of whether long or short answers were shown in the
+prompt and typed by the user.
+
+Here is an example of using this function:
+
+@lisp
+(let ((read-answer-short t))
+ (read-answer "Foo "
+ '(("yes" ?y "perform the action")
+ ("no" ?n "skip to the next")
+ ("all" ?! "perform for the rest without more questions")
+ ("help" ?h "show help")
+ ("quit" ?q "exit"))))
+@end lisp
+@end defun
+
@c copied from lispref/functions.texi
@defun mapcan function sequence
This function applies @var{function} to each element of @var{sequence},
@@ -920,8 +963,6 @@ implemented in 26.1:
@itemize
@item
-The function @code{read-answer}.
-@item
The function @code{func-arity}.
@item
The function @code{secure-hash-algorithms}.
