From 7060128663ebb74ccf659bd1ee6dc38f7c66ba9e Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 13 Oct 2021 00:04:23 +0200 Subject: [PATCH] Be more allowing when looking for menu-bar items * src/keymap.c (lookup_key_1): Factor out function from Flookup_key. (Flookup_key): Be case insensitive, and treat spaces as dashes, when looking for Qmenu_bar items. (Bug#50752) * test/src/keymap-tests.el (keymap-lookup-key/mixed-case) (keymap-lookup-key/mixed-case-multibyte) (keymap-lookup-keymap/with-spaces) (keymap-lookup-keymap/with-spaces-multibyte) (keymap-lookup-keymap/with-spaces-multibyte-lang-env): New tests. --- etc/NEWS | 8 +++ src/keymap.c | 125 ++++++++++++++++++++++++++++++++------- test/src/keymap-tests.el | 43 ++++++++++++++ 3 files changed, 155 insertions(+), 21 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index b7c4346db9..cb3a0c3ec4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -4319,6 +4319,14 @@ The new optional "," parameter has been added, and ** 'parse-time-string' can now parse ISO 8601 format strings. These have a format like "2020-01-15T16:12:21-08:00". +--- +** 'lookup-key' now downcases symbols in extended menu items. +If looking for a key like '[menu-bar Foo-Bar]', attempt to find +'[menu-bar foo-bar]' as well. If looking for a key like '[menu-bar +Foo\ Bar]', attempt to find both '[menu-bar foo\ bar]' and '[menu-bar +foo-bar]'. This improves backwards compatibility when menus are +converted to use 'easy-menu-define'. + --- ** 'make-network-process', 'make-serial-process' ':coding' behavior change. Previously, passing ':coding nil' to either of these functions would diff --git a/src/keymap.c b/src/keymap.c index be45d2be1e..4b3d50f53e 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,108 @@ 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); + + if (!NILP (found) && !NUMBERP (found)) + return found; + + /* Menu definitions might use mixed case symbols (notably in old + versions of `easy-menu-define'), or use " " instead of "-". + We accept these variations for backwards-compatibility. + (Bug#50752) */ + if (VECTORP (key) && ASIZE (key) > 0 && EQ (AREF (key, 0), Qmenu_bar)) + { + ptrdiff_t key_len = ASIZE (key); + Lisp_Object new_key = make_vector (key_len, Qnil); + + /* Try both the default ASCII case table, and the buffer local + one. Otherwise, we will fail for e.g. the "Turkish" language + environment where 'I' does not downcase to 'i'. */ + Lisp_Object old_case_table = Fcurrent_case_table (); + Lisp_Object tables[2] = {Vascii_downcase_table, old_case_table}; + for (int i = 0; i < 2; i++) + { + Fset_case_table (tables[i]); + + /* First, let's try converting all symbols like "Foo-Bar-Baz" to + "foo-bar-baz". */ + for (int i = 0; i < key_len; i++) + { + Lisp_Object lc_key = Fdowncase (Fsymbol_name (AREF (key, i))); + ASET (new_key, i, Fintern (lc_key, Qnil)); + } + found = lookup_key_1 (keymap, new_key, accept_default); + + if (!NILP (found) && !NUMBERP (found)) + break; + + /* If we still don't have a match, let's convert any spaces in + our lowercased string into dashes, e.g. "foo bar baz" to + "foo-bar-baz". */ + for (int i = 0; i < key_len; i++) + { + Lisp_Object lc_key = Fsymbol_name (AREF (new_key, i)); + + /* If there are no spaces in this symbol, just skip it. */ + if (!strstr (SSDATA (lc_key), " ")) + continue; + + USE_SAFE_ALLOCA; + ptrdiff_t size = SCHARS (lc_key), n; + if (INT_MULTIPLY_WRAPV (size, MAX_MULTIBYTE_LENGTH, &n)) + n = PTRDIFF_MAX; + unsigned char *dst = SAFE_ALLOCA (n); + + /* We can walk the string data byte by byte, because UTF-8 + encoding ensures that no other byte of any multibyte + sequence will ever include a 7-bit byte equal to an ASCII + single-byte character. */ + memcpy (dst, SSDATA (lc_key), SBYTES (lc_key)); + for (int i = 0; i < SBYTES (lc_key); ++i) + { + if (*(dst + i) == ' ') + *(dst + i) = '-'; + } + + Lisp_Object + new_it = make_multibyte_string ((char *) dst, SCHARS (lc_key), SBYTES (lc_key)); + ASET (new_key, i, Fintern (new_it, Qnil)); + SAFE_FREE (); + } + found = lookup_key_1 (keymap, new_key, accept_default); + + if (!NILP (found) && !NUMBERP (found)) + break; + } + /* Restore the previous case table before returning. */ + Fset_case_table (old_case_table); + } + + 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 68b42c346c..a7480fe5cc 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -124,6 +124,49 @@ keymap-lookup-key/too-long ;; (ert-deftest keymap-lookup-key/accept-default () ;; ...) +(ert-deftest keymap-lookup-key/mixed-case () + "Backwards compatibility behaviour (Bug#50752)." + (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))) + (let ((map (make-keymap))) + (define-key map [menu-bar i-bar] 'foo) + (should (eq (lookup-key map [menu-bar I-bar]) 'foo)))) + +(ert-deftest keymap-lookup-key/mixed-case-multibyte () + "Backwards compatibility behaviour (Bug#50752)." + (let ((map (make-keymap))) + ;; (downcase "Åäö") => "åäö" + (define-key map [menu-bar åäö bar] 'foo) + (should (eq (lookup-key map [menu-bar åäö bar]) 'foo)) + (should (eq (lookup-key map [menu-bar Åäö Bar]) 'foo)) + ;; (downcase "Γ") => "γ" + (define-key map [menu-bar γ bar] 'baz) + (should (eq (lookup-key map [menu-bar γ bar]) 'baz)) + (should (eq (lookup-key map [menu-bar Γ Bar]) 'baz)))) + +(ert-deftest keymap-lookup-keymap/with-spaces () + "Backwards compatibility behaviour (Bug#50752)." + (let ((map (make-keymap))) + (define-key map [menu-bar foo-bar] 'foo) + (should (eq (lookup-key map [menu-bar Foo\ Bar]) 'foo)))) + +(ert-deftest keymap-lookup-keymap/with-spaces-multibyte () + "Backwards compatibility behaviour (Bug#50752)." + (let ((map (make-keymap))) + (define-key map [menu-bar åäö-bar] 'foo) + (should (eq (lookup-key map [menu-bar Åäö\ Bar]) 'foo)))) + +(ert-deftest keymap-lookup-keymap/with-spaces-multibyte-lang-env () + "Backwards compatibility behaviour (Bug#50752)." + (let ((lang-env current-language-environment)) + (set-language-environment "Turkish") + (let ((map (make-keymap))) + (define-key map [menu-bar i-bar] 'foo) + (should (eq (lookup-key map [menu-bar I-bar]) 'foo))) + (set-language-environment lang-env))) + (ert-deftest describe-buffer-bindings/header-in-current-buffer () "Header should be inserted into the current buffer. https://debbugs.gnu.org/39149#31" -- 2.30.2