diff --git a/src/keymap.c b/src/keymap.c index 782931fadf..94d49ac733 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1180,27 +1180,8 @@ DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 3, 0, return FIXNUMP (command) ? Qnil : command; } -/* Value is number if KEY is too long; nil if valid but has no definition. */ -/* GC is possible in this function. */ - -DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, - doc: /* 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. */) - (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) +static Lisp_Object +lookup_key_1 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) { bool t_ok = !NILP (accept_default); @@ -1240,6 +1221,46 @@ DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, } } +/* Value is number if KEY is too long; nil if valid but has no definition. */ +/* GC is possible in this function. */ + +DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, + doc: /* 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. */) + (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) +{ + Lisp_Object found = lookup_key_1 (keymap, key, accept_default); + + /* Since menu definitions sometimes use mixed case identifiers + (notably in old versions of `easy-menu-define'), also look for + the lowercase version. */ + if ((NILP (found) || NUMBERP (found)) + && VECTORP (key) && EQ (AREF (key, 0), Qmenu_bar)) + { + Lisp_Object new_key = Fmake_vector (make_fixnum (ASIZE (key)), Qnil); + for (int i = 0; i < ASIZE (key); i++) + ASET (new_key, i, Fintern (Fdowncase (Fsymbol_name (AREF (key, i))), + Qnil)); + found = lookup_key_1 (keymap, new_key, accept_default); + } + + return found; +} + /* Make KEYMAP define event C as a keymap (i.e., as a prefix). Assume that currently it does not define C at all. Return the keymap. */ diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index a9b0cb502d..19b4013b21 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -124,6 +124,17 @@ keymap-lookup-key/too-long ;; (ert-deftest keymap-lookup-key/accept-default () ;; ...) +(ert-deftest keymap-lookup-key/mixed-case () + (let ((map (make-keymap))) + (define-key map [menu-bar foo bar] 'foo) + (should (eq (lookup-key map [menu-bar foo bar]) 'foo)) + (should (eq (lookup-key map [menu-bar Foo Bar]) 'foo)))) + +(ert-deftest subr-test-lookup-keymap/with-spaces () + (let ((map (make-keymap))) + (define-key map [menu-bar foo-bar] 'foo) + (should (eq (lookup-key map [menu-bar Foo\ Bar]) 'foo)))) + (ert-deftest describe-buffer-bindings/header-in-current-buffer () "Header should be inserted into the current buffer. https://debbugs.gnu.org/39149#31"