[elpa] externals/compat 191c333905: compat-27: Add read-char-from-minibuffer

[ELPA Syncer]

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

    compat-27: Add read-char-from-minibuffer
---
 NEWS.org        |  1 +
 compat-27.el    | 92 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 compat-tests.el | 10 +++++++
 compat.texi     | 15 ++++++++--
 4 files changed, 116 insertions(+), 2 deletions(-)

diff --git a/NEWS.org b/NEWS.org
index 2054ca669c..ca8b6dfde3 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -13,6 +13,7 @@
 - compat-27: Add ~major-mode-suspend~ and ~major-mode-restore~.
 - compat-27: Add ~make-decoded-time~.
 - compat-27: Add ~minibuffer-history-value~.
+- compat-27: Add ~read-char-from-minibuffer~.
 - compat-27: Add ~ring-resize~.
 - compat-28: Add ~color-dark-p~.
 - compat-28: Add ~directory-files-and-attributes~ with COUNT argument.
diff --git a/compat-27.el b/compat-27.el
index 233577877d..102abf1f1c 100644
--- a/compat-27.el
+++ b/compat-27.el
@@ -255,6 +255,98 @@ though trying to avoid AVOIDED-MODES."
              alist)))
       (normal-mode))))
 
+(compat-defun read-char-from-minibuffer-insert-char () ;; 
<compat-tests:read-char-from-minibuffer>
+  "Insert the character you type into the minibuffer and exit minibuffer.
+Discard all previous input before inserting and exiting the minibuffer."
+  (interactive)
+  (when (minibufferp)
+    (delete-minibuffer-contents)
+    (insert last-command-event)
+    (exit-minibuffer)))
+
+(compat-defun read-char-from-minibuffer-insert-other () ;; 
<compat-tests:read-char-from-minibuffer>
+  "Reject a disallowed character typed into the minibuffer.
+This command is intended to be bound to keys that users are not
+allowed to type into the minibuffer.  When the user types any
+such key, this command discard all minibuffer input and displays
+an error message."
+  (interactive)
+  (when (minibufferp)
+    (delete-minibuffer-contents)
+    (ding)
+    (discard-input)
+    (minibuffer-message "Wrong answer")
+    (sit-for 2)))
+
+(compat-defvar read-char-history nil ;; 
<compat-tests:read-char-from-minibuffer>
+  "The default history for the `read-char-from-minibuffer' function.")
+
+(compat-defvar read-char-from-minibuffer-map ;; 
<compat-tests:read-char-from-minibuffer>
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map minibuffer-local-map)
+    (define-key map [remap self-insert-command] 
#'read-char-from-minibuffer-insert-char)
+    (define-key map [remap exit-minibuffer] 
#'read-char-from-minibuffer-insert-other)
+    map)
+  "Keymap for the `read-char-from-minibuffer' function.")
+
+(compat-defvar read-char-from-minibuffer-map-hash  ;; 
<compat-tests:read-char-from-minibuffer>
+  (make-hash-table :test 'equal)
+  "Hash table of keymaps used by `read-char-from-minibuffer'."
+  :constant t)
+
+(compat-defun read-char-from-minibuffer (prompt &optional chars history) ;; 
<compat-tests:read-char-from-minibuffer>
+  "Read a character from the minibuffer, prompting for it with PROMPT.
+Like `read-char', but uses the minibuffer to read and return a character.
+Optional argument CHARS, if non-nil, should be a list of characters;
+the function will ignore any input that is not one of CHARS.
+Optional argument HISTORY, if non-nil, should be a symbol that
+specifies the history list variable to use for navigating in input
+history using \\`M-p' and \\`M-n', with \\`RET' to select a character from
+history.
+If you bind the variable `help-form' to a non-nil value
+while calling this function, then pressing `help-char'
+causes it to evaluate `help-form' and display the result.
+There is no need to explicitly add `help-char' to CHARS;
+`help-char' is bound automatically to `help-form-show'."
+  (let* ((map (if (consp chars)
+                  (or (gethash (list help-form (cons help-char chars))
+                               read-char-from-minibuffer-map-hash)
+                      (let ((map (make-sparse-keymap))
+                            (msg help-form))
+                        (set-keymap-parent map read-char-from-minibuffer-map)
+                        ;; If we have a dynamically bound `help-form'
+                        ;; here, then the `C-h' (i.e., `help-char')
+                        ;; character should output that instead of
+                        ;; being a command char.
+                        (when help-form
+                          (define-key map (vector help-char)
+                            (lambda ()
+                              (interactive)
+                              (let ((help-form msg)) ; lexically bound msg
+                                (help-form-show)))))
+                        (dolist (char chars)
+                          (define-key map (vector char)
+                            #'read-char-from-minibuffer-insert-char))
+                        (define-key map [remap self-insert-command]
+                          #'read-char-from-minibuffer-insert-other)
+                        (puthash (list help-form (cons help-char chars))
+                                 map read-char-from-minibuffer-map-hash)
+                        map))
+                read-char-from-minibuffer-map))
+         ;; Protect this-command when called from pre-command-hook (bug#45029)
+         (this-command this-command)
+         (result (read-from-minibuffer prompt nil map nil (or history t)))
+         (char
+          (if (> (length result) 0)
+              ;; We have a string (with one character), so return the first 
one.
+              (elt result 0)
+            ;; The default value is RET.
+            (when history (push "\r" (symbol-value history)))
+            ?\r)))
+    ;; Display the question with the answer.
+    (message "%s%s" prompt (char-to-string char))
+    char))
+
 ;;;; Defined in simple.el
 
 (compat-guard (not (fboundp 'decoded-time-second))
diff --git a/compat-tests.el b/compat-tests.el
index 5684aeb5ba..68451f7e87 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -364,6 +364,16 @@
       (fset #'read-char orig-rc)
       (setq completing-read-function orig-cr))))
 
+(ert-deftest read-char-from-minibuffer ()
+  (let ((orig (symbol-function #'read-from-minibuffer)))
+    (unwind-protect
+        (progn
+          (fset #'read-from-minibuffer (lambda (&rest _) "a"))
+          (should-equal ?a (read-char-from-minibuffer "Prompt: " '(?a ?b ?c) 
'read-char-history))
+          (should-equal ?a (read-char-from-minibuffer "Prompt: " '(?a ?b ?c)))
+          (should-equal ?a (read-char-from-minibuffer "Prompt: ")))
+      (fset #'read-from-minibuffer orig))))
+
 (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 fd03115ee8..25da519b2f 100644
--- a/compat.texi
+++ b/compat.texi
@@ -1052,6 +1052,19 @@ window. When used in a minibuffer window, select the 
window selected
 just before the minibuffer was activated, and execute the forms.
 @end defmac
 
+@c copied from lispref/minbuf.texi
+@defun read-char-from-minibuffer prompt &optional chars history
+This function uses the minibuffer to read and return a single
+character.  Optionally, it ignores any input that is not a member of
+@var{chars}, a list of accepted characters.  The @var{history}
+argument specifies the history list symbol to use; if it is omitted or
+@code{nil}, this function doesn't use the history.
+
+If you bind @code{help-form} to a non-@code{nil} value while calling
+@code{read-char-from-minibuffer}, then pressing @code{help-char}
+causes it to evaluate @code{help-form} and display the result.
+@end defun
+
 @c copied from lispref/numbers.texi
 @defun bignump object
 This predicate tests whether its argument is a large integer, and
@@ -1540,8 +1553,6 @@ All @code{iso8601-*} functions.
 @item
 The macro @code{benchmark-progn}.
 @item
-The function @code{read-char-from-minibuffer}.
-@item
 The macro @code{with-suppressed-warnings}.
 @item
 Support for @code{condition-case} to handle t.