From fb85c77f2edda78643793c821b8aa07dbd8b0834 Mon Sep 17 00:00:00 2001
From: Justin Burkett <justin@burkett.cc>
Date: Thu, 14 Dec 2017 14:20:45 -0500
Subject: [PATCH] Allow lookup-key and key-binding to return full menu-items

* src/keymap.c (access_keymap):  Add menu_items arg and adjust all calls.
(access_keymap_1): Add menu_items arg and adjust all calls.
(Flookup_key): Add menu_items arg and adjust all calls.
(Fdefine_key):
(Fcommand_remapping):
(Fkey_binding): Add menu_items arg and adjust all calls.
(Flocal_key_binding):
(Fglobal_key_binding):
(Fminor_mode_key_binding):
(Faccessible_keymaps):
(shadow_lookup):
(describe_map_tree):
(describe_map):
(describe_vector):
* src/keyboard.c (read_char):
(menu_bar_items):
(parse_menu_item):
(tool_bar_items):
(follow_key):
(access_keymap_keyremap):
* src/keymap.h: Fix access_keymap declaration
---
 src/keyboard.c | 12 ++++-----
 src/keymap.c   | 77 ++++++++++++++++++++++++++++++++++++----------------------
 src/keymap.h   |  2 +-
 3 files changed, 55 insertions(+), 36 deletions(-)

diff --git a/src/keyboard.c b/src/keyboard.c
index 375aa4f606..c6f235fb8b 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -2841,7 +2841,7 @@ read_char (int commandflag, Lisp_Object map,
      and loop around to read another event.  */
   save = Vquit_flag;
   Vquit_flag = Qnil;
-  tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1);
+  tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1, 0);
   Vquit_flag = save;
 
   if (!NILP (tem))
@@ -7503,7 +7503,7 @@ menu_bar_items (Lisp_Object old)
   for (mapno = nmaps - 1; mapno >= 0; mapno--)
     if (!NILP (maps[mapno]))
       {
-	def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1),
+	def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1, 0),
 			  0, 1);
 	if (CONSP (def))
 	  {
@@ -7897,7 +7897,7 @@ parse_menu_item (Lisp_Object item, int inmenubar)
 	if (CONSP (keyhint) && !NILP (XCAR (keyhint)))
 	  {
 	    keys = XCAR (keyhint);
-	    tem = Fkey_binding (keys, Qnil, Qnil, Qnil);
+	    tem = Fkey_binding (keys, Qnil, Qnil, Qnil, Qnil);
 
 	    /* We have a suggested key.  Is it bound to the command?  */
 	    if (NILP (tem)
@@ -8059,7 +8059,7 @@ tool_bar_items (Lisp_Object reuse, int *nitems)
       {
 	Lisp_Object keymap;
 
-	keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 0, 1), 0, 1);
+	keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 0, 1, 0), 0, 1);
 	if (CONSP (keymap))
 	  map_keymap (keymap, process_tool_bar_item, Qnil, NULL, 1);
       }
@@ -8721,7 +8721,7 @@ static Lisp_Object
 follow_key (Lisp_Object keymap, Lisp_Object key)
 {
   return access_keymap (get_keymap (keymap, 0, 1),
-			key, 1, 0, 1);
+			key, 1, 0, 1, 0);
 }
 
 static Lisp_Object
@@ -8761,7 +8761,7 @@ access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt,
 {
   Lisp_Object next;
 
-  next = access_keymap (map, key, 1, 0, 1);
+  next = access_keymap (map, key, 1, 0, 1, 0);
 
   /* Handle a symbol whose function definition is a keymap
      or an array.  */
diff --git a/src/keymap.c b/src/keymap.c
index ccf8ce7917..5fc6fc57b5 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -363,12 +363,16 @@ Return PARENT.  PARENT should be nil or another keymap.  */)
 
    If NOINHERIT, don't accept a subkeymap found in an inherited keymap.
 
+   If MENU_ITEMS, do not process menu items with get_keyelt. Return
+   the full menu item entry instead.
+
    Return Qunbound if no binding was found (and return Qnil if a nil
    binding was found).  */
 
 static Lisp_Object
 access_keymap_1 (Lisp_Object map, Lisp_Object idx,
-		 bool t_ok, bool noinherit, bool autoload)
+		 bool t_ok, bool noinherit, bool autoload,
+                 bool menu_items)
 {
   /* If idx is a list (some sort of mouse click, perhaps?),
      the index we want to use is the car of the list, which
@@ -395,7 +399,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
       if (XINT (meta_prefix_char) & CHAR_META)
 	meta_prefix_char = make_number (27);
       event_meta_binding = access_keymap_1 (map, meta_prefix_char, t_ok,
-					    noinherit, autoload);
+					    noinherit, autoload, menu_items);
       event_meta_map = get_keymap (event_meta_binding, 0, autoload);
       if (CONSP (event_meta_map))
 	{
@@ -440,7 +444,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
 		eassert (KEYMAPP (retval));
 		parent_entry
 		  = get_keymap (access_keymap_1 (tail, idx,
-						 t_ok, 0, autoload),
+						 t_ok, 0, autoload, menu_items),
 				0, autoload);
 		if (KEYMAPP (parent_entry))
 		  {
@@ -457,7 +461,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
 	  }
 	else if (CONSP (submap))
 	  {
-	    val = access_keymap_1 (submap, idx, t_ok, noinherit, autoload);
+	    val = access_keymap_1 (submap, idx, t_ok, noinherit, autoload, menu_items);
 	  }
 	else if (CONSP (binding))
 	  {
@@ -468,6 +472,11 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
 	    else if (t_ok && EQ (key, Qt))
 	      {
 		t_binding = XCDR (binding);
+
+                if (!menu_items)
+                  /* get_keyelt strips menu-item information. */
+                  t_binding = get_keyelt (t_binding, autoload);
+
 		t_ok = 0;
 	      }
 	  }
