unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* Proposed patch for lookup-key
@ 2017-12-14 19:44 Justin Burkett
  2017-12-14 21:07 ` Robert Weiner
                   ` (2 more replies)
  0 siblings, 3 replies; 6+ messages in thread
From: Justin Burkett @ 2017-12-14 19:44 UTC (permalink / raw)
  To: emacs-devel


[-- Attachment #1.1: Type: text/plain, Size: 759 bytes --]

Hi all,

I'd like to be able to access more information about key bindings of the
form (DESCRIPTION . DEF) and menu-items. As far as I can tell there's no
easy way to do this using built-in tools in a robust way (i.e., without
manually having to write a lookup-key function).

I'm wondering if the attached patch would be acceptable. The idea was to
add an optional argument to lookup-key to prevent it from stripping this
information about the key bindings.

In principle, I might also like to do something similar for the key-binding
function, but the current patch is sufficient for my purposes.

I have assigned copyright to the FSF, but this would be my first commit
against Emacs. I apologize in advance for overlooking some convention.

Thanks,
Justin

[-- Attachment #1.2: Type: text/html, Size: 937 bytes --]

[-- Attachment #2: 0001-Allow-lookup-key-to-return-full-menu-item-entries.patch --]
[-- Type: application/octet-stream, Size: 15610 bytes --]

From 759ac25488a6289a608eebd95771953e63c6d8fc 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 to return full menu-item entries

* src/keyboard.c (read_char): Adjust call to access_keymap
(menu_bar_items): Adjust call to access_keymap
(tool_bar_items): Adjust call to access_keymap
(follow_key): Adjust call to access_keymap
(access_keymap_keyremap): Adjust call to access_keymap
* src/keymap.c: Change get_keyelt declaration
(access_keymap_1): Add menus arg and adjust recursive calls
(get_keyelt): Add menus arg
(Fdefine_key): Adjust call to access_keymap
(Fcommand_remapping): Adjust call to Flookup_key
(Flookup_key): Add menus arg and adjust call to access_keymap
(Fkey_binding): Adjust call to Flookup_key
(Flocal_key_binding): Adjust call to Flookup_key
(Fglobal_key_binding): Adjust call to Flookup_key
(Fminor_mode_key_binding): Adjust call to Flookup_key
(accessible_keymaps_1): Adjust call to get_keyelt
(Faccessible_keymaps): Adjust call to Flookup_key
(shadow_lookup): Adjust call to Flookup_key
(where_is_internal_1): Adjust call to get_keyelt
(describe_map_tree): Adjust call to Flookup_key
(describe_map): Adjust calls to get_keyelt and Flookup_key
(describe_vector): Adjust calls to get_keyelt and Flookup_key
* src/keymap.h: Adjust access_keymap declaration
---
 src/keyboard.c | 10 ++++----
 src/keymap.c   | 79 ++++++++++++++++++++++++++++++++--------------------------
 src/keymap.h   |  2 +-
 3 files changed, 49 insertions(+), 42 deletions(-)

diff --git a/src/keyboard.c b/src/keyboard.c
index 375aa4f606..10ead0c1ab 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))
 	  {
@@ -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..6fac478cda 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -98,7 +98,7 @@ static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object,
                              void (*) (Lisp_Object, Lisp_Object), bool,
                              Lisp_Object, Lisp_Object, bool, bool);
 static void silly_event_symbol_error (Lisp_Object);
-static Lisp_Object get_keyelt (Lisp_Object, bool);
+static Lisp_Object get_keyelt (Lisp_Object, bool, bool);
 
 static void
 CHECK_VECTOR_OR_CHAR_TABLE (Lisp_Object x)
@@ -368,7 +368,8 @@ Return PARENT.  PARENT should be nil or another keymap.  */)
 
 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 menus)
 {
   /* 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 +396,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, menus);
       event_meta_map = get_keymap (event_meta_binding, 0, autoload);
       if (CONSP (event_meta_map))
 	{
@@ -440,7 +441,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, menus),
 				0, autoload);
 		if (KEYMAPP (parent_entry))
 		  {
@@ -457,7 +458,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, menus);
 	  }
 	else if (CONSP (binding))
 	  {
@@ -501,7 +502,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
 		 keymaps of lower precedence).  */
 	      val = Qnil;
 
-	    val = get_keyelt (val, autoload);
+	    val = get_keyelt (val, autoload, menus);
 
 	    if (!KEYMAPP (val))
 	      {
@@ -526,15 +527,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) ? get_keyelt (t_binding, autoload, menus) : 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 menus)
 {
-  Lisp_Object val = access_keymap_1 (map, idx, t_ok, noinherit, autoload);
+  Lisp_Object val = access_keymap_1 (map, idx, t_ok, noinherit, autoload, menus);
   return EQ (val, Qunbound) ? Qnil : val;
 }
 
