[elpa] externals/compat 2c331ee067 1/2: compat-tests: Fix and test read-multiple-choice

[ELPA Syncer]

branch: externals/compat
commit 2c331ee0675714da7458bf4c04b57f183692b16e
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    compat-tests: Fix and test read-multiple-choice
---
 NEWS.org        |  1 +
 compat-26.el    | 44 +++++++++++++++-----------------------------
 compat-tests.el | 23 +++++++++++++++++++++++
 compat.texi     | 12 +-----------
 4 files changed, 40 insertions(+), 40 deletions(-)

diff --git a/NEWS.org b/NEWS.org
index 9255ee57cb..f1539c3fdd 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -16,6 +16,7 @@
   recent Emacs 29 the byte compiled files are empty and not loaded, such that
   Compat does not any cost to the Emacs process.
 - compat-26: Fix and test ~image-property~ setter.
+- compat-26: Fix and test ~read-multiple-choice~.
 - compat-28: Fix and test ~with-existing-directory~.
 - compat-29: Drop broken functions ~string-pixel-width~ and
   ~buffer-text-pixel-size~. These functions had poor performance which lead to 
a
diff --git a/compat-26.el b/compat-26.el
index e645371ec0..c3893ec6ca 100644
--- a/compat-26.el
+++ b/compat-26.el
@@ -481,8 +481,7 @@ If VALUE is nil, PROPERTY is removed from IMAGE."
 
 ;;;; Defined in rmc.el
 
-(compat-defun read-multiple-choice ;; <UNTESTED>
-    (prompt choices &optional _help-string _show-help long-form)
+(compat-defun read-multiple-choice (prompt choices) ;; <OK>
   "Ask user to select an entry from CHOICES, promting with PROMPT.
 This function allows to ask the user a multiple-choice question.
 
@@ -491,36 +490,23 @@ KEY is a character the user should type to select the 
entry.
 NAME is a short name for the entry to be displayed while prompting
 \(if there's no room, it might be shortened).
 
-If LONG-FORM, do a `completing-read' over the NAME elements in
-CHOICES instead.
-
 NOTE: This is a partial implementation of `read-multiple-choice', that
 among other things doesn't offer any help and ignores the
 optional DESCRIPTION field."
-  (if long-form
-      (let ((options (mapconcat #'cadr choices "/"))
-            choice)
-        (setq prompt (concat prompt " (" options "): "))
-        (setq choice (completing-read prompt (mapcar #'cadr choices) nil t))
-        (catch 'found
-          (dolist (option choices)
-            (when (string= choice (cadr option))
-              (throw 'found option)))
-          (error "Invalid choice")))
-    (let ((options
-           (mapconcat
-            (lambda (opt)
-              (format
-               "[%s] %s"
-               (key-description (string (car opt)))
-               (cadr opt)))
-            choices " "))
-          choice)
-      (setq prompt (concat prompt " (" options "): "))
-      (while (not (setq choice (assq (read-char prompt) choices)))
-        (message "Invalid choice")
-        (sit-for 1))
-      choice)))
+  (let ((options
+         (mapconcat
+          (lambda (opt)
+            (format
+             "[%s] %s"
+             (key-description (string (car opt)))
+             (cadr opt)))
+          choices " "))
+        choice)
+    (setq prompt (concat prompt " (" options "): "))
+    (while (not (setq choice (assq (read-event prompt) choices)))
+      (message "Invalid choice")
+      (sit-for 1))
+    choice))
 
 (provide 'compat-26)
 ;;; compat-26.el ends here
diff --git a/compat-tests.el b/compat-tests.el
index c70a0c06a2..9fa7c0fa20 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -79,6 +79,29 @@
     (setf (image-property image :width) nil)
     (should-equal image '(image))))
 
+(ert-deftest read-multiple-choice ()
+  (let ((orig-re (symbol-function #'read-event))
+        (orig-rc (symbol-function #'read-char))
+        ;;(orig-cr completing-read-function)
+        )
+    (unwind-protect
+        (dolist (test '(("Choose"
+                         (?a "first" "first description")
+                         (?b "second" "second description")
+                         (?c "third"))
+                        ("Do it?" (?y "yes") (?n "no"))))
+          (dolist (choice (cdr test))
+            (fset #'read-char (lambda (&rest _) (car choice)))
+            (fset #'read-event (lambda (&rest _) (car choice)))
+            ;; TODO long form support
+            ;;(setq completing-read-function (lambda (&rest _) (cadr choice)))
+            ;;(should-equal choice (read-multiple-choice (car test) (cdr test) 
nil nil 'long))
+            (should-equal choice (read-multiple-choice (car test) (cdr 
test)))))
+      (fset #'read-event orig-re)
+      (fset #'read-char orig-rc)
+      ;;(setq completing-read-function orig-cr)
+      )))
+
 (ert-deftest with-environment-variables ()
   (let ((A "COMPAT_TESTS__VAR") (B "/foo/bar"))
     (should-not (getenv A))
diff --git a/compat.texi b/compat.texi
index 5ee16cf51e..0fa277e900 100644
--- a/compat.texi
+++ b/compat.texi
@@ -590,7 +590,7 @@ Processes,,,elisp}), and as the program to run on the 
remote host.  If
 @xref{Magic File Names,,,elisp}.
 @end defun
 
-@defun read-multiple-choice prompt choices &optional help-string show-help 
long-form
+@defun read-multiple-choice prompt choices
 Ask user a multiple choice question.  @var{prompt} should be a string
 that will be displayed as the prompt.
 
@@ -600,16 +600,6 @@ 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.
 
-If optional argument @var{long-form} is non-@code{nil}, the user
-will have to type in long-form answers (using @code{completing-read})
-instead of hitting a single key.  The answers must be among the second
-elements of the values in the @var{choices} list.
-
-@b{Note:} The Compat implementation of this function ignores the
-optional arguments @var{help-string} and @var{show-help}.  Therefore the
-optional third element in each @var{choices} entry will also be
-disregarded.
-
 See @ref{Reading One Event,Reading One Event,,elisp,}.
 @end defun