@@ -501,7 +510,8 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
 		 keymaps of lower precedence).  */
 	      val = Qnil;
 
-	    val = get_keyelt (val, autoload);
+            if (!menu_items)
+              val = get_keyelt (val, autoload);
 
 	    if (!KEYMAPP (val))
 	      {
@@ -526,15 +536,15 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
 	maybe_quit ();
       }
 
-    return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval;
+    return EQ (Qunbound, retval) ? t_binding : retval;
   }
 }
 
 Lisp_Object
 access_keymap (Lisp_Object map, Lisp_Object idx,
-	       bool t_ok, bool noinherit, bool autoload)
+	       bool t_ok, bool noinherit, bool autoload, bool menu_items)
 {
-  Lisp_Object val = access_keymap_1 (map, idx, t_ok, noinherit, autoload);
+  Lisp_Object val = access_keymap_1 (map, idx, t_ok, noinherit, autoload, menu_items);
   return EQ (val, Qunbound) ? Qnil : val;
 }
 
@@ -677,8 +687,8 @@ usage: (map-keymap FUNCTION KEYMAP)  */)
    (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
    and INDEX is the object to look up in KEYMAP to yield the definition.
 
-   Also if OBJECT has a menu string as the first element,
-   remove that.  Also remove a menu help string as second element.
+   Also if OBJECT has a menu string as the first element, remove that.
+   Also remove a menu help string as second element.
 
    If AUTOLOAD, load autoloadable keymaps
    that are referred to with indirection.
@@ -1136,7 +1146,7 @@ binding KEY to DEF is added at the front of KEYMAP.  */)
       if (idx == length)
 	return store_in_keymap (keymap, c, def);
 
-      cmd = access_keymap (keymap, c, 0, 1, 1);
+      cmd = access_keymap (keymap, c, 0, 1, 1, 0);
 
       /* If this key is undefined, make it a prefix.  */
       if (NILP (cmd))
@@ -1185,17 +1195,17 @@ remapping in all currently active keymaps.  */)
   ASET (command_remapping_vector, 1, command);
 
   if (NILP (keymaps))
-    command = Fkey_binding (command_remapping_vector, Qnil, Qt, position);
+    command = Fkey_binding (command_remapping_vector, Qnil, Qt, position, Qnil);
   else
     command = Flookup_key (Fcons (Qkeymap, keymaps),
-			   command_remapping_vector, Qnil);
+			   command_remapping_vector, Qnil, Qnil);
   return INTEGERP (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,
+DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 4, 0,
        doc: /* In keymap KEYMAP, look up key sequence KEY.  Return the definition.
 A value of nil means undefined.  See doc of `define-key'
 for kinds of definitions.
@@ -1210,14 +1220,19 @@ 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)
+recognize the default bindings, just as `read-key-sequence' does.
+
+A non-nil value for MENU-ITEMS makes `lookup-key` return full
+menu-items instead of just the associated definition. */)
+     (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default,
+      Lisp_Object menu_items)
 {
   ptrdiff_t idx;
   Lisp_Object cmd;
   Lisp_Object c;
   ptrdiff_t length;
   bool t_ok = !NILP (accept_default);
+  bool return_menu_items = !NILP (menu_items);
 
   keymap = get_keymap (keymap, 1, 1);
 
@@ -1242,7 +1257,7 @@ recognize the default bindings, just as `read-key-sequence' does.  */)
       if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
 	message_with_string ("Key sequence contains invalid event %s", c, 1);
 
-      cmd = access_keymap (keymap, c, t_ok, 0, 1);
+      cmd = access_keymap (keymap, c, t_ok, 0, 1, return_menu_items);
       if (idx == length)
 	return cmd;
 
@@ -1603,7 +1618,7 @@ like in the respective argument of `key-binding'.  */)
 
 /* GC is possible in this function if it autoloads a keymap.  */
 
-DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
+DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 5, 0,
        doc: /* Return the binding for command KEY in current keymaps.
 KEY is a string or vector, a sequence of keystrokes.
 The binding is probably a symbol with a function definition.
@@ -1628,8 +1643,12 @@ position as returned by `event-start' and `event-end', and the lookup
 occurs in the keymaps associated with it instead of KEY.  It can also
 be a number or marker, in which case the keymap properties at the
 specified buffer position instead of point are used.
+
+A non-nil value for MENU-ITEMS makes `key-binding` return full menu-items
+instead of just the associated definition.
   */)