@@ -677,8 +678,9 @@ 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 MENUS is true,
+   do not remove information about menus.
 
    If AUTOLOAD, load autoloadable keymaps
    that are referred to with indirection.
@@ -686,12 +688,13 @@ usage: (map-keymap FUNCTION KEYMAP)  */)
    This can GC because menu_item_eval_property calls Feval.  */
 
 static Lisp_Object
-get_keyelt (Lisp_Object object, bool autoload)
+get_keyelt (Lisp_Object object, bool autoload, bool menus)
 {
   while (1)
     {
-      if (!(CONSP (object)))
-	/* This is really the value.  */
+      if (!(CONSP (object)) || menus)
+	/* This is really the value or we do not want to process
+           menu-items.  */
 	return object;
 
       /* If the keymap contents looks like (menu-item name . DEFN)
@@ -1136,7 +1139,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))
@@ -1188,14 +1191,14 @@ remapping in all currently active keymaps.  */)
     command = Fkey_binding (command_remapping_vector, Qnil, Qt, position);
   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 +1213,18 @@ 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 MENUS 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 menus)
 {
   ptrdiff_t idx;
   Lisp_Object cmd;
   Lisp_Object c;
   ptrdiff_t length;
   bool t_ok = !NILP (accept_default);
+  bool return_menus = !NILP (menus);
 
   keymap = get_keymap (keymap, 1, 1);
 
@@ -1242,7 +1249,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_menus);
       if (idx == length)
 	return cmd;
 
@@ -1655,7 +1662,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, Qnil);
 
   if (NILP (value) || INTEGERP (value))
     return Qnil;
@@ -1688,7 +1695,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 +1711,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 +1741,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))
@@ -1836,7 +1843,7 @@ accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void *
   bool is_metized = d->is_metized && INTEGERP (key);
   Lisp_Object tem;
 
-  cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
+  cmd = get_keymap (get_keyelt (cmd, 0, 0), 0, 0);
   if (NILP (cmd))
     return;
 
@@ -1907,7 +1914,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 +2369,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;
 	}
@@ -2695,7 +2702,7 @@ where_is_internal_1 (Lisp_Object key, Lisp_Object binding, Lisp_Object args, voi
 
   /* Search through indirections unless that's not wanted.  */
   if (!noindirect)
-    binding = get_keyelt (binding, 0);
+    binding = get_keyelt (binding, 0, 0);
 
   /* End this iteration if this element does not match
      the target.  */
@@ -3000,7 +3007,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;
 	    }
@@ -3194,7 +3201,7 @@ describe_map (Lisp_Object map, Lisp_Object prefix,
 	  if (nomenu && EQ (event, Qmenu_bar))
 	    continue;
 
-	  definition = get_keyelt (XCDR (XCAR (tail)), 0);
+	  definition = get_keyelt (XCDR (XCAR (tail)), 0, 0);
 
 	  /* Don't show undefined commands or suppressed commands.  */
 	  if (NILP (definition)) continue;
@@ -3227,7 +3234,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;
@@ -3445,7 +3452,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
 	}
       else
 	val = AREF (vector, i);
-      definition = get_keyelt (val, 0);
+      definition = get_keyelt (val, 0, 0);
 
       if (NILP (definition)) continue;
 
@@ -3484,7 +3491,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;
@@ -3512,14 +3519,14 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
 		 && (range_beg = i + 1, range_end = stop - 1,
 		   val = char_table_ref_and_range (vector, range_beg,
 						   &range_beg, &range_end),
-		   tem2 = get_keyelt (val, 0),
+                     tem2 = get_keyelt (val, 0, 0),
 		   !NILP (tem2))
 		 && !NILP (Fequal (tem2, definition)))
 	    i = range_end;
 	}
       else
 	while (i + 1 < stop
-	       && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
+	       && (tem2 = get_keyelt (AREF (vector, i + 1), 0, 0),
 		   !NILP (tem2))
 	       && !NILP (Fequal (tem2, definition)))
 	  i++;
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


^ permalink raw reply related	[flat|nested] 6+ messages in thread
end of thread, other threads:[~2017-12-15 14:55 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2017-12-14 19:44 Proposed patch for lookup-key Justin Burkett
2017-12-14 21:07 ` Robert Weiner
2017-12-14 21:25   ` Justin Burkett
2017-12-15  1:31 ` Justin Burkett
2017-12-15  2:57 ` Stefan Monnier
2017-12-15 14:55   ` Justin Burkett

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).