bug#50752: 28.0.50; easy-menu-define lowers the menu-bar key

[Stefan Kangas <stefan@marxist.se>]

[-- Attachment #1: Type: text/plain, Size: 639 bytes --]

Eli Zaretskii <eliz@gnu.org> writes:

>> I think just downcasing ASCII would get use more than 99%, really.
>
> Then let's go with this variant on emacs-28, and leave the full
> solution for master.

OK.  I'm not sure if you just mean my previous patch, but without Lars'
fixes for the Turkish language environment, or if you mean a stripped
down version of my patch.

So I have attached two versions of the patch, one minimal one and the
one you've already seen with the additional fixes for language
environments.

Please let me know which of these is acceptable for emacs-28, and I will
push it as soon as possible.

Thanks in advance.

[-- Attachment #2: minimal-0001-Be-more-allowing-when-looking-for-menu-bar-items.patch --]
[-- Type: text/x-diff, Size: 8647 bytes --]

From f4a8cff7ee0ef09f5b95496dccc5fbcfc2a99d18 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): New tests.
---
 etc/NEWS                 |   8 +++
 src/keymap.c             | 112 +++++++++++++++++++++++++++++++--------
 test/src/keymap-tests.el |  34 ++++++++++++
 3 files changed, 133 insertions(+), 21 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 7f9797e1fa..60dfff60ab 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -4348,6 +4348,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 940a6f492e..5955b73c63 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1183,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);
 
@@ -1243,6 +1224,95 @@ 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;
+
+  ptrdiff_t key_len = ASIZE (key);
+  Lisp_Object new_key = make_vector (key_len, Qnil);
+
+  /* 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 new_item = Fdowncase (Fsymbol_name (AREF (key, i)));
+      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))
+    return found;
+
+  /* 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.  */
+  return lookup_key_1 (keymap, new_key, accept_default);
+}
+
 /* 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..e835af4890 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -124,6 +124,40 @@ 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 describe-buffer-bindings/header-in-current-buffer ()
   "Header should be inserted into the current buffer.
 https://debbugs.gnu.org/39149#31"
-- 
2.30.2


[-- Attachment #3: full-0001-Be-more-allowing-when-looking-for-menu-bar-items.patch --]
[-- Type: text/x-diff, Size: 10959 bytes --]

From 7a3d5eacf20a2ee1cf732a850c8e0283e591aaa7 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             | 161 ++++++++++++++++++++++++++++++++++-----
 test/src/keymap-tests.el |  43 +++++++++++
 3 files changed, 191 insertions(+), 21 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 7f9797e1fa..60dfff60ab 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -4348,6 +4348,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 940a6f492e..e4e5065f26 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.  */
+static 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.  */
@@ -1183,27 +1186,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);
 
@@ -1243,6 +1227,141 @@ 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"));
+      staticpro (&unicode_case_table);
+    }
+
+  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.  */
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