compat-29: Add set-transient-map

4 files changed, 106 insertions, 0 deletions

diff --git a/NEWS.org b/NEWS.org
index 5337252..c114b3b 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -5,6 +5,7 @@
 - compat-26: Add ~make-temp-file~ with optional argument TEXT.
 - compat-29: Add ~funcall-with-delayed-message~ and ~with-delayed-message~.
 - compat-29: Add ~ert-with-temp-file~ and ~ert-with-temp-directory~.
+- compat-29: Add ~set-transient-map~ with optional arguments MESSAGE and TIMEOUT.
 
 * Release of "Compat" Version 29.1.3.1
 
diff --git a/compat-29.el b/compat-29.el
index fa62c45..97b44f5 100644
--- a/compat-29.el
+++ b/compat-29.el
@@ -416,6 +416,63 @@ CONDITION."
         (push buf bufs)))
     bufs))
 
+(compat-defvar set-transient-map-timeout nil ;; <compat-tests:set-transient-map>
+  "Timeout in seconds for deactivation of a transient keymap.
+If this is a number, it specifies the amount of idle time
+after which to deactivate the keymap set by `set-transient-map',
+thus overriding the value of the TIMEOUT argument to that function.")
+
+(compat-defvar set-transient-map-timer nil ;; <compat-tests:set-transient-map>
+  "Timer for `set-transient-map-timeout'.")
+
+(autoload 'format-spec "format-spec")
+(compat-defun set-transient-map (map &optional keep-pred on-exit message timeout) ;; <compat-tests:set-transient-map>
+  "Handle the optional arguments MESSAGE and TIMEOUT."
+  :extended t
+  (let* ((timeout (or set-transient-map-timeout timeout))
+         (message
+          (when message
+            (let (keys)
+              (map-keymap (lambda (key cmd) (and cmd (push key keys))) map)
+              (format-spec (if (stringp message) message "Repeat with %k")
+                           `((?k . ,(mapconcat
+                                     (lambda (key)
+                                       (substitute-command-keys
+                                        (format "\\`%s'"
+                                                (key-description (vector key)))))
+                                     keys ", ")))))))
+         (clearfun (make-symbol "clear-transient-map"))
+         (exitfun
+          (lambda ()
+            (internal-pop-keymap map 'overriding-terminal-local-map)
+            (remove-hook 'pre-command-hook clearfun)
+            (when message (message ""))
+            (when set-transient-map-timer (cancel-timer set-transient-map-timer))
+            (when on-exit (funcall on-exit)))))
+    (fset clearfun
+          (lambda ()
+            (with-demoted-errors "set-transient-map PCH: %S"
+              (if (cond
+                       ((null keep-pred) nil)
+                       ((and (not (eq map (cadr overriding-terminal-local-map)))
+                             (memq map (cddr overriding-terminal-local-map)))
+                        t)
+                       ((eq t keep-pred)
+                        (let ((mc (lookup-key map (this-command-keys-vector))))
+                          (when (and mc (symbolp mc))
+                            (setq mc (or (command-remapping mc) mc)))
+                          (and mc (eq this-command mc))))
+                       (t (funcall keep-pred)))
+                  (when message (message "%s" message))
+                (funcall exitfun)))))
+    (add-hook 'pre-command-hook clearfun)
+    (internal-push-keymap map 'overriding-terminal-local-map)
+    (when timeout
+      (when set-transient-map-timer (cancel-timer set-transient-map-timer))
+      (setq set-transient-map-timer (run-with-idle-timer timeout nil exitfun)))
+    (when message (message "%s" message))
+    exitfun))
+
 ;;;; Defined in simple.el
 
 (compat-defun use-region-noncontiguous-p () ;; <compat-tests:region-noncontiguous-p>
diff --git a/compat-tests.el b/compat-tests.el
index 11e108c..2e2d0d2 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -2875,6 +2875,15 @@
   (should-equal 'result (funcall-with-delayed-message
                          1 "timeout" (lambda () 'result))))
 
+(ert-deftest set-transient-map ()
+  (let (overriding-terminal-local-map)
+    ;; TODO Implement a proper test.  Interactive features like
+    ;; `set-transient-map' are hard to test and Emacs itself is lacking tests.
+    ;; For now only test the calling convention here.
+    (set-transient-map (define-keymap "x" #'ignore))
+    (compat-call set-transient-map (define-keymap "x" #'ignore))
+    (compat-call set-transient-map (define-keymap "x" #'ignore) nil nil "msg" 1)))
+
 (ert-deftest ert-with-temp-file ()
   (ert-with-temp-file file
     (should-not (directory-name-p file))
diff --git a/compat.texi b/compat.texi
index e323c59..b5fd2dc 100644
--- a/compat.texi
+++ b/compat.texi
@@ -2912,6 +2912,45 @@ The same keyword arguments are supported as in
 These functions must be called explicitly via @code{compat-call},
 since their calling convention or behavior was extended in Emacs 29.1:
 
+@c copied from lispref/keymaps.texi
+@defun compat-call@ set-transient-map keymap &optional keep-pred on-exit message timeout
+This function adds @var{keymap} as a @dfn{transient} keymap, which
+takes precedence over other keymaps for one (or more) subsequent keys.
+
+Normally, @var{keymap} is used just once, to look up the very next key.
+If the optional argument @var{keep-pred} is @code{t}, the map stays
+active as long as the user types keys defined in @var{keymap}; when the
+user types a key that is not in @var{keymap}, the transient keymap is
+deactivated and normal key lookup continues for that key.
+
+The @var{keep-pred} argument can also be a function.  In that case, the
+function is called with no arguments, prior to running each command,
+while @var{keymap} is active; it should return non-@code{nil} if
+@var{keymap} should stay active.
+
+The optional argument @var{on-exit}, if non-@code{nil}, specifies a
+function that is called, with no arguments, after @var{keymap} is
+deactivated.
+
+The optional argument @var{message} specifies the message to display
+after activating the transient map.  If @var{message} is a string, it
+is the format string for the message, and any @samp{%k} specifier in
+that string is replaced with the list of keys from the transient map.
+Any other non-@code{nil} value of @var{message} stands for the default
+message format @samp{Repeat with %k}.
+
+@vindex set-transient-map-timeout
+If the optional argument @var{timeout} is non-@code{nil}, it should be
+a number that specifies how many seconds of idle time to wait before
+deactivating @var{keymap}.  The value of the variable
+@code{set-transient-map-timeout}, if non-@code{nil}, overrides the
+value of this argument.
+
+This function works by adding and removing @var{keymap} from the
+variable @code{overriding-terminal-local-map}, which takes precedence
+over all other active keymaps (@pxref{elisp,,,Searching Keymaps}).
+@end defun
+
 @c copied from lispref/strings.texi
 @defun compat-call@ string-lines string &optional omit-nulls keep-newlines
 Split @var{string} into a list of strings on newline boundaries.  If