branch: externals/compat
commit aa112d8bd04174422cf17a2ee8e9a3dca2e9254b
Author: Philip Kaludercic <phil...@posteo.net>
Commit: Philip Kaludercic <phil...@posteo.net>
Implement lookup-key handling of keymap lists
---
compat-27.1.el | 28 ++++++++++++++++++++++++++++
compat-tests.el | 11 +++++++++++
2 files changed, 39 insertions(+)
diff --git a/compat-27.1.el b/compat-27.1.el
index 46847bd..c55aa77 100644
--- a/compat-27.1.el
+++ b/compat-27.1.el
@@ -105,6 +105,34 @@ Letter-case is significant, but text properties are
ignored."
(when (and redisplay recenter-redisplay)
(redisplay)))
+;;;; Defined in keymap.c
+
+(compat-advise lookup-key (keymap key &optional accept-default)
+ "Look up key sequence KEY in KEYMAP. Return the definition.
+A value of nil means undefined. See doc of `define-key'
+for kinds of definitions.
+
+A number as value means KEY is \"too long\"; that is, characters
+or symbols in it except for the last one fail to be a valid
+sequence of prefix characters in KEYMAP. The number is how many
+characters at the front of KEY it takes to reach a non-prefix
+key. KEYMAP can also be a list of keymaps.
+
+Normally, `lookup-key' ignores bindings for t, which act as default
+bindings, used when nothing else in the keymap applies; this makes it
+usable as a general function for probing keymaps. However, if the
+third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
+recognize the default bindings, just as `read-key-sequence' does."
+ (cond
+ ((keymapp keymap)
+ (funcall oldfun keymap key accept-default))
+ ((listp keymap)
+ (catch 'found
+ (dolist (map keymap)
+ (let ((fn (funcall oldfun map key accept-default)))
+ (when fn (throw 'found fn))))))
+ ((signal 'wrong-type-argument (list 'keymapp keymap)))))
+
;;;; Defined in json.c
(declare-function json-encode-string "json" (object))
diff --git a/compat-tests.el b/compat-tests.el
index 213c9a4..f2a4114 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1295,6 +1295,17 @@ the compatibility function."
(should (equal (gethash "key" obj) ["abc" 2]))
(should (equal (gethash "yek" obj) :null))))))
+(ert-deftest compat-lookup-key ()
+ "Check if `compat-lookup-key' was implemented properly."
+ (let ((a-map (make-sparse-keymap))
+ (b-map (make-sparse-keymap)))
+ (define-key a-map "x" 'foo)
+ (define-key b-map "x" 'bar)
+ (compat-test lookup-key
+ (compat--should* 'foo a-map "x")
+ (compat--should* 'bar b-map "x")
+ (compat--should* 'foo (list a-map b-map) "x")
+ (compat--should* 'bar (list b-map a-map) "x"))))
(provide 'compat-tests)
;;; compat-tests.el ends here
