[elpa] externals/compat a18351d539 1/3: compat-26: Add read-answer

[ELPA Syncer]

branch: externals/compat
commit a18351d539ac85ae31cd71520afff650ee5856b9
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@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}.