From: Stefan Kangas <stefan@marxist.se>
To: Eli Zaretskii <eliz@gnu.org>
Cc: shuguang79@qq.com, larsi@gnus.org, 50752@debbugs.gnu.org
Subject: bug#50752: 28.0.50; easy-menu-define lowers the menu-bar key
Date: Tue, 19 Oct 2021 14:54:59 -0700 [thread overview]
Message-ID: <CADwFkmketerEimYJsrAzZO1MjhXsmFOBG1r84F+EhWJGDf7b1A@mail.gmail.com> (raw)
In-Reply-To: <83sfwxck9r.fsf@gnu.org>
[-- Attachment #1: Type: text/plain, Size: 301 bytes --]
Eli Zaretskii <eliz@gnu.org> writes:
> Don't give up, you are close.
Thank you! Your feedback so far has been extremely useful and much
appreciated.
Based on your comments, I have been able to come up with the attached
patch. It bootstraps and all tests pass.
Please let me know what you think.
[-- Attachment #2: 0001-Be-more-allowing-when-looking-for-menu-bar-items.patch --]
[-- Type: text/x-diff, Size: 11250 bytes --]
From 67d08470b9a07da2053a562879e222a456098e2b Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefan@marxist.se>
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 | 162 ++++++++++++++++++++++++++++++++++-----
test/src/keymap-tests.el | 43 +++++++++++
3 files changed, 192 insertions(+), 21 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 7031be311e..b47939305f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -4320,6 +4320,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' is more allowing when searching for extended menu items.
+When looking for a menu item '[menu-bar Foo-Bar]', first try to find
+an exact match, then look for the lowercased '[menu-bar foo-bar]'.
+When looking for a menu item with a symbol containing spaces, as in
+'[menu-bar Foo\ Bar]', look for an exact match , then look for both
+'[menu-bar foo\ bar]' and '[menu-bar foo-bar]'.
+
---
** '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..75422caf48 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -65,6 +65,9 @@
/* Pre-allocated 2-element vector for Fcommand_remapping to use. */
static Lisp_Object command_remapping_vector;
+/* Char table for the backwards-compatibility part in Flookup_key. */
+Lisp_Object unicode_case_table;
+
/* Hash table used to cache a reverse-map to speed up calls to where-is. */
static Lisp_Object where_is_cache;
/* Which keymaps are reverse-stored in the cache. */
@@ -1180,27 +1183,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 +1224,140 @@ 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 "-".
+ The rest of this function is about accepting these variations for
+ backwards-compatibility. (Bug#50752) */
+
+ /* Just skip everything below unless this is a menu item. */
+ if (!VECTORP (key) || !(ASIZE (key) > 0)
+ || !EQ (AREF (key, 0), Qmenu_bar))
+ return found;
+
+ /* Initialize the unicode case table, if it wasn't already. */
+ if (NILP (unicode_case_table))
+ unicode_case_table = uniprop_table (intern ("lowercase"));
+
+ ptrdiff_t key_len = ASIZE (key);
+ Lisp_Object new_key = make_vector (key_len, Qnil);
+
+ /* Try both the Unicode 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 tables[2] = {unicode_case_table, Fcurrent_case_table ()};
+ for (int tbl_num = 0; tbl_num < 2; tbl_num++)
+ {
+ /* 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 key_item = Fsymbol_name (AREF (key, i));
+ Lisp_Object new_item;
+ if (!STRING_MULTIBYTE (key_item))
+ {
+ new_item = Fdowncase (key_item);
+ }
+ else
+ {
+ USE_SAFE_ALLOCA;
+ ptrdiff_t size = SCHARS (key_item), n;
+ if (INT_MULTIPLY_WRAPV (size, MAX_MULTIBYTE_LENGTH, &n))
+ n = PTRDIFF_MAX;
+ unsigned char *dst = SAFE_ALLOCA (n);
+ unsigned char *p = dst;
+ ptrdiff_t j_char = 0, j_byte = 0;
+
+ while (j_char < size)
+ {
+ int ch = fetch_string_char_advance (key_item, &j_char, &j_byte);
+ Lisp_Object ch_conv = CHAR_TABLE_REF (tables[tbl_num], ch);
+ if (!NILP (ch_conv))
+ CHAR_STRING (XFIXNUM (ch_conv), p);
+ else
+ CHAR_STRING (ch, p);
+ p = dst + j_byte;
+ }
+ new_item = make_multibyte_string ((char *) dst,
+ SCHARS (key_item),
+ SBYTES (key_item));
+ SAFE_FREE ();
+ }
+ ASET (new_key, i, Fintern (new_item, Qnil));
+ }
+
+ /* Check for match. */
+ 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 ();
+ }
+
+ /* Check for match. */
+ found = lookup_key_1 (keymap, new_key, accept_default);
+ if (!NILP (found) && !NUMBERP (found))
+ break;
+ }
+
+ 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. */
@@ -3210,6 +3328,8 @@ syms_of_keymap (void)
intern_c_string ("mouse-4"),
intern_c_string ("mouse-5"));
+ staticpro (&unicode_case_table);
+
/* Keymap used for minibuffers when doing completion. */
/* Keymap used for minibuffers when doing completion and require a match. */
DEFSYM (Qkeymapp, "keymapp");
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
next prev parent reply other threads:[~2021-10-19 21:54 UTC|newest]
Thread overview: 63+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-09-23 8:39 bug#50752: 28.0.50; easy-menu-define lowers the menu-bar key Shuguang Sun via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-09-23 17:15 ` Juri Linkov
2021-09-23 21:45 ` Lars Ingebrigtsen
2021-10-12 22:22 ` Stefan Kangas
2021-10-13 11:28 ` Lars Ingebrigtsen
2021-10-13 11:59 ` Eli Zaretskii
2021-10-13 12:04 ` Lars Ingebrigtsen
2021-10-13 12:19 ` Stefan Kangas
2021-10-13 12:58 ` Lars Ingebrigtsen
2021-10-13 15:26 ` Stefan Kangas
2021-10-13 15:42 ` Lars Ingebrigtsen
2021-10-19 3:22 ` Stefan Kangas
2021-10-19 3:40 ` Lars Ingebrigtsen
2021-10-19 3:52 ` Lars Ingebrigtsen
2021-10-19 11:56 ` Eli Zaretskii
2021-10-19 12:07 ` Lars Ingebrigtsen
2021-10-19 12:17 ` Lars Ingebrigtsen
2021-10-19 12:37 ` Eli Zaretskii
2021-10-19 12:45 ` Lars Ingebrigtsen
2021-10-19 13:24 ` Lars Ingebrigtsen
2021-10-19 16:01 ` Eli Zaretskii
2021-10-19 15:41 ` Eli Zaretskii
2021-10-19 15:57 ` Lars Ingebrigtsen
2021-10-19 16:12 ` Eli Zaretskii
2021-10-19 16:15 ` Lars Ingebrigtsen
2021-10-19 16:21 ` Lars Ingebrigtsen
2021-10-19 16:30 ` Eli Zaretskii
2021-10-19 17:12 ` Lars Ingebrigtsen
2021-10-19 17:37 ` Eli Zaretskii
2021-10-19 18:21 ` Lars Ingebrigtsen
2021-10-20 11:28 ` Eli Zaretskii
2021-10-20 11:55 ` Glenn Morris
2021-10-24 20:11 ` Stefan Kangas
2021-10-25 13:06 ` Lars Ingebrigtsen
2021-10-25 13:19 ` Eli Zaretskii
2021-10-25 13:21 ` Lars Ingebrigtsen
2021-10-25 13:51 ` Eli Zaretskii
2021-10-25 13:55 ` Lars Ingebrigtsen
2021-10-25 14:12 ` Eli Zaretskii
2021-10-26 8:38 ` Stefan Kangas
2021-10-26 13:04 ` Eli Zaretskii
2021-10-26 20:24 ` Stefan Kangas
2021-10-27 14:00 ` Eli Zaretskii
2021-10-28 5:29 ` Stefan Kangas
2021-10-28 7:33 ` Eli Zaretskii
2021-10-28 8:06 ` Stefan Kangas
2021-10-28 9:35 ` Eli Zaretskii
2021-10-28 10:49 ` Stefan Kangas
2021-10-28 12:49 ` Eli Zaretskii
2021-10-28 20:44 ` Stefan Kangas
2021-10-21 2:45 ` Lars Ingebrigtsen
2021-10-21 7:26 ` Eli Zaretskii
2021-10-21 13:04 ` Lars Ingebrigtsen
2021-10-20 7:45 ` Lars Ingebrigtsen
2021-10-20 12:24 ` Eli Zaretskii
2021-10-19 11:43 ` Eli Zaretskii
2021-10-19 21:54 ` Stefan Kangas [this message]
2021-10-20 12:59 ` Eli Zaretskii
2021-10-13 16:09 ` Eli Zaretskii
2021-10-15 5:59 ` Eli Zaretskii
2021-10-15 18:34 ` Stefan Kangas
2021-10-19 3:18 ` Stefan Kangas
2021-09-23 22:28 ` Glenn Morris
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=CADwFkmketerEimYJsrAzZO1MjhXsmFOBG1r84F+EhWJGDf7b1A@mail.gmail.com \
--to=stefan@marxist.se \
--cc=50752@debbugs.gnu.org \
--cc=eliz@gnu.org \
--cc=larsi@gnus.org \
--cc=shuguang79@qq.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).