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

[Stefan Kangas <stefan@marxist.se>]

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

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Stefan Kangas <stefan@marxist.se> writes:
>
>> Do we have an alternative to downcase, or should we just ensure that
>> it uses a standard case-table?  Could that lead to any other problems?
>
> But then non-ASCII characters wouldn't downcase correctly.  :-)
>
> Since we're just trying to be backwards compatible, perhaps it would
> make sense to try downcase twice -- once with the current case-table and
> once with the standard one and see whether either matches?

So I've tried this approach in the attached patch, but I couldn't get it
to work.  I'm probably doing something wrong, given that I've never so
much as glanced at language environments and case tables before this.

Eli Zaretskii <eliz@gnu.org> writes:

> We could use the equivalent of
>
>   (get-char-code-property ?I 'lowercase)
>
> If the above returns nil, it means the lower-case variant is the
> character itself.
>
> In C, this means to use uniprop_table, like bidi.c and casefiddle.c
> do.  This accesses the database generated from UnicodeData.txt.

I didn't try this approach, mostly because it sounds more difficult to
implement than what Lars said.  I think?  Wouldn't it amount to
basically re-implementing Fdowncase?  Sorry, I didn't look too closely
at this.  Perhaps this would be the better approach.

If anyone has any preferences or further ideas here, that would be much
appreciated, otherwise I'll keep investigating.

The attached patch is what I have so far.  It's obviously not yet
finished, but all tests pass except for the one for "I->i" conversion in
the Turkish language environment.

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

From 7060128663ebb74ccf659bd1ee6dc38f7c66ba9e 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             | 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