From: Justin Burkett <justin@burkett.cc>
To: emacs-devel@gnu.org
Subject: Proposed patch for lookup-key
Date: Thu, 14 Dec 2017 14:44:12 -0500 [thread overview]
Message-ID: <CAF8XuLh3JhL3aiN0ZNp=akiiMhd9-zhKH5tnqZp4gFVx0e+CHw@mail.gmail.com> (raw)
[-- 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
next reply other threads:[~2017-12-14 19:44 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-12-14 19:44 Justin Burkett [this message]
2017-12-14 21:07 ` Proposed patch for lookup-key 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
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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='CAF8XuLh3JhL3aiN0ZNp=akiiMhd9-zhKH5tnqZp4gFVx0e+CHw@mail.gmail.com' \
--to=justin@burkett.cc \
--cc=emacs-devel@gnu.org \
/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 external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.