From: Robert Pluim <rpluim@gmail.com>
To: Jonas Bernoulli <jonas@bernoul.li>
Cc: 62207@debbugs.gnu.org
Subject: bug#62207: 29.0.60; Trying to remove non-existent key binding instead adds a binding
Date: Wed, 15 Mar 2023 18:36:01 +0100 [thread overview]
Message-ID: <871qlpvrwe.fsf@gmail.com> (raw)
In-Reply-To: <87v8j2hsa8.fsf@bernoul.li> (Jonas Bernoulli's message of "Wed, 15 Mar 2023 17:51:27 +0100")
>>>>> On Wed, 15 Mar 2023 17:51:27 +0100, Jonas Bernoulli <jonas@bernoul.li> said:
Jonas> As a side-note, it would be nice if it were possible to lookup a
Jonas> key in a keymap only, while ignoring bindings in its parent keymap.
A feature request and a bug report? Tsk ;-) Luckily the infrastructure
is actually there already.
The following passes my admittedly quick testing for both.
diff --git c/lisp/keymap.el i/lisp/keymap.el
index 4f02639ffe2..706da70d360 100644
--- c/lisp/keymap.el
+++ i/lisp/keymap.el
@@ -370,7 +370,7 @@ key-translate
(make-char-table 'keyboard-translate-table nil)))
(aset keyboard-translate-table (key-parse from) (key-parse to)))
-(defun keymap-lookup (keymap key &optional accept-default no-remap position)
+(defun keymap-lookup (keymap key &optional accept-default no-remap position noparent)
"Return the binding for command KEY in KEYMAP.
KEY is a string that satisfies `key-valid-p'.
@@ -406,8 +406,10 @@ keymap-lookup
(keymap--check key)
(when (and keymap position)
(error "Can't pass in both keymap and position"))
+ (when (and (not keymap) noparent)
+ (error "Must specify keymap when noparent is t"))
(if keymap
- (let ((value (lookup-key keymap (key-parse key) accept-default)))
+ (let ((value (lookup-key keymap (key-parse key) accept-default noparent)))
(if (and (not no-remap)
(symbolp value))
(or (command-remapping value) value)
diff --git c/src/keymap.c i/src/keymap.c
index 23453eaa9a6..a660a687994 100644
--- c/src/keymap.c
+++ i/src/keymap.c
@@ -887,22 +887,23 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx,
keymap_end:
/* We have scanned the entire keymap, and not found a binding for
IDX. Let's add one. */
- {
- Lisp_Object elt;
+ if (!remove)
+ {
+ Lisp_Object elt;
- if (CONSP (idx) && CHARACTERP (XCAR (idx)))
- {
- /* IDX specifies a range of characters, and not all of them
- were handled yet, which means this keymap doesn't have a
- char-table. So, we insert a char-table now. */
- elt = Fmake_char_table (Qkeymap, Qnil);
- Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
- }
- else
- elt = Fcons (idx, def);
- CHECK_IMPURE (insertion_point, XCONS (insertion_point));
- XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
- }
+ if (CONSP (idx) && CHARACTERP (XCAR (idx)))
+ {
+ /* IDX specifies a range of characters, and not all of them
+ were handled yet, which means this keymap doesn't have a
+ char-table. So, we insert a char-table now. */
+ elt = Fmake_char_table (Qkeymap, Qnil);
+ Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
+ }
+ else
+ elt = Fcons (idx, def);
+ CHECK_IMPURE (insertion_point, XCONS (insertion_point));
+ XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
+ }
}
return def;
@@ -1240,14 +1241,15 @@ DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 3, 0,
if (NILP (keymaps))
command = Fkey_binding (command_remapping_vector, Qnil, Qt, position);
else
- command = Flookup_key (keymaps, command_remapping_vector, Qnil);
+ command = Flookup_key (keymaps, command_remapping_vector, Qnil, Qnil);
return FIXNUMP (command) ? Qnil : command;
}
static Lisp_Object
-lookup_key_1 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default)
+lookup_key_1 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default, Lisp_Object noparent)
{
bool t_ok = !NILP (accept_default);
+ bool noinherit = !NILP (noparent);
if (!CONSP (keymap) && !NILP (keymap))
keymap = get_keymap (keymap, true, true);
@@ -1275,7 +1277,7 @@ lookup_key_1 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default)
if (!FIXNUMP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
message_with_string ("Key sequence contains invalid event %s", c, 1);
- Lisp_Object cmd = access_keymap (keymap, c, t_ok, 0, 1);
+ Lisp_Object cmd = access_keymap (keymap, c, t_ok, noinherit, 1);
if (idx == length)
return cmd;
@@ -1290,7 +1292,7 @@ lookup_key_1 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default)
/* 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: /* Look up key sequence KEY in KEYMAP. Return the definition.
This is a legacy function; see `keymap-lookup' for the recommended
function to use instead.
@@ -1310,9 +1312,9 @@ DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
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 keymap, Lisp_Object key, Lisp_Object accept_default, Lisp_Object noparent)
{
- Lisp_Object found = lookup_key_1 (keymap, key, accept_default);
+ Lisp_Object found = lookup_key_1 (keymap, key, accept_default, noparent);
if (!NILP (found) && !NUMBERP (found))
return found;
@@ -1390,7 +1392,7 @@ DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
}
/* Check for match. */
- found = lookup_key_1 (keymap, new_key, accept_default);
+ found = lookup_key_1 (keymap, new_key, accept_default, noparent);
if (!NILP (found) && !NUMBERP (found))
break;
@@ -1432,7 +1434,7 @@ DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
}
/* Check for match. */
- found = lookup_key_1 (keymap, new_key, accept_default);
+ found = lookup_key_1 (keymap, new_key, accept_default, noparent);
if (!NILP (found) && !NUMBERP (found))
break;
}
@@ -1823,7 +1825,7 @@ DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
}
Lisp_Object value = Flookup_key (Fcurrent_active_maps (Qt, position),
- key, accept_default);
+ key, accept_default, Qnil);
if (NILP (value) || FIXNUMP (value))
return Qnil;
@@ -1864,7 +1866,7 @@ DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_bindin
int j;
for (int 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))
&& !FIXNUMP (binding))
{
if (KEYMAPP (binding))
@@ -2013,7 +2015,7 @@ DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
{
/* 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 = Flookup_key (keymap, prefix, Qt);
+ Lisp_Object 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. */
@@ -2453,7 +2455,7 @@ preferred_sequence_p (Lisp_Object seq)
shadow_lookup (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default,
bool remap)
{
- Lisp_Object value = Flookup_key (keymap, key, accept_default);
+ Lisp_Object value = Flookup_key (keymap, key, accept_default, Qnil);
if (FIXNATP (value)) /* `key' is too long! */
return Qnil;
@@ -3237,7 +3239,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
one in the same keymap. */
if (!NILP (entire_map))
{
- Lisp_Object tem = Flookup_key (entire_map, kludge, Qt);
+ Lisp_Object tem = Flookup_key (entire_map, kludge, Qt, Qnil);
if (!EQ (tem, definition))
continue;
next prev parent reply other threads:[~2023-03-15 17:36 UTC|newest]
Thread overview: 28+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-03-15 16:07 bug#62207: 29.0.60; Trying to remove non-existent key binding instead adds a binding Jonas Bernoulli
2023-03-15 16:51 ` Jonas Bernoulli
2023-03-15 17:36 ` Robert Pluim [this message]
2023-03-15 18:12 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-03-15 22:26 ` Jonas Bernoulli
2023-03-17 21:09 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-03-20 18:46 ` Jonas Bernoulli
2023-03-20 21:25 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-03-15 17:13 ` Eli Zaretskii
2023-03-15 17:39 ` Robert Pluim
2023-03-15 18:02 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-03-17 8:23 ` Eli Zaretskii
2023-03-17 8:54 ` Robert Pluim
2023-03-17 9:55 ` Robert Pluim
2023-03-17 11:36 ` Eli Zaretskii
2023-03-17 13:20 ` Robert Pluim
2023-03-17 11:32 ` Eli Zaretskii
2023-03-17 13:20 ` Robert Pluim
2023-03-20 18:14 ` Jonas Bernoulli
2023-03-17 20:51 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-03-18 5:51 ` Eli Zaretskii
2023-03-18 14:05 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-03-18 9:43 ` Robert Pluim
2023-03-18 14:07 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-03-20 9:09 ` Robert Pluim
2023-03-20 12:17 ` Eli Zaretskii
2023-03-20 15:03 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-03-20 15:27 ` Robert Pluim
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
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=871qlpvrwe.fsf@gmail.com \
--to=rpluim@gmail.com \
--cc=62207@debbugs.gnu.org \
--cc=jonas@bernoul.li \
/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 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).