-  (Lisp_Object key, Lisp_Object accept_default, Lisp_Object no_remap, Lisp_Object position)
+     (Lisp_Object key, Lisp_Object accept_default, Lisp_Object no_remap,
+      Lisp_Object position, Lisp_Object menu_items)
 {
   Lisp_Object value;
 
@@ -1655,7 +1674,7 @@ specified buffer position instead of point are used.
     }
 
   value = Flookup_key (Fcons (Qkeymap, Fcurrent_active_maps (Qt, position)),
-		       key, accept_default);
+		       key, accept_default, menu_items);
 
   if (NILP (value) || INTEGERP (value))
     return Qnil;
@@ -1688,7 +1707,7 @@ bindings; see the description of `lookup-key' for more details about this.  */)
   map = BVAR (current_buffer, keymap);
   if (NILP (map))
     return Qnil;
-  return Flookup_key (map, keys, accept_default);
+  return Flookup_key (map, keys, accept_default, Qnil);
 }
 
 /* GC is possible in this function if it autoloads a keymap.  */
@@ -1704,7 +1723,7 @@ If optional argument ACCEPT-DEFAULT is non-nil, recognize default
 bindings; see the description of `lookup-key' for more details about this.  */)
   (Lisp_Object keys, Lisp_Object accept_default)
 {
-  return Flookup_key (current_global_map, keys, accept_default);
+  return Flookup_key (current_global_map, keys, accept_default, Qnil);
 }
 
 /* GC is possible in this function if it autoloads a keymap.  */
@@ -1734,7 +1753,7 @@ bindings; see the description of `lookup-key' for more details about this.  */)
 
   for (i = j = 0; i < nmaps; i++)
     if (!NILP (maps[i])
-	&& !NILP (binding = Flookup_key (maps[i], key, accept_default))
+	&& !NILP (binding = Flookup_key (maps[i], key, accept_default, Qnil))
 	&& !INTEGERP (binding))
       {
 	if (KEYMAPP (binding))
@@ -1907,7 +1926,7 @@ then the value includes only maps for prefixes that start with PREFIX.  */)
       /* If a prefix was specified, start with the keymap (if any) for
 	 that prefix, so we don't waste time considering other prefixes.  */
       Lisp_Object tem;
-      tem = Flookup_key (keymap, prefix, Qt);
+      tem = Flookup_key (keymap, prefix, Qt, Qnil);
       /* Flookup_key may give us nil, or a number,
 	 if the prefix is not defined in this particular map.
 	 It might even give us a list that isn't a keymap.  */
@@ -2362,11 +2381,11 @@ shadow_lookup (Lisp_Object shadow, Lisp_Object key, Lisp_Object flag,
 
   for (tail = shadow; CONSP (tail); tail = XCDR (tail))
     {
-      value = Flookup_key (XCAR (tail), key, flag);
+      value = Flookup_key (XCAR (tail), key, flag, Qnil);
       if (NATNUMP (value))
 	{
 	  value = Flookup_key (XCAR (tail),
-			       Fsubstring (key, make_number (0), value), flag);
+			       Fsubstring (key, make_number (0), value), flag, Qnil);
 	  if (!NILP (value))
 	    return Qnil;
 	}
@@ -3000,7 +3019,7 @@ key             binding\n\
 	     what we should use.  */
 	  else
 	    {
-	      shmap = Flookup_key (shmap, Fcar (elt), Qt);
+	      shmap = Flookup_key (shmap, Fcar (elt), Qt, Qnil);
 	      if (INTEGERP (shmap))
 		shmap = Qnil;
 	    }
@@ -3227,7 +3246,7 @@ describe_map (Lisp_Object map, Lisp_Object prefix,
 		}
 	    }
 
-	  tem = Flookup_key (map, kludge, Qt);
+	  tem = Flookup_key (map, kludge, Qt, Qnil);
 	  if (!EQ (tem, definition)) continue;
 
 	  vect[slots_used].event = event;
@@ -3484,7 +3503,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
 	{
 	  Lisp_Object tem;
 
-	  tem = Flookup_key (entire_map, kludge, Qt);
+	  tem = Flookup_key (entire_map, kludge, Qt, Qnil);
 
 	  if (!EQ (tem, definition))
 	    continue;
diff --git a/src/keymap.h b/src/keymap.h
index 2a1945a80a..ea735b4026 100644
--- a/src/keymap.h
+++ b/src/keymap.h
@@ -34,7 +34,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #define KEYMAPP(m) (!NILP (get_keymap (m, false, false)))
 extern Lisp_Object current_global_map;
 extern char *push_key_description (EMACS_INT, char *);
-extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool);
+extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool, bool);
 extern Lisp_Object get_keymap (Lisp_Object, bool, bool);
 extern void describe_map_tree (Lisp_Object, bool, Lisp_Object, Lisp_Object,
 			       const char *, bool, bool, bool, bool);
-- 
2.15.1

