#include <config.h>
#include <stdio.h>
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
#include "charset.h"
#include "keyboard.h"
#include "termhooks.h"
#include "blockinput.h"
#include "puresize.h"
#include "intervals.h"
#define min(a, b) ((a) < (b) ? (a) : (b))
#define DENSE_TABLE_SIZE (0200)
Lisp_Object current_global_map;
Lisp_Object global_map;
Lisp_Object meta_map;
Lisp_Object control_x_map;
Lisp_Object Vminibuffer_local_map;
Lisp_Object Vminibuffer_local_ns_map;
Lisp_Object Vminibuffer_local_completion_map;
Lisp_Object Vminibuffer_local_must_match_map;
Lisp_Object Vminor_mode_map_alist;
Lisp_Object Vminor_mode_overriding_map_alist;
Lisp_Object Vfunction_key_map;
Lisp_Object Vkey_translation_map;
Lisp_Object Vdefine_key_rebound_commands;
Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item;
extern Lisp_Object meta_prefix_char;
extern Lisp_Object Voverriding_local_map;
static Lisp_Object where_is_cache;
static Lisp_Object where_is_cache_keymaps;
static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object));
static Lisp_Object describe_buffer_bindings P_ ((Lisp_Object));
static void describe_command P_ ((Lisp_Object));
static void describe_translation P_ ((Lisp_Object));
static void describe_map P_ ((Lisp_Object, Lisp_Object,
void (*) P_ ((Lisp_Object)),
int, Lisp_Object, Lisp_Object*, int));
DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
"Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).\n\
CHARTABLE is a char-table that holds the bindings for the ASCII\n\
characters. ALIST is an assoc-list which holds bindings for function keys,\n\
mouse events, and any other things that appear in the input stream.\n\
All entries in it are initially nil, meaning \"command undefined\".\n\n\
The optional arg STRING supplies a menu name for the keymap\n\
in case you use it as a menu with `x-popup-menu'.")
(string)
Lisp_Object string;
{
Lisp_Object tail;
if (!NILP (string))
tail = Fcons (string, Qnil);
else
tail = Qnil;
return Fcons (Qkeymap,
Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
}
DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
"Construct and return a new sparse keymap.\n\
Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\
which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\
which binds the function key or mouse event SYMBOL to DEFINITION.\n\
Initially the alist is nil.\n\n\
The optional arg STRING supplies a menu name for the keymap\n\
in case you use it as a menu with `x-popup-menu'.")
(string)
Lisp_Object string;
{
if (!NILP (string))
return Fcons (Qkeymap, Fcons (string, Qnil));
return Fcons (Qkeymap, Qnil);
}
void
initial_define_key (keymap, key, defname)
Lisp_Object keymap;
int key;
char *defname;
{
store_in_keymap (keymap, make_number (key), intern (defname));
}
void
initial_define_lispy_key (keymap, keyname, defname)
Lisp_Object keymap;
char *keyname;
char *defname;
{
store_in_keymap (keymap, intern (keyname), intern (defname));
}
DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
"Return t if OBJECT is a keymap.\n\
\n\
A keymap is a list (keymap . ALIST),\n\
or a symbol whose function definition is itself a keymap.\n\
ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\
a vector of densely packed bindings for small character codes\n\
is also allowed as an element.")
(object)
Lisp_Object object;
{
return (KEYMAPP (object) ? Qt : Qnil);
}
Lisp_Object
get_keymap (object, error, autoload)
Lisp_Object object;
int error, autoload;
{
Lisp_Object tem;
autoload_retry:
if (NILP (object))
goto end;
if (CONSP (object) && EQ (XCAR (object), Qkeymap))
return object;
tem = indirect_function (object);
if (CONSP (tem))
{
if (EQ (XCAR (tem), Qkeymap))
return tem;
if ((autoload || !error) && EQ (XCAR (tem), Qautoload))
{
Lisp_Object tail;
tail = Fnth (make_number (4), tem);
if (EQ (tail, Qkeymap))
{
if (autoload)
{
struct gcpro gcpro1, gcpro2;
GCPRO2 (tem, object);
do_autoload (tem, object);
UNGCPRO;
goto autoload_retry;
}
else
return Qt;
}
}
}
end:
if (error)
wrong_type_argument (Qkeymapp, object);
return Qnil;
}
DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
"Return the parent keymap of KEYMAP.")
(keymap)
Lisp_Object keymap;
{
Lisp_Object list;
keymap = get_keymap (keymap, 1, 1);
list = XCDR (keymap);
for (; CONSP (list); list = XCDR (list))
{
if (KEYMAPP (list))
return list;
}
return get_keymap (list, 0, 1);
}
int
keymap_memberp (map, maps)
Lisp_Object map, maps;
{
if (NILP (map)) return 0;
while (KEYMAPP (maps) && !EQ (map, maps))
maps = Fkeymap_parent (maps);
return (EQ (map, maps));
}
DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
"Modify KEYMAP to set its parent map to PARENT.\n\
PARENT should be nil or another keymap.")
(keymap, parent)
Lisp_Object keymap, parent;
{
Lisp_Object list, prev;
struct gcpro gcpro1;
int i;
where_is_cache_keymaps = Qt;
keymap = get_keymap (keymap, 1, 1);
GCPRO1 (keymap);
if (!NILP (parent))
{
parent = get_keymap (parent, 1, 1);
if (keymap_memberp (keymap, parent))
error ("Cyclic keymap inheritance");
}
prev = keymap;
while (1)
{
list = XCDR (prev);
if (! CONSP (list) || KEYMAPP (list))
{
if (EQ (XCDR (prev), parent))
RETURN_UNGCPRO (parent);
XCDR (prev) = parent;
break;
}
prev = list;
}
for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
{
if (EQ (XCAR (list), Qkeymap))
break;
if (CONSP (XCAR (list))
&& CONSP (XCDR (XCAR (list))))
fix_submap_inheritance (keymap, XCAR (XCAR (list)),
XCDR (XCAR (list)));
if (VECTORP (XCAR (list)))
for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
if (CONSP (XVECTOR (XCAR (list))->contents[i]))
fix_submap_inheritance (keymap, make_number (i),
XVECTOR (XCAR (list))->contents[i]);
if (CHAR_TABLE_P (XCAR (list)))
{
Lisp_Object indices[3];
map_char_table (fix_submap_inheritance, Qnil, XCAR (list),
keymap, 0, indices);
}
}
RETURN_UNGCPRO (parent);
}
static void
fix_submap_inheritance (map, event, submap)
Lisp_Object map, event, submap;
{
Lisp_Object map_parent, parent_entry;
submap = get_keymap (get_keyelt (submap, 0), 0, 0);
if (!CONSP (submap))
return;
map_parent = Fkeymap_parent (map);
if (!NILP (map_parent))
parent_entry =
get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
else
parent_entry = Qnil;
if (!CONSP (parent_entry))
return;
if (! EQ (parent_entry, submap))
{
Lisp_Object submap_parent;
submap_parent = submap;
while (1)
{
Lisp_Object tem;
tem = Fkeymap_parent (submap_parent);
if (KEYMAPP (tem))
{
if (keymap_memberp (tem, parent_entry))
return;
submap_parent = tem;
}
else
break;
}
Fset_keymap_parent (submap_parent, parent_entry);
}
}
Lisp_Object
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;
idx = EVENT_HEAD (idx);
if (SYMBOLP (idx))
idx = reorder_modifiers (idx);
else if (INTEGERP (idx))
XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
{
Lisp_Object meta_map =
get_keymap (access_keymap (map, meta_prefix_char,
t_ok, noinherit, autoload),
0, autoload);
if (CONSP (meta_map))
{
map = meta_map;
idx = make_number (XUINT (idx) & ~meta_modifier);
}
else if (t_ok)
idx = Qt;
else
return Qnil;
}
{
Lisp_Object tail;
Lisp_Object t_binding;
Lisp_Object generic_binding;
t_binding = Qnil;
generic_binding = Qnil;
for (tail = XCDR (map);
(CONSP (tail)
|| (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
tail = XCDR (tail))
{
Lisp_Object binding;
binding = XCAR (tail);
if (SYMBOLP (binding))
{
if (noinherit && EQ (binding, Qkeymap))
noprefix = 1;
}
else if (CONSP (binding))
{
Lisp_Object key = XCAR (binding);
int c1, c2, charset;
if (EQ (key, idx))
{
val = XCDR (binding);
if (noprefix && KEYMAPP (val))
return Qnil;
if (CONSP (val))
fix_submap_inheritance (map, idx, val);
return get_keyelt (val, autoload);
}
else if (INTEGERP (idx)
&& (XINT (idx) & CHAR_MODIFIER_MASK) == 0
&& INTEGERP (key)
&& (XINT (key) & CHAR_MODIFIER_MASK) == 0
&& !SINGLE_BYTE_CHAR_P (XINT (idx))
&& !SINGLE_BYTE_CHAR_P (XINT (key))
&& CHAR_VALID_P (XINT (key), 1)
&& !CHAR_VALID_P (XINT (key), 0)
&& (CHAR_CHARSET (XINT (key))
== CHAR_CHARSET (XINT (idx))))
{
generic_binding = XCDR (binding);
}
else if (t_ok && EQ (XCAR (binding), Qt))
t_binding = XCDR (binding);
}
else if (VECTORP (binding))
{
if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (binding)->size)
{
val = XVECTOR (binding)->contents[XFASTINT (idx)];
if (noprefix && KEYMAPP (val))
return Qnil;
if (CONSP (val))
fix_submap_inheritance (map, idx, val);
return get_keyelt (val, autoload);
}
}
else if (CHAR_TABLE_P (binding))
{
if (NATNUMP (idx)
&& (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
{
val = Faref (binding, idx);
if (noprefix && KEYMAPP (val))
return Qnil;
if (CONSP (val))
fix_submap_inheritance (map, idx, val);
return get_keyelt (val, autoload);
}
}
QUIT;
}
if (!NILP (generic_binding))
return get_keyelt (generic_binding, autoload);
return get_keyelt (t_binding, autoload);
}
}
Lisp_Object
get_keyelt (object, autoload)
register Lisp_Object object;
int autoload;
{
while (1)
{
if (!(CONSP (object)))
return object;
else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
return object;
else if (EQ (XCAR (object), Qmenu_item))
{
if (CONSP (XCDR (object)))
{
Lisp_Object tem;
object = XCDR (XCDR (object));
tem = object;
if (CONSP (object))
object = XCAR (object);
for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
if (EQ (XCAR (tem), QCfilter) && autoload)
{
Lisp_Object filter;
filter = XCAR (XCDR (tem));
filter = list2 (filter, list2 (Qquote, object));
object = menu_item_eval_property (filter);
break;
}
}
else
return object;
}
else if (STRINGP (XCAR (object)))
{
object = XCDR (object);
if (CONSP (object) && STRINGP (XCAR (object)))
object = XCDR (object);
if (CONSP (object) && CONSP (XCAR (object)))
{
Lisp_Object carcar;
carcar = XCAR (XCAR (object));
if (NILP (carcar) || VECTORP (carcar))
object = XCDR (object);
}
}
else
{
Lisp_Object map;
map = get_keymap (Fcar_safe (object), 0, autoload);
return (!CONSP (map) ? object
: access_keymap (map, Fcdr (object), 0, 0, autoload));
}
}
}
static Lisp_Object
store_in_keymap (keymap, idx, def)
Lisp_Object keymap;
register Lisp_Object idx;
register Lisp_Object def;
{
where_is_cache = Qnil;
where_is_cache_keymaps = Qt;
if (CONSP (def) && PURE_P (def)
&& (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
def = Fcons (XCAR (def), XCDR (def));
if (!CONSP (keymap) || ! EQ (XCAR (keymap), Qkeymap))
error ("attempt to define a key in a non-keymap");
idx = EVENT_HEAD (idx);
if (SYMBOLP (idx))
idx = reorder_modifiers (idx);
else if (INTEGERP (idx))
XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
{
Lisp_Object tail;
Lisp_Object insertion_point;
insertion_point = keymap;
for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
{
Lisp_Object elt;
elt = XCAR (tail);
if (VECTORP (elt))
{
if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
{
ASET (elt, XFASTINT (idx), def);
return def;
}
insertion_point = tail;
}
else if (CHAR_TABLE_P (elt))
{
if (NATNUMP (idx)
&& ! (XFASTINT (idx)
& (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
| CHAR_SHIFT | CHAR_CTL | CHAR_META)))
{
Faset (elt, idx, def);
return def;
}
insertion_point = tail;
}
else if (CONSP (elt))
{
if (EQ (idx, XCAR (elt)))
{
XCDR (elt) = def;
return def;
}
}
else if (EQ (elt, Qkeymap))
goto keymap_end;
QUIT;
}
keymap_end:
XCDR (insertion_point)
= Fcons (Fcons (idx, def), XCDR (insertion_point));
}
return def;
}
void
copy_keymap_1 (chartable, idx, elt)
Lisp_Object chartable, idx, elt;
{
if (CONSP (elt) && EQ (XCAR (elt), Qkeymap))
Faset (chartable, idx, Fcopy_keymap (elt));
}
DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
"Return a copy of the keymap KEYMAP.\n\
The copy starts out with the same definitions of KEYMAP,\n\
but changing either the copy or KEYMAP does not affect the other.\n\
Any key definitions that are subkeymaps are recursively copied.\n\
However, a key definition which is a symbol whose definition is a keymap\n\
is not copied.")
(keymap)
Lisp_Object keymap;
{
register Lisp_Object copy, tail;
copy = Fcopy_alist (get_keymap (keymap, 1, 0));
for (tail = copy; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object elt;
elt = XCAR (tail);
if (CHAR_TABLE_P (elt))
{
Lisp_Object indices[3];
elt = Fcopy_sequence (elt);
XCAR (tail) = elt;
map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices);
}
else if (VECTORP (elt))
{
int i;
elt = Fcopy_sequence (elt);
XCAR (tail) = elt;
for (i = 0; i < ASIZE (elt); i++)
if (CONSP (AREF (elt, i)) && EQ (XCAR (AREF (elt, i)), Qkeymap))
ASET (elt, i, Fcopy_keymap (AREF (elt, i)));
}
else if (CONSP (elt) && CONSP (XCDR (elt)))
{
Lisp_Object tem;
tem = XCDR (elt);
if (EQ (XCAR (tem),Qmenu_item))
{
XCDR (elt)
= Fcons (XCAR (tem), XCDR (tem));
elt = XCDR (elt);
tem = XCDR (elt);
if (CONSP (tem))
{
XCDR (elt)
= Fcons (XCAR (tem), XCDR (tem));
elt = XCDR (elt);
tem = XCDR (elt);
};
if (CONSP (tem))
{
XCDR (elt)
= Fcons (XCAR (tem), XCDR (tem));
elt = XCDR (elt);
tem = XCAR (elt);
if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
XCAR (elt) = Fcopy_keymap (tem);
tem = XCDR (elt);
if (CONSP (tem) && CONSP (XCAR (tem)))
XCDR (elt) = XCDR (tem);
}
}
else
{
if (STRINGP (XCAR (tem)))
{
XCDR (elt)
= Fcons (XCAR (tem), XCDR (tem));
elt = XCDR (elt);
tem = XCDR (elt);
if (CONSP (tem) && STRINGP (XCAR (tem)))
{
XCDR (elt)
= Fcons (XCAR (tem), XCDR (tem));
elt = XCDR (elt);
tem = XCDR (elt);
}
if (CONSP (tem)
&& CONSP (XCAR (tem))
&& (NILP (XCAR (XCAR (tem)))
|| VECTORP (XCAR (XCAR (tem)))))
XCDR (elt) = XCDR (tem);
}
if (CONSP (elt)
&& CONSP (XCDR (elt))
&& EQ (XCAR (XCDR (elt)), Qkeymap))
XCDR (elt) = Fcopy_keymap (XCDR (elt));
}
}
}
return copy;
}
DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
"Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\
KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\
meaning a sequence of keystrokes and events.\n\
Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
can be included if you use a vector.\n\
DEF is anything that can be a key's definition:\n\
nil (means key is undefined in this keymap),\n\
a command (a Lisp function suitable for interactive calling)\n\
a string (treated as a keyboard macro),\n\
a keymap (to define a prefix key),\n\
a symbol. When the key is looked up, the symbol will stand for its\n\
function definition, which should at that time be one of the above,\n\
or another symbol whose function definition is used, etc.\n\
a cons (STRING . DEFN), meaning that DEFN is the definition\n\
(DEFN should be a valid definition in its own right),\n\
or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\
\n\
If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\
the front of KEYMAP.")
(keymap, key, def)
Lisp_Object keymap;
Lisp_Object key;
Lisp_Object def;
{
register int idx;
register Lisp_Object c;
register Lisp_Object cmd;
int metized = 0;
int meta_bit;
int length;
struct gcpro gcpro1, gcpro2, gcpro3;
keymap = get_keymap (keymap, 1, 1);
if (!VECTORP (key) && !STRINGP (key))
key = wrong_type_argument (Qarrayp, key);
length = XFASTINT (Flength (key));
if (length == 0)
return Qnil;
if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
GCPRO3 (keymap, key, def);
if (VECTORP (key))
meta_bit = meta_modifier;
else
meta_bit = 0x80;
idx = 0;
while (1)
{
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++;
}
if (! INTEGERP (c) && ! SYMBOLP (c) && ! CONSP (c))
error ("Key sequence contains invalid events");
if (idx == length)
RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
cmd = access_keymap (keymap, c, 0, 1, 1);
if (NILP (cmd))
cmd = define_as_prefix (keymap, c);
keymap = get_keymap (cmd, 0, 1);
if (!CONSP (keymap))
error ("Key sequence %s uses invalid prefix characters",
XSTRING (Fkey_description (key))->data);
}
}
DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
"In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\
nil means undefined. See doc of `define-key' for kinds of definitions.\n\
\n\
A number as value means KEY is \"too long\";\n\
that is, characters or symbols in it except for the last one\n\
fail to be a valid sequence of prefix characters in KEYMAP.\n\
The number is how many characters at the front of KEY\n\
it takes to reach a non-prefix command.\n\
\n\
Normally, `lookup-key' ignores bindings for t, which act as default\n\
bindings, used when nothing else in the keymap applies; this makes it\n\
usable as a general function for probing keymaps. However, if the\n\
third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\
recognize the default bindings, just as `read-key-sequence' does.")
(keymap, key, accept_default)
register Lisp_Object keymap;
Lisp_Object key;
Lisp_Object accept_default;
{
register int idx;
register Lisp_Object cmd;
register Lisp_Object c;
int length;
int t_ok = ! NILP (accept_default);
struct gcpro gcpro1;
keymap = get_keymap (keymap, 1, 1);
if (!VECTORP (key) && !STRINGP (key))
key = wrong_type_argument (Qarrayp, key);
length = XFASTINT (Flength (key));
if (length == 0)
return keymap;
GCPRO1 (key);
idx = 0;
while (1)
{
c = Faref (key, make_number (idx++));
if (CONSP (c) && lucid_event_type_list_p (c))
c = Fevent_convert_list (c);
if (XINT (c) & 0x80 && STRINGP (key))
XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
cmd = access_keymap (keymap, c, t_ok, 0, 1);
if (idx == length)
RETURN_UNGCPRO (cmd);
keymap = get_keymap (cmd, 0, 1);
if (!CONSP (keymap))
RETURN_UNGCPRO (make_number (idx));
QUIT;
}
}
static Lisp_Object
define_as_prefix (keymap, c)
Lisp_Object keymap, c;
{
Lisp_Object cmd;
cmd = Fmake_sparse_keymap (Qnil);
cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
store_in_keymap (keymap, c, cmd);
return cmd;
}
Lisp_Object
append_key (key_sequence, key)
Lisp_Object key_sequence, key;
{
Lisp_Object args[2];
args[0] = key_sequence;
args[1] = Fcons (key, Qnil);
return Fvconcat (2, args);
}
static Lisp_Object *cmm_modes, *cmm_maps;
static int cmm_size;
static Lisp_Object
current_minor_maps_error ()
{
return Qnil;
}
int
current_minor_maps (modeptr, mapptr)
Lisp_Object **modeptr, **mapptr;
{
int i = 0;
int list_number = 0;
Lisp_Object alist, assoc, var, val;
Lisp_Object lists[2];
lists[0] = Vminor_mode_overriding_map_alist;
lists[1] = Vminor_mode_map_alist;
for (list_number = 0; list_number < 2; list_number++)
for (alist = lists[list_number];
CONSP (alist);
alist = XCDR (alist))
if ((assoc = XCAR (alist), CONSP (assoc))
&& (var = XCAR (assoc), SYMBOLP (var))
&& (val = find_symbol_value (var), ! EQ (val, Qunbound))
&& ! NILP (val))
{
Lisp_Object temp;
if (list_number == 1)
{
val = assq_no_quit (var, lists[0]);
if (!NILP (val))
continue;
}
if (i >= cmm_size)
{
Lisp_Object *newmodes, *newmaps;
if (cmm_maps)
{
BLOCK_INPUT;
cmm_size *= 2;
newmodes
= (Lisp_Object *) realloc (cmm_modes,
cmm_size * sizeof *newmodes);
newmaps
= (Lisp_Object *) realloc (cmm_maps,
cmm_size * sizeof *newmaps);
UNBLOCK_INPUT;
}
else
{
BLOCK_INPUT;
cmm_size = 30;
newmodes
= (Lisp_Object *) malloc (cmm_size * sizeof *newmodes);
newmaps
= (Lisp_Object *) malloc (cmm_size * sizeof *newmaps);
UNBLOCK_INPUT;
}
if (newmodes)
cmm_modes = newmodes;
if (newmaps)
cmm_maps = newmaps;
if (newmodes == NULL || newmaps == NULL)
break;
}
temp = internal_condition_case_1 (Findirect_function,
XCDR (assoc),
Qerror, current_minor_maps_error);
if (!NILP (temp))
{
cmm_modes[i] = var;
cmm_maps [i] = temp;
i++;
}
}
if (modeptr) *modeptr = cmm_modes;
if (mapptr) *mapptr = cmm_maps;
return i;
}
DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
"Return the binding for command KEY in current keymaps.\n\
KEY is a string or vector, a sequence of keystrokes.\n\
The binding is probably a symbol with a function definition.\n\
\n\
Normally, `key-binding' ignores bindings for t, which act as default\n\
bindings, used when nothing else in the keymap applies; this makes it\n\
usable as a general function for probing keymaps. However, if the\n\
optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\
recognize the default bindings, just as `read-key-sequence' does.")
(key, accept_default)
Lisp_Object key, accept_default;
{
Lisp_Object *maps, value;
int nmaps, i;
struct gcpro gcpro1;
GCPRO1 (key);
if (!NILP (current_kboard->Voverriding_terminal_local_map))
{
value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
key, accept_default);
if (! NILP (value) && !INTEGERP (value))
RETURN_UNGCPRO (value);
}
else if (!NILP (Voverriding_local_map))
{
value = Flookup_key (Voverriding_local_map, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
RETURN_UNGCPRO (value);
}
else
{
Lisp_Object local;
nmaps = current_minor_maps (0, &maps);
for (i = 0; i < nmaps; i++)
if (! NILP (maps[i]))
{
value = Flookup_key (maps[i], key, accept_default);
if (! NILP (value) && !INTEGERP (value))
RETURN_UNGCPRO (value);
}
local = get_local_map (PT, current_buffer, Qkeymap);
if (! NILP (local))
{
value = Flookup_key (local, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
RETURN_UNGCPRO (value);
}
local = get_local_map (PT, current_buffer, Qlocal_map);
if (! NILP (local))
{
value = Flookup_key (local, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
RETURN_UNGCPRO (value);
}
}
value = Flookup_key (current_global_map, key, accept_default);
UNGCPRO;
if (! NILP (value) && !INTEGERP (value))
return value;
return Qnil;
}
DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
"Return the binding for command KEYS in current local keymap only.\n\
KEYS is a string, a sequence of keystrokes.\n\
The binding is probably a symbol with a function definition.\n\
\n\
If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
bindings; see the description of `lookup-key' for more details about this.")
(keys, accept_default)
Lisp_Object keys, accept_default;
{
register Lisp_Object map;
map = current_buffer->keymap;
if (NILP (map))
return Qnil;
return Flookup_key (map, keys, accept_default);
}
DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
"Return the binding for command KEYS in current global keymap only.\n\
KEYS is a string, a sequence of keystrokes.\n\
The binding is probably a symbol with a function definition.\n\
This function's return values are the same as those of lookup-key\n\
\(which see).\n\
\n\
If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
bindings; see the description of `lookup-key' for more details about this.")
(keys, accept_default)
Lisp_Object keys, accept_default;
{
return Flookup_key (current_global_map, keys, accept_default);
}
DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
"Find the visible minor mode bindings of KEY.\n\
Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
the symbol which names the minor mode binding KEY, and BINDING is\n\
KEY's definition in that mode. In particular, if KEY has no\n\
minor-mode bindings, return nil. If the first binding is a\n\
non-prefix, all subsequent bindings will be omitted, since they would\n\
be ignored. Similarly, the list doesn't include non-prefix bindings\n\
that come after prefix bindings.\n\
\n\
If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
bindings; see the description of `lookup-key' for more details about this.")
(key, accept_default)
Lisp_Object key, accept_default;
{
Lisp_Object *modes, *maps;
int nmaps;
Lisp_Object binding;
int i, j;
struct gcpro gcpro1, gcpro2;
nmaps = current_minor_maps (&modes, &maps);
binding = Qnil;
GCPRO2 (key, binding);
for (i = j = 0; i < nmaps; i++)
if (!NILP (maps[i])
&& !NILP (binding = Flookup_key (maps[i], key, accept_default))
&& !INTEGERP (binding))
{
if (KEYMAPP (binding))
maps[j++] = Fcons (modes[i], binding);
else if (j == 0)
RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
}
UNGCPRO;
return Flist (j, maps);
}
DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
"Define COMMAND as a prefix command. COMMAND should be a symbol.\n\
A new sparse keymap is stored as COMMAND's function definition and its value.\n\
If a second optional argument MAPVAR is given, the map is stored as\n\
its value instead of as COMMAND's value; but COMMAND is still defined\n\
as a function.\n\
The third optional argument NAME, if given, supplies a menu name\n\
string for the map. This is required to use the keymap as a menu.")
(command, mapvar, name)
Lisp_Object command, mapvar, name;
{
Lisp_Object map;
map = Fmake_sparse_keymap (name);
Ffset (command, map);
if (!NILP (mapvar))
Fset (mapvar, map);
else
Fset (command, map);
return command;
}
DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
"Select KEYMAP as the global keymap.")
(keymap)
Lisp_Object keymap;
{
keymap = get_keymap (keymap, 1, 1);
current_global_map = keymap;
return Qnil;
}
DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
"Select KEYMAP as the local keymap.\n\
If KEYMAP is nil, that means no local keymap.")
(keymap)
Lisp_Object keymap;
{
if (!NILP (keymap))
keymap = get_keymap (keymap, 1, 1);
current_buffer->keymap = keymap;
return Qnil;
}
DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
"Return current buffer's local keymap, or nil if it has none.")
()
{
return current_buffer->keymap;
}
DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
"Return the current global keymap.")
()
{
return current_global_map;
}
DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
"Return a list of keymaps for the minor modes of the current buffer.")
()
{
Lisp_Object *maps;
int nmaps = current_minor_maps (0, &maps);
return Flist (nmaps, maps);
}
static void accessible_keymaps_char_table P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
1, 2, 0,
"Find all keymaps accessible via prefix characters from KEYMAP.\n\
Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\
so that the KEYS increase in length. The first element is ([] . KEYMAP).\n\
An optional argument PREFIX, if non-nil, should be a key sequence;\n\
then the value includes only maps for prefixes that start with PREFIX.")
(keymap, prefix)
Lisp_Object keymap, prefix;
{
Lisp_Object maps, good_maps, tail;
int prefixlen = 0;
if (!NILP (prefix))
prefixlen = XINT (Flength (prefix));
if (!NILP (prefix))
{
Lisp_Object tem;
tem = Flookup_key (keymap, prefix, Qt);
tem = get_keymap (tem, 0, 0);
if (CONSP (tem))
{
if (STRINGP (prefix))
{
int i, i_byte, c;
Lisp_Object copy;
copy = Fmake_vector (make_number (XSTRING (prefix)->size), Qnil);
for (i = 0, i_byte = 0; i < XSTRING (prefix)->size;)
{
int i_before = i;
FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
c ^= 0200 | meta_modifier;
ASET (copy, i_before, make_number (c));
}
prefix = copy;
}
maps = Fcons (Fcons (prefix, tem), Qnil);
}
else
return Qnil;
}
else
maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
get_keymap (keymap, 1, 0)),
Qnil);
for (tail = maps; CONSP (tail); tail = XCDR (tail))
{
register Lisp_Object thisseq, thismap;
Lisp_Object last;
int is_metized;
thisseq = Fcar (Fcar (tail));
thismap = Fcdr (Fcar (tail));
last = make_number (XINT (Flength (thisseq)) - 1);
is_metized = (XINT (last) >= 0
&& XINT (last) >= prefixlen
&& EQ (Faref (thisseq, last), meta_prefix_char));
for (; CONSP (thismap); thismap = XCDR (thismap))
{
Lisp_Object elt;
elt = XCAR (thismap);
QUIT;
if (CHAR_TABLE_P (elt))
{
Lisp_Object indices[3];
map_char_table (accessible_keymaps_char_table, Qnil,
elt, Fcons (Fcons (maps, make_number (is_metized)),
Fcons (tail, thisseq)),
0, indices);
}
else if (VECTORP (elt))
{
register int i;
for (i = 0; i < ASIZE (elt); i++)
{
register Lisp_Object tem;
register Lisp_Object cmd;
cmd = get_keyelt (AREF (elt, i), 0);
if (NILP (cmd)) continue;
tem = get_keymap (cmd, 0, 0);
if (CONSP (tem))
{
cmd = tem;
tem = Frassq (cmd, maps);
if (NILP (tem))
{
if (is_metized)
{
int meta_bit = meta_modifier;
tem = Fcopy_sequence (thisseq);
Faset (tem, last, make_number (i | meta_bit));
XCDR (tail)
= Fcons (Fcons (tem, cmd), XCDR (tail));
}
else
{
tem = append_key (thisseq, make_number (i));
nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
}
}
}
}
}
else if (CONSP (elt))
{
register Lisp_Object cmd, tem;
cmd = get_keyelt (XCDR (elt), 0);
tem = get_keymap (cmd, 0, 0);
if (CONSP (tem))
{
cmd = tem;
tem = Frassq (cmd, maps);
if (NILP (tem))
{
elt = XCAR (elt);
if (is_metized && INTEGERP (elt))
{
Lisp_Object element;
element = thisseq;
tem = Fvconcat (1, &element);
XSETFASTINT (AREF (tem, XINT (last)),
XINT (elt) | meta_modifier);
XCDR (tail)
= Fcons (Fcons (tem, cmd), XCDR (tail));
}
else
nconc2 (tail,
Fcons (Fcons (append_key (thisseq, elt), cmd),
Qnil));
}
}
}
}
}
if (NILP (prefix))
return maps;
good_maps = Qnil;
for (; CONSP (maps); maps = XCDR (maps))
{
Lisp_Object elt, thisseq;
elt = XCAR (maps);
thisseq = XCAR (elt);
if (XINT (Flength (thisseq)) >= prefixlen)
{
int i;
for (i = 0; i < prefixlen; i++)
{
Lisp_Object i1;
XSETFASTINT (i1, i);
if (!EQ (Faref (thisseq, i1), Faref (prefix, i1)))
break;
}
if (i == prefixlen)
good_maps = Fcons (elt, good_maps);
}
}
return Fnreverse (good_maps);
}
static void
accessible_keymaps_char_table (args, index, cmd)
Lisp_Object args, index, cmd;
{
Lisp_Object tem;
Lisp_Object maps, tail, thisseq;
int is_metized;
cmd = get_keyelt (cmd, 0);
if (NILP (cmd))
return;
maps = XCAR (XCAR (args));
is_metized = XINT (XCDR (XCAR (args)));
tail = XCAR (XCDR (args));
thisseq = XCDR (XCDR (args));
tem = get_keymap (cmd, 0, 0);
if (CONSP (tem))
{
cmd = tem;
tem = Frassq (cmd, maps);
if (NILP (tem))
{
if (is_metized)
{
int meta_bit = meta_modifier;
Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
tem = Fcopy_sequence (thisseq);
Faset (tem, last, make_number (XINT (index) | meta_bit));
XCDR (tail)
= Fcons (Fcons (tem, cmd), XCDR (tail));
}
else
{
tem = append_key (thisseq, index);
nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
}
}
}
}
Lisp_Object Qsingle_key_description, Qkey_description;
DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
"Return a pretty description of key-sequence KEYS.\n\
Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
spaces are put between sequence elements, etc.")
(keys)
Lisp_Object keys;
{
int len = 0;
int i, i_byte;
Lisp_Object sep;
Lisp_Object *args = NULL;
if (STRINGP (keys))
{
Lisp_Object vector;
vector = Fmake_vector (Flength (keys), Qnil);
for (i = 0, i_byte = 0; i < XSTRING (keys)->size; )
{
int c;
int i_before = i;
FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte);
if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
c ^= 0200 | meta_modifier;
XSETFASTINT (AREF (vector, i_before), c);
}
keys = vector;
}
if (VECTORP (keys))
{
len = XVECTOR (keys)->size;
sep = build_string (" ");
args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
for (i = 0; i < len; i++)
{
args[i * 2] = Fsingle_key_description (AREF (keys, i), Qnil);
args[i * 2 + 1] = sep;
}
}
else if (CONSP (keys))
{
len = XFASTINT (Flength (keys));
sep = build_string (" ");
args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
for (i = 0; i < len; i++)
{
args[i * 2] = Fsingle_key_description (XCAR (keys), Qnil);
args[i * 2 + 1] = sep;
keys = XCDR (keys);
}
}
else
keys = wrong_type_argument (Qarrayp, keys);
if (len == 0)
return build_string ("");
return Fconcat (len * 2 - 1, args);
}
char *
push_key_description (c, p, force_multibyte)
register unsigned int c;
register char *p;
int force_multibyte;
{
unsigned c2;
c &= meta_modifier | ~ - meta_modifier;
c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
| meta_modifier | shift_modifier | super_modifier);
if (c & alt_modifier)
{
*p++ = 'A';
*p++ = '-';
c -= alt_modifier;
}
if ((c & ctrl_modifier) != 0
|| (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
{
*p++ = 'C';
*p++ = '-';
c &= ~ctrl_modifier;
}
if (c & hyper_modifier)
{
*p++ = 'H';
*p++ = '-';
c -= hyper_modifier;
}
if (c & meta_modifier)
{
*p++ = 'M';
*p++ = '-';
c -= meta_modifier;
}
if (c & shift_modifier)
{
*p++ = 'S';
*p++ = '-';
c -= shift_modifier;
}
if (c & super_modifier)
{
*p++ = 's';
*p++ = '-';
c -= super_modifier;
}
if (c < 040)
{
if (c == 033)
{
*p++ = 'E';
*p++ = 'S';
*p++ = 'C';
}
else if (c == '\t')
{
*p++ = 'T';
*p++ = 'A';
*p++ = 'B';
}
else if (c == Ctl ('M'))
{
*p++ = 'R';
*p++ = 'E';
*p++ = 'T';
}
else
{
if (c > 0 && c <= Ctl ('Z'))
*p++ = c + 0140;
else
*p++ = c + 0100;
}
}
else if (c == 0177)
{
*p++ = 'D';
*p++ = 'E';
*p++ = 'L';
}
else if (c == ' ')
{
*p++ = 'S';
*p++ = 'P';
*p++ = 'C';
}
else if (c < 128
|| (NILP (current_buffer->enable_multibyte_characters)
&& SINGLE_BYTE_CHAR_P (c)
&& !force_multibyte))
{
*p++ = c;
}
else
{
int valid_p = SINGLE_BYTE_CHAR_P (c) || char_valid_p (c, 0);
if (force_multibyte && valid_p)
{
if (SINGLE_BYTE_CHAR_P (c))
c = unibyte_char_to_multibyte (c);
p += CHAR_STRING (c, p);
}
else if (NILP (current_buffer->enable_multibyte_characters)
|| valid_p)
{
int bit_offset;
*p++ = '\\';
for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
{
if (c >= (1 << bit_offset))
*p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
}
}
else
p += CHAR_STRING (c, p);
}
return p;
}
DEFUN ("single-key-description", Fsingle_key_description,
Ssingle_key_description, 1, 2, 0,
"Return a pretty description of command character KEY.\n\
Control characters turn into C-whatever, etc.\n\
Optional argument NO-ANGLES non-nil means don't put angle brackets\n\
around function keys and event symbols.")
(key, no_angles)
Lisp_Object key, no_angles;
{
if (CONSP (key) && lucid_event_type_list_p (key))
key = Fevent_convert_list (key);
key = EVENT_HEAD (key);
if (INTEGERP (key))
{
unsigned int charset, c1, c2;
int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
if (SINGLE_BYTE_CHAR_P (without_bits))
charset = 0;
else
SPLIT_CHAR (without_bits, charset, c1, c2);
if (charset
&& CHARSET_DEFINED_P (charset)
&& ((c1 >= 0 && c1 < 32)
|| (c2 >= 0 && c2 < 32)))
{
Lisp_Object name;
name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX);
CHECK_STRING (name, 0);
return concat2 (build_string ("Character set "), name);
}
else
{
char tem[KEY_DESCRIPTION_SIZE], *end;
int nbytes, nchars;
Lisp_Object string;
end = push_key_description (XUINT (key), tem, 1);
nbytes = end - tem;
nchars = multibyte_chars_in_text (tem, nbytes);
if (nchars == nbytes)
{
*end = '\0';
string = build_string (tem);
}
else
string = make_multibyte_string (tem, nchars, nbytes);
return string;
}
}
else if (SYMBOLP (key))
{
if (NILP (no_angles))
{
char *buffer
= (char *) alloca (STRING_BYTES (XSYMBOL (key)->name) + 5);
sprintf (buffer, "<%s>", XSYMBOL (key)->name->data);
return build_string (buffer);
}
else
return Fsymbol_name (key);
}
else if (STRINGP (key))
return Fcopy_sequence (key);
else
error ("KEY must be an integer, cons, symbol, or string");
return Qnil;
}
char *
push_text_char_description (c, p)
register unsigned int c;
register char *p;
{
if (c >= 0200)
{
*p++ = 'M';
*p++ = '-';
c -= 0200;
}
if (c < 040)
{
*p++ = '^';
*p++ = c + 64;
}
else if (c == 0177)
{
*p++ = '^';
*p++ = '?';
}
else
*p++ = c;
return p;
}
DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
"Return a pretty description of file-character CHARACTER.\n\
Control characters turn into \"^char\", etc.")
(character)
Lisp_Object character;
{
unsigned char str[6];
int c;
CHECK_NUMBER (character, 0);
c = XINT (character);
if (!SINGLE_BYTE_CHAR_P (c))
{
int len = CHAR_STRING (c, str);
return make_multibyte_string (str, 1, len);
}
*push_text_char_description (c & 0377, str) = 0;
return build_string (str);
}
static int
ascii_sequence_p (seq)
Lisp_Object seq;
{
int i;
int len = XINT (Flength (seq));
for (i = 0; i < len; i++)
{
Lisp_Object ii, elt;
XSETFASTINT (ii, i);
elt = Faref (seq, ii);
if (!INTEGERP (elt)
|| (XUINT (elt) & ~CHAR_META) >= 0x80)
return 0;
}
return 1;
}
static Lisp_Object where_is_internal_1 ();
static void where_is_internal_2 ();
static Lisp_Object
shadow_lookup (shadow, key, flag)
Lisp_Object shadow, key, flag;
{
Lisp_Object tail, value;
for (tail = shadow; CONSP (tail); tail = XCDR (tail))
{
value = Flookup_key (XCAR (tail), key, flag);
if (!NILP (value) && !NATNUMP (value))
return value;
}
return Qnil;
}
static Lisp_Object
where_is_internal (definition, keymaps, firstonly, noindirect)
Lisp_Object definition, keymaps;
Lisp_Object firstonly, noindirect;
{
Lisp_Object maps = Qnil;
Lisp_Object found, sequences;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
found = keymaps;
while (CONSP (found))
{
maps =
nconc2 (maps,
Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
found = XCDR (found);
}
GCPRO5 (definition, keymaps, maps, found, sequences);
found = Qnil;
sequences = Qnil;
for (; !NILP (maps); maps = Fcdr (maps))
{
register Lisp_Object this, map;
Lisp_Object last;
int last_is_meta;
this = Fcar (Fcar (maps));
map = Fcdr (Fcar (maps));
last = make_number (XINT (Flength (this)) - 1);
last_is_meta = (XINT (last) >= 0
&& EQ (Faref (this, last), meta_prefix_char));
if (nomenus && XINT (last) >= 0
&& !INTEGERP (Faref (this, make_number (0))))
continue;
QUIT;
while (CONSP (map))
{
Lisp_Object elt, key, binding;
elt = XCAR (map);
map = XCDR (map);
sequences = Qnil;
QUIT;
if (VECTORP (elt))
{
Lisp_Object sequence;
int i;
for (i = 0; i < XVECTOR (elt)->size; i++)
{
binding = AREF (elt, i);
XSETFASTINT (key, i);
sequence = where_is_internal_1 (binding, key, definition,
noindirect, this,
last, nomenus, last_is_meta);
if (!NILP (sequence))
sequences = Fcons (sequence, sequences);
}
}
else if (CHAR_TABLE_P (elt))
{
Lisp_Object indices[3];
Lisp_Object args;
args = Fcons (Fcons (Fcons (definition, noindirect),
Qnil),
Fcons (Fcons (this, last),
Fcons (make_number (nomenus),
make_number (last_is_meta))));
map_char_table (where_is_internal_2, Qnil, elt, args,
0, indices);
sequences = XCDR (XCAR (args));
}
else if (CONSP (elt))
{
Lisp_Object sequence;
key = XCAR (elt);
binding = XCDR (elt);
sequence = where_is_internal_1 (binding, key, definition,
noindirect, this,
last, nomenus, last_is_meta);
if (!NILP (sequence))
sequences = Fcons (sequence, sequences);
}
for (; ! NILP (sequences); sequences = XCDR (sequences))
{
Lisp_Object sequence;
sequence = XCAR (sequences);
if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
continue;
if (NILP (Fmember (sequence, found)))
found = Fcons (sequence, found);
if (EQ (firstonly, Qnon_ascii))
RETURN_UNGCPRO (sequence);
else if (! NILP (firstonly) && ascii_sequence_p (sequence))
RETURN_UNGCPRO (sequence);
}
}
}
UNGCPRO;
found = Fnreverse (found);
if (! NILP (firstonly))
return Fcar (found);
return found;
}
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\
If KEYMAP is nil, search all the currently active keymaps.\n\
If KEYMAP is a list of keymaps, search only those keymaps.\n\
\n\
If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\
rather than a list of all possible key sequences.\n\
If FIRSTONLY is the symbol `non-ascii', return the first binding found,\n\
no matter what it is.\n\
If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,\n\
and entirely reject menu bindings.\n\
\n\
If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
to other keymaps or slots. This makes it possible to search for an\n\
indirect definition itself.")
(definition, keymap, firstonly, noindirect)
Lisp_Object definition, keymap;
Lisp_Object firstonly, noindirect;
{
Lisp_Object sequences, keymaps;
int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
Lisp_Object result;
if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
keymaps = keymap;
else if (! NILP (keymap))
keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
else
keymaps =
Fdelq (Qnil,
nconc2 (Fcurrent_minor_mode_maps (),
Fcons (get_local_map (PT, current_buffer, Qkeymap),
Fcons (get_local_map (PT, current_buffer,
Qlocal_map),
Fcons (current_global_map, Qnil)))));
if (nomenus && NILP (noindirect) && NILP (keymap))
{
Lisp_Object *defns;
int i, j, n;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
where_is_cache = Qnil;
if (NILP (where_is_cache))
{
Lisp_Object args[2];
where_is_cache = Fmake_hash_table (0, args);
where_is_cache_keymaps = Qt;
GCPRO4 (definition, keymaps, firstonly, noindirect);
where_is_internal (definition, keymaps, firstonly, noindirect);
UNGCPRO;
where_is_cache_keymaps = keymaps;
}
sequences = Fgethash (definition, where_is_cache, Qnil);
n = XINT (Flength (sequences));
defns = (Lisp_Object *) alloca (n * sizeof *defns);
for (i = 0; CONSP (sequences); sequences = XCDR (sequences))
defns[i++] = XCAR (sequences);
GCPRO2 (definition, keymaps);
result = Qnil;
j = -1;
for (i = n - 1; i >= 0; --i)
if (EQ (shadow_lookup (keymaps, defns[i], Qnil), definition))
{
if (ascii_sequence_p (defns[i]))
break;
else if (j < 0)
j = i;
}
result = i >= 0 ? defns[i] : (j >= 0 ? defns[j] : Qnil);
UNGCPRO;
}
else
{
where_is_cache = Qnil;
result = where_is_internal (definition, keymaps, firstonly, noindirect);
}
return result;
}
static void
where_is_internal_2 (args, key, binding)
Lisp_Object args, key, binding;
{
Lisp_Object definition, noindirect, this, last;
Lisp_Object result, sequence;
int nomenus, last_is_meta;
struct gcpro gcpro1, gcpro2, gcpro3;
GCPRO3 (args, key, binding);
result = XCDR (XCAR (args));
definition = XCAR (XCAR (XCAR (args)));
noindirect = XCDR (XCAR (XCAR (args)));
this = XCAR (XCAR (XCDR (args)));
last = XCDR (XCAR (XCDR (args)));
nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));
sequence = where_is_internal_1 (binding, key, definition, noindirect,
this, last, nomenus, last_is_meta);
if (!NILP (sequence))
XCDR (XCAR (args)) = Fcons (sequence, result);
UNGCPRO;
}
static Lisp_Object
where_is_internal_1 (binding, key, definition, noindirect, this, last,
nomenus, last_is_meta)
Lisp_Object binding, key, definition, noindirect, this, last;
int nomenus, last_is_meta;
{
Lisp_Object sequence;
if (NILP (noindirect))
binding = get_keyelt (binding, 0);
if (!(!NILP (where_is_cache)
|| EQ (binding, definition)
|| (CONSP (definition) && !NILP (Fequal (binding, definition)))))
return Qnil;
if (INTEGERP (key) && last_is_meta)
{
sequence = Fcopy_sequence (this);
Faset (sequence, last, make_number (XINT (key) | meta_modifier));
}
else
sequence = append_key (this, key);
if (!NILP (where_is_cache))
{
Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
return Qnil;
}
else
return sequence;
}
DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, Sdescribe_bindings_internal, 0, 2, "",
"Show a list of all defined keys, and their definitions.\n\
We put that list in a buffer, and display the buffer.\n\
\n\
The optional argument MENUS, if non-nil, says to mention menu bindings.\n\
\(Ordinarily these are omitted from the output.)\n\
The optional argument PREFIX, if non-nil, should be a key sequence;\n\
then we display only bindings that start with that prefix.")
(menus, prefix)
Lisp_Object menus, prefix;
{
register Lisp_Object thisbuf;
XSETBUFFER (thisbuf, current_buffer);
internal_with_output_to_temp_buffer ("*Help*",
describe_buffer_bindings,
list3 (thisbuf, prefix, menus));
return Qnil;
}
static Lisp_Object
describe_buffer_bindings (arg)
Lisp_Object arg;
{
Lisp_Object descbuf, prefix, shadow;
int nomenu;
register Lisp_Object start1;
struct gcpro gcpro1;
char *alternate_heading
= "\
Keyboard translations:\n\n\
You type Translation\n\
-------- -----------\n";
descbuf = XCAR (arg);
arg = XCDR (arg);
prefix = XCAR (arg);
arg = XCDR (arg);
nomenu = NILP (XCAR (arg));
shadow = Qnil;
GCPRO1 (shadow);
Fset_buffer (Vstandard_output);
if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
{
int c;
unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
int translate_len = XSTRING (Vkeyboard_translate_table)->size;
for (c = 0; c < translate_len; c++)
if (translate[c] != c)
{
char buf[KEY_DESCRIPTION_SIZE];
char *bufend;
if (alternate_heading)
{
insert_string (alternate_heading);
alternate_heading = 0;
}
bufend = push_key_description (translate[c], buf, 1);
insert (buf, bufend - buf);
Findent_to (make_number (16), make_number (1));
bufend = push_key_description (c, buf, 1);
insert (buf, bufend - buf);
insert ("\n", 1);
}
insert ("\n", 1);
}
if (!NILP (Vkey_translation_map))
describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
"Key translations", nomenu, 1, 0);
{
int i, nmaps;
Lisp_Object *modes, *maps;
Fset_buffer (descbuf);
if (!NILP (current_kboard->Voverriding_terminal_local_map)
|| !NILP (Voverriding_local_map))
nmaps = 0;
else
nmaps = current_minor_maps (&modes, &maps);
Fset_buffer (Vstandard_output);
for (i = 0; i < nmaps; i++)
{
char *title, *p;
if (!SYMBOLP (modes[i]))
abort();
p = title = (char *) alloca (42 + XSYMBOL (modes[i])->name->size);
*p++ = '\f';
*p++ = '\n';
*p++ = '`';
bcopy (XSYMBOL (modes[i])->name->data, p,
XSYMBOL (modes[i])->name->size);
p += XSYMBOL (modes[i])->name->size;
*p++ = '\'';
bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
p += sizeof (" Minor Mode Bindings") - 1;
*p = 0;
describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0);
shadow = Fcons (maps[i], shadow);
}
}
if (!NILP (current_kboard->Voverriding_terminal_local_map))
start1 = current_kboard->Voverriding_terminal_local_map;
else if (!NILP (Voverriding_local_map))
start1 = Voverriding_local_map;
else
start1 = XBUFFER (descbuf)->keymap;
if (!NILP (start1))
{
describe_map_tree (start1, 1, shadow, prefix,
"\f\nMajor Mode Bindings", nomenu, 0, 0);
shadow = Fcons (start1, shadow);
}
describe_map_tree (current_global_map, 1, shadow, prefix,
"\f\nGlobal Bindings", nomenu, 0, 1);
if (!NILP (Vfunction_key_map))
describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
"\f\nFunction key map translations", nomenu, 1, 0);
call0 (intern ("help-mode"));
Fset_buffer (descbuf);
UNGCPRO;
return Qnil;
}
void
describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
always_title)
Lisp_Object startmap, shadow, prefix;
int partial;
char *title;
int nomenu;
int transl;
int always_title;
{
Lisp_Object maps, orig_maps, seen, sub_shadows;
struct gcpro gcpro1, gcpro2, gcpro3;
int something = 0;
char *key_heading
= "\
key binding\n\
--- -------\n";
orig_maps = maps = Faccessible_keymaps (startmap, prefix);
seen = Qnil;
sub_shadows = Qnil;
GCPRO3 (maps, seen, sub_shadows);
if (nomenu)
{
Lisp_Object list;
for (list = maps; !NILP (list); list = XCDR (list))
{
Lisp_Object elt, prefix, tem;
elt = Fcar (list);
prefix = Fcar (elt);
if (XVECTOR (prefix)->size >= 1)
{
tem = Faref (prefix, make_number (0));
if (EQ (tem, Qmenu_bar))
maps = Fdelq (elt, maps);
}
}
}
if (!NILP (maps) || always_title)
{
if (title)
{
insert_string (title);
if (!NILP (prefix))
{
insert_string (" Starting With ");
insert1 (Fkey_description (prefix));
}
insert_string (":\n");
}
insert_string (key_heading);
something = 1;
}
for (; !NILP (maps); maps = Fcdr (maps))
{
register Lisp_Object elt, prefix, tail;
elt = Fcar (maps);
prefix = Fcar (elt);
sub_shadows = Qnil;
for (tail = shadow; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object shmap;
shmap = XCAR (tail);
if ((STRINGP (prefix) && XSTRING (prefix)->size == 0)
|| (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
;
else
{
shmap = Flookup_key (shmap, Fcar (elt), Qt);
if (INTEGERP (shmap))
shmap = Qnil;
}
if (!NILP (shmap) && !KEYMAPP (shmap))
goto skip;
if (!NILP (shmap))
sub_shadows = Fcons (shmap, sub_shadows);
}
for (tail = orig_maps; ! EQ (tail, maps); tail = XCDR (tail))
{
Lisp_Object tem;
tem = Fequal (Fcar (XCAR (tail)), prefix);
if (! NILP (tem))
sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
}
describe_map (Fcdr (elt), prefix,
transl ? describe_translation : describe_command,
partial, sub_shadows, &seen, nomenu);
skip: ;
}
if (something)
insert_string ("\n");
UNGCPRO;
}
static int previous_description_column;
static void
describe_command (definition)
Lisp_Object definition;
{
register Lisp_Object tem1;
int column = current_column ();
int description_column;
if (column > 30)
{
insert_char ('\n');
description_column = 32;
}
else if (column > 14 || (column > 10 && previous_description_column == 32))
description_column = 32;
else
description_column = 16;
Findent_to (make_number (description_column), make_number (1));
previous_description_column = description_column;
if (SYMBOLP (definition))
{
XSETSTRING (tem1, XSYMBOL (definition)->name);
insert1 (tem1);
insert_string ("\n");
}
else if (STRINGP (definition) || VECTORP (definition))
insert_string ("Keyboard Macro\n");
else if (KEYMAPP (definition))
insert_string ("Prefix Command\n");
else
insert_string ("??\n");
}
static void
describe_translation (definition)
Lisp_Object definition;
{
register Lisp_Object tem1;
Findent_to (make_number (16), make_number (1));
if (SYMBOLP (definition))
{
XSETSTRING (tem1, XSYMBOL (definition)->name);
insert1 (tem1);
insert_string ("\n");
}
else if (STRINGP (definition) || VECTORP (definition))
{
insert1 (Fkey_description (definition));
insert_string ("\n");
}
else if (KEYMAPP (definition))
insert_string ("Prefix Command\n");
else
insert_string ("??\n");
}
static void
describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
register Lisp_Object map;
Lisp_Object keys;
void (*elt_describer) P_ ((Lisp_Object));
int partial;
Lisp_Object shadow;
Lisp_Object *seen;
int nomenu;
{
Lisp_Object elt_prefix;
Lisp_Object tail, definition, event;
Lisp_Object tem;
Lisp_Object suppress;
Lisp_Object kludge;
int first = 1;
struct gcpro gcpro1, gcpro2, gcpro3;
suppress = Qnil;
if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
{
tem = Fkey_description (keys);
elt_prefix = concat2 (tem, build_string (" "));
}
else
elt_prefix = Qnil;
if (partial)
suppress = intern ("suppress-keymap");
kludge = Fmake_vector (make_number (1), Qnil);
definition = Qnil;
GCPRO3 (elt_prefix, definition, kludge);
for (tail = map; CONSP (tail); tail = XCDR (tail))
{
QUIT;
if (VECTORP (XCAR (tail))
|| CHAR_TABLE_P (XCAR (tail)))
describe_vector (XCAR (tail),
elt_prefix, elt_describer, partial, shadow, map,
(int *)0, 0);
else if (CONSP (XCAR (tail)))
{
event = XCAR (XCAR (tail));
if (! (SYMBOLP (event) || INTEGERP (event)))
continue;
if (nomenu && EQ (event, Qmenu_bar))
continue;
definition = get_keyelt (XCDR (XCAR (tail)), 0);
if (NILP (definition)) continue;
if (SYMBOLP (definition) && partial)
{
tem = Fget (definition, suppress);
if (!NILP (tem))
continue;
}
ASET (kludge, 0, event);
if (!NILP (shadow))
{
tem = shadow_lookup (shadow, kludge, Qt);
if (!NILP (tem)) continue;
}
tem = Flookup_key (map, kludge, Qt);
if (! EQ (tem, definition)) continue;
if (first)
{
previous_description_column = 0;
insert ("\n", 1);
first = 0;
}
if (!NILP (elt_prefix))
insert1 (elt_prefix);
insert1 (Fsingle_key_description (event, Qnil));
(*elt_describer) (definition);
}
else if (EQ (XCAR (tail), Qkeymap))
{
tem = Fassq (tail, *seen);
if (CONSP (tem) && !NILP (Fequal (XCAR (tem), keys)))
break;
*seen = Fcons (Fcons (tail, keys), *seen);
}
}
UNGCPRO;
}
static void
describe_vector_princ (elt)
Lisp_Object elt;
{
Findent_to (make_number (16), make_number (1));
Fprinc (elt, Qnil);
Fterpri (Qnil);
}
DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0,
"Insert a description of contents of VECTOR.\n\
This is text showing the elements of vector matched against indices.")
(vector)
Lisp_Object vector;
{
int count = specpdl_ptr - specpdl;
specbind (Qstandard_output, Fcurrent_buffer ());
CHECK_VECTOR_OR_CHAR_TABLE (vector, 0);
describe_vector (vector, Qnil, describe_vector_princ, 0,
Qnil, Qnil, (int *)0, 0);
return unbind_to (count, Qnil);
}
void
describe_vector (vector, elt_prefix, elt_describer,
partial, shadow, entire_map,
indices, char_table_depth)
register Lisp_Object vector;
Lisp_Object elt_prefix;
void (*elt_describer) P_ ((Lisp_Object));
int partial;
Lisp_Object shadow;
Lisp_Object entire_map;
int *indices;
int char_table_depth;
{
Lisp_Object definition;
Lisp_Object tem2;
register int i;
Lisp_Object suppress;
Lisp_Object kludge;
int first = 1;
struct gcpro gcpro1, gcpro2, gcpro3;
int from, to;
int complete_char;
int character;
int starting_i;
suppress = Qnil;
if (indices == 0)
indices = (int *) alloca (3 * sizeof (int));
definition = Qnil;
kludge = Fmake_vector (make_number (1), Qnil);
GCPRO3 (elt_prefix, definition, kludge);
if (partial)
suppress = intern ("suppress-keymap");
if (CHAR_TABLE_P (vector))
{
if (char_table_depth == 0)
{
complete_char = 1;
from = 0;
to = CHAR_TABLE_ORDINARY_SLOTS;
}
else
{
if (char_table_depth >= 3)
error ("Too deep char table");
complete_char
= (CHARSET_VALID_P (indices[0])
&& ((CHARSET_DIMENSION (indices[0]) == 1
&& char_table_depth == 1)
|| char_table_depth == 2));
from = 32;
to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
}
}
else
{
complete_char = 1;
from = 0;
to = XVECTOR (vector)->size;
}
for (i = from; i < to; i++)
{
QUIT;
if (CHAR_TABLE_P (vector))
{
if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
complete_char = 0;
if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
&& !CHARSET_DEFINED_P (i - 128))
continue;
definition
= get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
}
else
definition = get_keyelt (AREF (vector, i), 0);
if (NILP (definition)) continue;
if (SYMBOLP (definition) && partial)
{
Lisp_Object tem;
tem = Fget (definition, suppress);
if (!NILP (tem)) continue;
}
if (CHAR_TABLE_P (vector))
{
indices[char_table_depth] = i;
if (char_table_depth == 0)
{
character = i;
indices[0] = i - 128;
}
else if (complete_char)
{
character = MAKE_CHAR (indices[0], indices[1], indices[2]);
}
else
character = 0;
}
else
character = i;
if (!NILP (shadow) && complete_char)
{
Lisp_Object tem;
ASET (kludge, 0, make_number (character));
tem = shadow_lookup (shadow, kludge, Qt);
if (!NILP (tem)) continue;
}
if (!NILP (entire_map) && complete_char)
{
Lisp_Object tem;
ASET (kludge, 0, make_number (character));
tem = Flookup_key (entire_map, kludge, Qt);
if (! EQ (tem, definition))
continue;
}
if (first)
{
if (char_table_depth == 0)
insert ("\n", 1);
first = 0;
}
if (char_table_depth > 0)
insert (" ", char_table_depth * 2);
if (!NILP (elt_prefix))
insert1 (elt_prefix);
if (SUB_CHAR_TABLE_P (vector))
{
if (complete_char)
insert_char (character);
else
{
char work[16];
sprintf (work, "(row %d)", i);
insert (work, strlen (work));
}
}
else if (CHAR_TABLE_P (vector))
{
if (complete_char)
insert1 (Fsingle_key_description (make_number (character), Qnil));
else
{
insert_string ("<");
tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
if (STRINGP (tem2))
insert_from_string (tem2, 0, 0, XSTRING (tem2)->size,
STRING_BYTES (XSTRING (tem2)), 0);
else
insert ("?", 1);
insert (">", 1);
}
}
else
{
insert1 (Fsingle_key_description (make_number (character), Qnil));
}
if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
{
insert ("\n", 1);
describe_vector (definition, elt_prefix, elt_describer,
partial, shadow, entire_map,
indices, char_table_depth + 1);
continue;
}
starting_i = i;
if (CHAR_TABLE_P (vector))
{
int limit = to;
if (char_table_depth == 0)
limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
while (i + 1 < limit
&& (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
!NILP (tem2))
&& !NILP (Fequal (tem2, definition)))
i++;
}
else
while (i + 1 < to
&& (tem2 = get_keyelt (AREF (vector, i + 1), 0),
!NILP (tem2))
&& !NILP (Fequal (tem2, definition)))
i++;
if (i != starting_i)
{
insert (" .. ", 4);
if (!NILP (elt_prefix))
insert1 (elt_prefix);
if (CHAR_TABLE_P (vector))
{
if (char_table_depth == 0)
{
insert1 (Fsingle_key_description (make_number (i), Qnil));
}
else if (complete_char)
{
indices[char_table_depth] = i;
character = MAKE_CHAR (indices[0], indices[1], indices[2]);
insert_char (character);
}
else
{
char work[16];
sprintf (work, "(row %d)", i);
insert (work, strlen (work));
}
}
else
{
insert1 (Fsingle_key_description (make_number (i), Qnil));
}
}
(*elt_describer) (definition);
}
if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
{
insert (" ", char_table_depth * 2);
insert_string ("<<default>>");
(*elt_describer) (XCHAR_TABLE (vector)->defalt);
}
UNGCPRO;
}
Lisp_Object apropos_predicate;
Lisp_Object apropos_accumulate;
static void
apropos_accum (symbol, string)
Lisp_Object symbol, string;
{
register Lisp_Object tem;
tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
if (!NILP (tem) && !NILP (apropos_predicate))
tem = call1 (apropos_predicate, symbol);
if (!NILP (tem))
apropos_accumulate = Fcons (symbol, apropos_accumulate);
}
DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
"Show all symbols whose names contain match for REGEXP.\n\
If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\
for each symbol and a symbol is mentioned only if that returns non-nil.\n\
Return list of symbols found.")
(regexp, predicate)
Lisp_Object regexp, predicate;
{
struct gcpro gcpro1, gcpro2;
CHECK_STRING (regexp, 0);
apropos_predicate = predicate;
GCPRO2 (apropos_predicate, apropos_accumulate);
apropos_accumulate = Qnil;
map_obarray (Vobarray, apropos_accum, regexp);
apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
UNGCPRO;
return apropos_accumulate;
}
void
syms_of_keymap ()
{
Qkeymap = intern ("keymap");
staticpro (&Qkeymap);
Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
global_map = Fmake_keymap (Qnil);
Fset (intern ("global-map"), global_map);
current_global_map = global_map;
staticpro (&global_map);
staticpro (¤t_global_map);
meta_map = Fmake_keymap (Qnil);
Fset (intern ("esc-map"), meta_map);
Ffset (intern ("ESC-prefix"), meta_map);
control_x_map = Fmake_keymap (Qnil);
Fset (intern ("ctl-x-map"), control_x_map);
Ffset (intern ("Control-X-prefix"), control_x_map);
DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
"List of commands given new key bindings recently.\n\
This is used for internal purposes during Emacs startup;\n\
don't alter it yourself.");
Vdefine_key_rebound_commands = Qt;
DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
"Default keymap to use when reading from the minibuffer.");
Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
"Local keymap for the minibuffer when spaces are not allowed.");
Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
"Local keymap for minibuffer input with completion.");
Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
"Local keymap for minibuffer input with completion, for exact match.");
Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
"Alist of keymaps to use for minor modes.\n\
Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
If two active keymaps bind the same key, the keymap appearing earlier\n\
in the list takes precedence.");
Vminor_mode_map_alist = Qnil;
DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
"Alist of keymaps to use for minor modes, in current major mode.\n\
This variable is a alist just like `minor-mode-map-alist', and it is\n\
used the same way (and before `minor-mode-map-alist'); however,\n\
it is provided for major modes to bind locally.");
Vminor_mode_overriding_map_alist = Qnil;
DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
"Keymap mapping ASCII function key sequences onto their preferred forms.\n\
This allows Emacs to recognize function keys sent from ASCII\n\
terminals at any point in a key sequence.\n\
\n\
The `read-key-sequence' function replaces any subsequence bound by\n\
`function-key-map' with its binding. More precisely, when the active\n\
keymaps have no binding for the current key sequence but\n\
`function-key-map' binds a suffix of the sequence to a vector or string,\n\
`read-key-sequence' replaces the matching suffix with its binding, and\n\
continues with the new sequence.\n\
\n\
The events that come from bindings in `function-key-map' are not\n\
themselves looked up in `function-key-map'.\n\
\n\
For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\
Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\
`C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\
key, typing `ESC O P x' would return [f1 x].");
Vfunction_key_map = Fmake_sparse_keymap (Qnil);
DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
"Keymap of key translations that can override keymaps.\n\
This keymap works like `function-key-map', but comes after that,\n\
and applies even for keys that have ordinary bindings.");
Vkey_translation_map = Qnil;
Qsingle_key_description = intern ("single-key-description");
staticpro (&Qsingle_key_description);
Qkey_description = intern ("key-description");
staticpro (&Qkey_description);
Qkeymapp = intern ("keymapp");
staticpro (&Qkeymapp);
Qnon_ascii = intern ("non-ascii");
staticpro (&Qnon_ascii);
Qmenu_item = intern ("menu-item");
staticpro (&Qmenu_item);
where_is_cache_keymaps = Qt;
where_is_cache = Qnil;
staticpro (&where_is_cache);
staticpro (&where_is_cache_keymaps);
defsubr (&Skeymapp);
defsubr (&Skeymap_parent);
defsubr (&Sset_keymap_parent);
defsubr (&Smake_keymap);
defsubr (&Smake_sparse_keymap);
defsubr (&Scopy_keymap);
defsubr (&Skey_binding);
defsubr (&Slocal_key_binding);
defsubr (&Sglobal_key_binding);
defsubr (&Sminor_mode_key_binding);
defsubr (&Sdefine_key);
defsubr (&Slookup_key);
defsubr (&Sdefine_prefix_command);
defsubr (&Suse_global_map);
defsubr (&Suse_local_map);
defsubr (&Scurrent_local_map);
defsubr (&Scurrent_global_map);
defsubr (&Scurrent_minor_mode_maps);
defsubr (&Saccessible_keymaps);
defsubr (&Skey_description);
defsubr (&Sdescribe_vector);
defsubr (&Ssingle_key_description);
defsubr (&Stext_char_description);
defsubr (&Swhere_is_internal);
defsubr (&Sdescribe_bindings_internal);
defsubr (&Sapropos_internal);
}
void
keys_of_keymap ()
{
initial_define_key (global_map, 033, "ESC-prefix");
initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
}