/* Manipulation of keymaps
- Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 01, 2004
- Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1998, 1999, 2000,
+ 2001, 2004, 2005 Free Software Foundation, Inc.
This file is part of GNU Emacs.
static void describe_translation P_ ((Lisp_Object, Lisp_Object));
static void describe_map P_ ((Lisp_Object, Lisp_Object,
void (*) P_ ((Lisp_Object, Lisp_Object)),
- int, Lisp_Object, Lisp_Object*, int));
+ int, Lisp_Object, Lisp_Object*, int, int));
static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
void (*) (Lisp_Object, Lisp_Object), int,
- Lisp_Object, Lisp_Object, int *, int, int));
+ Lisp_Object, Lisp_Object, int *,
+ int, int, int));
static void silly_event_symbol_error P_ ((Lisp_Object));
\f
/* Keymap object support - constructors and predicates. */
DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
-CHARTABLE is a char-table that holds the bindings for the ASCII
-characters. ALIST is an assoc-list which holds bindings for function keys,
-mouse events, and any other things that appear in the input stream.
-All entries in it are initially nil, meaning "command undefined".
+CHARTABLE is a char-table that holds the bindings for all characters
+without modifiers. All entries in it are initially nil, meaning
+"command undefined". ALIST is an assoc-list which holds bindings for
+function keys, mouse events, and any other things that appear in the
+input stream. Initially, ALIST is nil.
The optional arg STRING supplies a menu name for the keymap
in case you use it as a menu with `x-popup-menu'. */)
(map)
Lisp_Object map;
{
+ map = get_keymap (map, 0, 0);
while (CONSP (map))
{
- register Lisp_Object tem;
- tem = Fcar (map);
+ Lisp_Object tem = XCAR (map);
if (STRINGP (tem))
return tem;
- map = Fcdr (map);
+ map = XCDR (map);
}
return Qnil;
}
/* Should we do an autoload? Autoload forms for keymaps have
Qkeymap as their fifth element. */
- if ((autoload || !error) && EQ (XCAR (tem), Qautoload))
+ if ((autoload || !error) && EQ (XCAR (tem), Qautoload)
+ && SYMBOLP (object))
{
Lisp_Object tail;
struct gcpro gcpro1;
Lisp_Object meta_map;
GCPRO1 (map);
+ /* A strange value in which Meta is set would cause
+ infinite recursion. Protect against that. */
+ if (XINT (meta_prefix_char) & CHAR_META)
+ meta_prefix_char = make_number (27);
meta_map = get_keymap (access_keymap (map, meta_prefix_char,
t_ok, noinherit, autoload),
0, autoload);
call2 (fun, key, val);
}
-DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 2, 0,
+DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
doc: /* Call FUNCTION for every binding in KEYMAP.
-FUNCTION is called with two arguments: the event and its binding. */)
- (function, keymap)
- Lisp_Object function, keymap;
+FUNCTION is called with two arguments: the event and its binding.
+If KEYMAP has a parent, the parent's bindings are included as well.
+This works recursively: if the parent has itself a parent, then the
+grandparent's bindings are also included and so on.
+usage: (map-keymap FUNCTION KEYMAP) */)
+ (function, keymap, sort_first)
+ Lisp_Object function, keymap, sort_first;
{
if (INTEGERP (function))
/* We have to stop integers early since map_keymap gives them special
significance. */
Fsignal (Qinvalid_function, Fcons (function, Qnil));
+ if (! NILP (sort_first))
+ return call3 (intern ("map-keymap-internal"), function, keymap, Qt);
+
map_keymap (keymap, map_keymap_call, function, NULL, 1);
return Qnil;
}
remove that. Also remove a menu help string as second element.
If AUTOLOAD is nonzero, load autoloadable keymaps
- that are referred to with indirection. */
+ that are referred to with indirection.
+
+ This can GC because menu_item_eval_property calls Feval. */
Lisp_Object
get_keyelt (object, autoload)
c = Fevent_convert_list (c);
/* Turn the 8th bit of string chars into a meta modifier. */
- if (XINT (c) & 0x80 && STRINGP (key))
+ if (INTEGERP (c) && XINT (c) & 0x80 && STRINGP (key))
XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
/* Allow string since binding for `menu-bar-select-buffer'
if (!NILP (olp))
{
- if (!NILP (Voverriding_local_map))
- keymaps = Fcons (Voverriding_local_map, keymaps);
if (!NILP (current_kboard->Voverriding_terminal_local_map))
keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
+ /* The doc said that overriding-terminal-local-map should
+ override overriding-local-map. The code used them both,
+ but it seems clearer to use just one. rms, jan 2005. */
+ else if (!NILP (Voverriding_local_map))
+ keymaps = Fcons (Voverriding_local_map, keymaps);
}
if (NILP (XCDR (keymaps)))
{
Lisp_Object *maps;
int nmaps, i;
+ /* This usually returns the buffer's local map,
+ but that can be overridden by a `local-map' property. */
local = get_local_map (PT, current_buffer, Qlocal_map);
if (!NILP (local))
keymaps = Fcons (local, keymaps);
+ /* Now put all the minor mode keymaps on the list. */
nmaps = current_minor_maps (0, &maps);
for (i = --nmaps; i >= 0; i--)
if (!NILP (maps[i]))
keymaps = Fcons (maps[i], keymaps);
+ /* This returns nil unless there is a `keymap' property. */
local = get_local_map (PT, current_buffer, Qkeymap);
if (!NILP (local))
keymaps = Fcons (local, keymaps);
continue;
record_sequence:
+ /* Don't annoy user with strings from a menu such as
+ Select Paste. Change them all to "(any string)",
+ so that there seems to be only one menu item
+ to report. */
+ if (! NILP (sequence))
+ {
+ Lisp_Object tem;
+ tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
+ if (STRINGP (tem))
+ Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
+ build_string ("(any string)"));
+ }
+
/* It is a true unshadowed match. Record it, unless it's already
been seen (as could happen when inheriting keymaps). */
if (NILP (Fmember (sequence, found)))
DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
doc: /* Return list of keys that invoke DEFINITION.
-If KEYMAP is non-nil, search only KEYMAP and the global keymap.
+If KEYMAP is a keymap, search only KEYMAP and the global keymap.
If KEYMAP is nil, search all the currently active keymaps.
If KEYMAP is a list of keymaps, search only those keymaps.
rather than a list of all possible key sequences.
If FIRSTONLY is the symbol `non-ascii', return the first binding found,
no matter what it is.
-If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,
-and entirely reject menu bindings.
+If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters
+\(or their meta variants) and entirely reject menu bindings.
If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
to other keymaps or slots. This makes it possible to search for an
}
-/* This function cannot GC. */
+/* This function can GC because get_keyelt can. */
static Lisp_Object
where_is_internal_1 (binding, key, definition, noindirect, this, last,
if (!NILP (Vkey_translation_map))
describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
- "Key translations", nomenu, 1, 0);
+ "Key translations", nomenu, 1, 0, 0);
/* Print the (major mode) local map. */
if (!NILP (start1))
{
describe_map_tree (start1, 1, shadow, prefix,
- "\f\nOverriding Bindings", nomenu, 0, 0);
+ "\f\nOverriding Bindings", nomenu, 0, 0, 0);
shadow = Fcons (start1, shadow);
}
else
if (!NILP (start1))
{
describe_map_tree (start1, 1, shadow, prefix,
- "\f\n`keymap' Property Bindings", nomenu, 0, 0);
+ "\f\n`keymap' Property Bindings", nomenu,
+ 0, 0, 0);
shadow = Fcons (start1, shadow);
}
p += sizeof (" Minor Mode Bindings") - 1;
*p = 0;
- describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0);
+ describe_map_tree (maps[i], 1, shadow, prefix,
+ title, nomenu, 0, 0, 0);
shadow = Fcons (maps[i], shadow);
}
{
if (EQ (start1, XBUFFER (buffer)->keymap))
describe_map_tree (start1, 1, shadow, prefix,
- "\f\nMajor Mode Bindings", nomenu, 0, 0);
+ "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
else
describe_map_tree (start1, 1, shadow, prefix,
"\f\n`local-map' Property Bindings",
- nomenu, 0, 0);
+ nomenu, 0, 0, 0);
shadow = Fcons (start1, shadow);
}
}
describe_map_tree (current_global_map, 1, shadow, prefix,
- "\f\nGlobal Bindings", nomenu, 0, 1);
+ "\f\nGlobal Bindings", nomenu, 0, 1, 0);
/* Print the function-key-map translations under this prefix. */
if (!NILP (Vfunction_key_map))
describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
- "\f\nFunction key map translations", nomenu, 1, 0);
+ "\f\nFunction key map translations", nomenu, 1, 0, 0);
UNGCPRO;
return Qnil;
so print strings and vectors differently.
If ALWAYS_TITLE is nonzero, print the title even if there are no maps
- to look through. */
+ to look through.
+
+ If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
+ don't omit it; instead, mention it but say it is shadowed. */
void
describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
- always_title)
+ always_title, mention_shadow)
Lisp_Object startmap, shadow, prefix;
int partial;
char *title;
int nomenu;
int transl;
int always_title;
+ int mention_shadow;
{
Lisp_Object maps, orig_maps, seen, sub_shadows;
struct gcpro gcpro1, gcpro2, gcpro3;
describe_map (Fcdr (elt), prefix,
transl ? describe_translation : describe_command,
- partial, sub_shadows, &seen, nomenu);
+ partial, sub_shadows, &seen, nomenu, mention_shadow);
skip: ;
}
PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
static void
-describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
+describe_map (map, prefix, elt_describer, partial, shadow,
+ seen, nomenu, mention_shadow)
register Lisp_Object map;
Lisp_Object prefix;
void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
Lisp_Object shadow;
Lisp_Object *seen;
int nomenu;
+ int mention_shadow;
{
Lisp_Object tail, definition, event;
Lisp_Object tem;
|| CHAR_TABLE_P (XCAR (tail)))
describe_vector (XCAR (tail),
prefix, Qnil, elt_describer, partial, shadow, map,
- (int *)0, 0, 1);
+ (int *)0, 0, 1, mention_shadow);
else if (CONSP (XCAR (tail)))
{
+ int this_shadowed = 0;
event = XCAR (XCAR (tail));
/* Ignore bindings whose "prefix" are not really valid events.
if (!NILP (shadow))
{
tem = shadow_lookup (shadow, kludge, Qt);
- if (!NILP (tem)) continue;
+ if (!NILP (tem))
+ {
+ if (mention_shadow)
+ this_shadowed = 1;
+ else
+ continue;
+ }
}
tem = Flookup_key (map, kludge, Qt);
elt_describer will take care of spacing out far enough
for alignment purposes. */
(*elt_describer) (definition, Qnil);
+
+ if (this_shadowed)
+ {
+ SET_PT (PT - 1);
+ insert_string (" (binding currently shadowed)");
+ SET_PT (PT + 1);
+ }
}
else if (EQ (XCAR (tail), Qkeymap))
{
specbind (Qstandard_output, Fcurrent_buffer ());
CHECK_VECTOR_OR_CHAR_TABLE (vector);
describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
- Qnil, Qnil, (int *)0, 0, 0);
+ Qnil, Qnil, (int *)0, 0, 0, 0);
return unbind_to (count, Qnil);
}
static void
describe_vector (vector, prefix, args, elt_describer,
partial, shadow, entire_map,
- indices, char_table_depth, keymap_p)
+ indices, char_table_depth, keymap_p,
+ mention_shadow)
register Lisp_Object vector;
Lisp_Object prefix, args;
void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
int *indices;
int char_table_depth;
int keymap_p;
+ int mention_shadow;
{
Lisp_Object definition;
Lisp_Object tem2;
for (i = from; i < to; i++)
{
+ int this_shadowed = 0;
QUIT;
if (CHAR_TABLE_P (vector))
tem = shadow_lookup (shadow, kludge, Qt);
- if (!NILP (tem)) continue;
+ if (!NILP (tem))
+ {
+ if (mention_shadow)
+ this_shadowed = 1;
+ else
+ continue;
+ }
}
/* Ignore this definition if it is shadowed by an earlier
insert ("\n", 1);
describe_vector (definition, prefix, args, elt_describer,
partial, shadow, entire_map,
- indices, char_table_depth + 1, keymap_p);
+ indices, char_table_depth + 1, keymap_p,
+ mention_shadow);
continue;
}
elt_describer will take care of spacing out far enough
for alignment purposes. */
(*elt_describer) (definition, args);
+
+ if (this_shadowed)
+ {
+ SET_PT (PT - 1);
+ insert_string (" (binding currently shadowed)");
+ SET_PT (PT + 1);
+ }
}
/* For (sub) char-table, print `defalt' slot at last. */