Commit db785038 authored by Stefan Monnier's avatar Stefan Monnier

* keymap.c (access_keymap): Add AUTOLOAD parameter.

Do the meta->esc mapping.  Call get_keyelt before returning.
Start scanning from the second element (the first is always `keymap')
to make it easier to detect when we reach a parent map.
Handle the case of inheriting from a symbol whose function is a map.
(Fkeymap_parent): Also handle the `inherit from symbol' case.
(fix_submap_inheritance, Fdefine_key): Update call to access_keymap.
(get_keyelt, Flookup_key): Update call to access_keymap.
Remove the meta->esc mappings.
(define_as_prefix): Delete old disabled code.
(menu_item_p): New function.
(where_is_internal_1): Skip over the few remaining menu items.
* lisp.h (access_keymap): Update prototype.
* keyboard.c (read_char, menu_bar_items, tool_bar_items):
Update call to access_keymap.
(follow_key, read_key_sequence): Update calls to access_keymap.
Remove the meta->esc mappings.
parent 86b7fcbb
2000-10-14 Stefan Monnier <monnier@cs.yale.edu>
* keymap.c (access_keymap): Add AUTOLOAD parameter.
Do the meta->esc mapping. Call get_keyelt before returning.
Start scanning from the second element (the first is always `keymap')
to make it easier to detect when we reach a parent map.
Handle the case of inheriting from a symbol whose function is a map.
(Fkeymap_parent): Also handle the `inherit from symbol' case.
(fix_submap_inheritance, Fdefine_key): Update call to access_keymap.
(get_keyelt, Flookup_key): Update call to access_keymap.
Remove the meta->esc mappings.
(define_as_prefix): Delete old disabled code.
(menu_item_p): New function.
(where_is_internal_1): Skip over the few remaining menu items.
* lisp.h (access_keymap): Update prototype.
* keyboard.c (read_char, menu_bar_items, tool_bar_items):
Update call to access_keymap.
(follow_key, read_key_sequence): Update calls to access_keymap.
Remove the meta->esc mappings.
2000-10-13 Gerd Moellmann <gerd@gnu.org>
* dispnew.c (direct_output_for_insert): Call set_iterator_to_next
......
......@@ -2570,8 +2570,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
and loop around to read another event. */
save = Vquit_flag;
Vquit_flag = Qnil;
tem = get_keyelt (access_keymap (get_keymap_1 (Vspecial_event_map, 0, 0),
c, 0, 0), 1);
tem = access_keymap (get_keymap_1 (Vspecial_event_map, 0, 0), c, 0, 0, 1);
Vquit_flag = save;
if (!NILP (tem))
......@@ -6254,7 +6253,7 @@ menu_bar_items (old)
for (mapno = nmaps - 1; mapno >= 0; mapno--)
if (!NILP (maps[mapno]))
{
def = get_keyelt (access_keymap (maps[mapno], Qmenu_bar, 1, 0), 0);
def = access_keymap (maps[mapno], Qmenu_bar, 1, 0, 0);
tem = Fkeymapp (def);
if (!NILP (tem))
menu_bar_one_keymap (def);
......@@ -6911,8 +6910,9 @@ tool_bar_items (reuse, nitems)
if (!NILP (maps[i]))
{
Lisp_Object keymap;
keymap = get_keyelt (access_keymap (maps[i], Qtool_bar, 1, 1), 0);
/* Why set the `noinherit' flag ? -sm */
keymap = access_keymap (maps[i], Qtool_bar, 1, 1, 0);
if (!NILP (Fkeymapp (keymap)))
{
Lisp_Object tail;
......@@ -7599,31 +7599,6 @@ follow_key (key, nmaps, current, defs, next)
int i, first_binding;
int did_meta = 0;
/* If KEY is a meta ASCII character, treat it like meta-prefix-char
followed by the corresponding non-meta character.
Put the results into DEFS, since we are going to alter that anyway.
Do not alter CURRENT or NEXT. */
if (INTEGERP (key) && (XUINT (key) & CHAR_META))
{
for (i = 0; i < nmaps; i++)
if (! NILP (current[i]))
{
Lisp_Object def;
def = get_keyelt (access_keymap (current[i],
meta_prefix_char, 1, 0), 0);
/* Note that since we pass the resulting bindings through
get_keymap_1, non-prefix bindings for meta-prefix-char
disappear. */
defs[i] = get_keymap_1 (def, 0, 1);
}
else
defs[i] = Qnil;
did_meta = 1;
XSETINT (key, XFASTINT (key) & ~CHAR_META);
}
first_binding = nmaps;
for (i = nmaps - 1; i >= 0; i--)
{
......@@ -7635,7 +7610,7 @@ follow_key (key, nmaps, current, defs, next)
else
map = current[i];
defs[i] = get_keyelt (access_keymap (map, key, 1, 0), 1);
defs[i] = access_keymap (map, key, 1, 0, 1);
if (! NILP (defs[i]))
first_binding = i;
}
......@@ -8457,22 +8432,8 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
Lisp_Object key;
key = keybuf[fkey_end++];
/* Look up meta-characters by prefixing them
with meta_prefix_char. I hate this. */
if (INTEGERP (key) && XUINT (key) & meta_modifier)
{
fkey_next
= get_keymap_1
(get_keyelt
(access_keymap (fkey_map, meta_prefix_char, 1, 0), 0),
0, 1);
XSETFASTINT (key, XFASTINT (key) & ~meta_modifier);
}
else
fkey_next = fkey_map;
fkey_next
= get_keyelt (access_keymap (fkey_next, key, 1, 0), 1);
= access_keymap (fkey_map, key, 1, 0, 1);
/* Handle symbol with autoload definition. */
if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
......@@ -8581,22 +8542,8 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
Lisp_Object key;
key = keybuf[keytran_end++];
/* Look up meta-characters by prefixing them
with meta_prefix_char. I hate this. */
if (INTEGERP (key) && XUINT (key) & meta_modifier)
{
keytran_next
= get_keymap_1
(get_keyelt
(access_keymap (keytran_map, meta_prefix_char, 1, 0), 0),
0, 1);
XSETFASTINT (key, XFASTINT (key) & ~meta_modifier);
}
else
keytran_next = keytran_map;
keytran_next
= get_keyelt (access_keymap (keytran_next, key, 1, 0), 1);
= access_keymap (keytran_map, key, 1, 0, 1);
/* Handle symbol with autoload definition. */
if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
......
......@@ -302,7 +302,7 @@ DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
return list;
}
return Qnil;
return get_keymap_1(list, 0, autoload);
}
......@@ -413,7 +413,7 @@ fix_submap_inheritance (map, event, submap)
map_parent = Fkeymap_parent (map);
if (! NILP (map_parent))
parent_entry = get_keyelt (access_keymap (map_parent, event, 0, 0), 0);
parent_entry = access_keymap (map_parent, event, 0, 0, 0);
else
parent_entry = Qnil;
......@@ -455,11 +455,12 @@ fix_submap_inheritance (map, event, submap)
If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
Lisp_Object
access_keymap (map, idx, t_ok, noinherit)
access_keymap (map, idx, t_ok, noinherit, autoload)
Lisp_Object map;
Lisp_Object idx;
int t_ok;
int noinherit;
int autoload;
{
int noprefix = 0;
Lisp_Object val;
......@@ -478,12 +479,23 @@ access_keymap (map, idx, t_ok, noinherit)
with more than 24 bits of integer. */
XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
/* Handle the special meta -> esc mapping. */
if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
{
map = get_keymap_1 (access_keymap
(map, meta_prefix_char, t_ok, noinherit, autoload),
0, autoload);
XSETINT (idx, XFASTINT (idx) & ~meta_modifier);
}
{
Lisp_Object tail;
Lisp_Object t_binding;
t_binding = Qnil;
for (tail = map; CONSP (tail); tail = XCDR (tail))
for (tail = XCDR (map);
CONSP (tail) || (tail = get_keymap_1(tail, 0, autoload), CONSP (tail));
tail = XCDR (tail))
{
Lisp_Object binding;
......@@ -492,7 +504,7 @@ access_keymap (map, idx, t_ok, noinherit)
{
/* If NOINHERIT, stop finding prefix definitions
after we pass a second occurrence of the `keymap' symbol. */
if (noinherit && EQ (binding, Qkeymap) && ! EQ (tail, map))
if (noinherit && EQ (binding, Qkeymap))
noprefix = 1;
}
else if (CONSP (binding))
......@@ -504,7 +516,7 @@ access_keymap (map, idx, t_ok, noinherit)
return Qnil;
if (CONSP (val))
fix_submap_inheritance (map, idx, val);
return val;
return get_keyelt (val, autoload);
}
if (t_ok && EQ (XCAR (binding), Qt))
t_binding = XCDR (binding);
......@@ -518,7 +530,7 @@ access_keymap (map, idx, t_ok, noinherit)
return Qnil;
if (CONSP (val))
fix_submap_inheritance (map, idx, val);
return val;
return get_keyelt (val, autoload);
}
}
else if (CHAR_TABLE_P (binding))
......@@ -536,14 +548,14 @@ access_keymap (map, idx, t_ok, noinherit)
return Qnil;
if (CONSP (val))
fix_submap_inheritance (map, idx, val);
return val;
return get_keyelt (val, autoload);
}
}
QUIT;
}
return t_binding;
return get_keyelt (t_binding, autoload);
}
}
......@@ -635,26 +647,9 @@ get_keyelt (object, autoload)
else
{
Lisp_Object map;
map = get_keymap_1 (Fcar_safe (object), 0, autoload);
if (NILP (map))
/* Invalid keymap */
return object;
else
{
Lisp_Object key;
key = Fcdr (object);
if (INTEGERP (key) && (XUINT (key) & meta_modifier))
{
object = access_keymap (map, meta_prefix_char, 0, 0);
map = get_keymap_1 (object, 0, autoload);
object = access_keymap (map, make_number (XINT (key)
& ~meta_modifier),
0, 0);
}
else
object = access_keymap (map, key, 0, 0);
}
return (NILP (map) ? object /* Invalid keymap */
: access_keymap (map, Fcdr (object), 0, 0, autoload));
}
}
}
......@@ -973,7 +968,7 @@ the front of KEYMAP.")
if (idx == length)
RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
cmd = get_keyelt (access_keymap (keymap, c, 0, 1), 1);
cmd = access_keymap (keymap, c, 0, 1, 1);
/* If this key is undefined, make it a prefix. */
if (NILP (cmd))
......@@ -1014,10 +1009,8 @@ recognize the default bindings, just as `read-key-sequence' does.")
register int idx;
register Lisp_Object cmd;
register Lisp_Object c;
int metized = 0;
int length;
int t_ok = ! NILP (accept_default);
int meta_bit;
struct gcpro gcpro1;
keymap = get_keymap_1 (keymap, 1, 1);
......@@ -1029,38 +1022,21 @@ recognize the default bindings, just as `read-key-sequence' does.")
if (length == 0)
return keymap;
if (VECTORP (key))
meta_bit = meta_modifier;
else
meta_bit = 0x80;
GCPRO1 (key);
idx = 0;
while (1)
{
c = Faref (key, make_number (idx));
c = Faref (key, make_number (idx++));
if (CONSP (c) && lucid_event_type_list_p (c))
c = Fevent_convert_list (c);
if (INTEGERP (c)
&& (XINT (c) & meta_bit)
&& !metized)
{
c = meta_prefix_char;
metized = 1;
}
else
{
if (INTEGERP (c))
XSETINT (c, XINT (c) & ~meta_bit);
metized = 0;
idx++;
}
/* Turn the 8th bit of string chars into a meta modifier. */
if (XINT (c) & 0x80 && STRINGP (key))
XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
cmd = get_keyelt (access_keymap (keymap, c, t_ok, 0), 1);
cmd = access_keymap (keymap, c, t_ok, 0, 1);
if (idx == length)
RETURN_UNGCPRO (cmd);
......@@ -1080,44 +1056,13 @@ static Lisp_Object
define_as_prefix (keymap, c)
Lisp_Object keymap, c;
{
Lisp_Object inherit, cmd;
Lisp_Object cmd;
cmd = Fmake_sparse_keymap (Qnil);
/* If this key is defined as a prefix in an inherited keymap,
make it a prefix in this map, and make its definition
inherit the other prefix definition. */
inherit = access_keymap (keymap, c, 0, 0);
#if 0
/* This code is needed to do the right thing in the following case:
keymap A inherits from B,
you define KEY as a prefix in A,
then later you define KEY as a prefix in B.
We want the old prefix definition in A to inherit from that in B.
It is hard to do that retroactively, so this code
creates the prefix in B right away.
But it turns out that this code causes problems immediately
when the prefix in A is defined: it causes B to define KEY
as a prefix with no subcommands.
So I took out this code. */
if (NILP (inherit))
{
/* If there's an inherited keymap
and it doesn't define this key,
make it define this key. */
Lisp_Object tail;
for (tail = Fcdr (keymap); CONSP (tail); tail = XCDR (tail))
if (EQ (XCAR (tail), Qkeymap))
break;
if (!NILP (tail))
inherit = define_as_prefix (tail, c);
}
#endif
cmd = nconc2 (cmd, inherit);
cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
store_in_keymap (keymap, c, cmd);
return cmd;
......@@ -2082,6 +2027,15 @@ static void where_is_internal_2 ();
/* This function can GC if Flookup_key autoloads any keymaps. */
static INLINE int
menu_item_p (item)
Lisp_Object item;
{
return (CONSP (item)
&& (EQ (XCAR (item),Qmenu_item)
|| STRINGP (XCAR (item))));
}
DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
"Return list of keys that invoke DEFINITION.\n\
If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
......@@ -2334,6 +2288,10 @@ where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last,
int keymap_specified = !NILP (keymap);
struct gcpro gcpro1, gcpro2;
/* Skip left-over menu-items.
These can appear in a keymap bound to a mouse click, for example. */
if (nomenus && menu_item_p (binding))
return Qnil;
/* Search through indirections unless that's not wanted. */
if (NILP (noindirect))
binding = get_keyelt (binding, 0);
......
......@@ -2591,7 +2591,7 @@ EXFUN (Fkey_binding, 2);
EXFUN (Fkey_description, 1);
EXFUN (Fsingle_key_description, 2);
EXFUN (Fwhere_is_internal, 4);
extern Lisp_Object access_keymap P_ ((Lisp_Object, Lisp_Object, int, int));
extern Lisp_Object access_keymap P_ ((Lisp_Object, Lisp_Object, int, int, int));
extern Lisp_Object get_keyelt P_ ((Lisp_Object, int));
extern Lisp_Object get_keymap P_ ((Lisp_Object));
extern Lisp_Object get_keymap_1 P_ ((Lisp_Object, int, int));
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment