/* Alist of elements like (DEL . "\d"). */
static Lisp_Object exclude_keys;
-/* Pre-allocated 2-element vector for Fremap_command to use. */
-static Lisp_Object remap_command_vector;
+/* Pre-allocated 2-element vector for Fcommand_remapping to use. */
+static Lisp_Object command_remapping_vector;
/* A char with the CHAR_META bit set in a vector or the 0200 bit set
in a string key sequence is equivalent to prefixing with this
{
Lisp_Object indices[3];
- map_char_table (fix_submap_inheritance, Qnil, XCAR (list),
+ map_char_table (fix_submap_inheritance, Qnil,
+ XCAR (list), XCAR (list),
keymap, 0, indices);
}
}
}
}
+static void
+map_keymap_item (fun, args, key, val, data)
+ map_keymap_function_t fun;
+ Lisp_Object args, key, val;
+ void *data;
+{
+ /* We should maybe try to detect bindings shadowed by previous
+ ones and things like that. */
+ if (EQ (val, Qt))
+ val = Qnil;
+ (*fun) (key, val, args, data);
+}
+
+static void
+map_keymap_char_table_item (args, key, val)
+ Lisp_Object args, key, val;
+{
+ if (!NILP (val))
+ {
+ map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer;
+ args = XCDR (args);
+ map_keymap_item (fun, XCDR (args), key, val,
+ XSAVE_VALUE (XCAR (args))->pointer);
+ }
+}
+
+/* Call FUN for every binding in MAP.
+ FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
+ AUTOLOAD if non-zero means that we can autoload keymaps if necessary. */
+void
+map_keymap (map, fun, args, data, autoload)
+ map_keymap_function_t fun;
+ Lisp_Object map, args;
+ void *data;
+ int autoload;
+{
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object tail;
+
+ GCPRO3 (map, args, tail);
+ map = get_keymap (map, 1, autoload);
+ for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
+ CONSP (tail) || (tail = get_keymap (tail, 0, autoload), CONSP (tail));
+ tail = XCDR (tail))
+ {
+ Lisp_Object binding = XCAR (tail);
+
+ if (CONSP (binding))
+ map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
+ else if (VECTORP (binding))
+ {
+ /* Loop over the char values represented in the vector. */
+ int len = ASIZE (binding);
+ int c;
+ abort();
+ for (c = 0; c < len; c++)
+ {
+ Lisp_Object character;
+ XSETFASTINT (character, c);
+ map_keymap_item (fun, args, character, AREF (binding, c), data);
+ }
+ }
+ else if (CHAR_TABLE_P (binding))
+ {
+ Lisp_Object indices[3];
+ map_char_table (map_keymap_char_table_item, Qnil, binding, binding,
+ Fcons (make_save_value (fun, 0),
+ Fcons (make_save_value (data, 0),
+ args)),
+ 0, indices);
+ }
+ }
+ UNGCPRO;
+}
+
+static void
+map_keymap_call (key, val, fun, dummy)
+ Lisp_Object key, val, fun;
+ void *dummy;
+{
+ call2 (fun, key, val);
+}
+
+DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 2, 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;
+{
+ if (INTEGERP (function))
+ /* We have to stop integers early since map_keymap gives them special
+ significance. */
+ Fsignal (Qinvalid_function, Fcons (function, Qnil));
+ map_keymap (keymap, map_keymap_call, function, NULL, 1);
+ return Qnil;
+}
+
/* Given OBJECT which was found in a slot in a keymap,
trace indirect definitions to get the actual definition of that slot.
An indirect definition is a list of the form
return res;
}
-void
+static void
copy_keymap_1 (chartable, idx, elt)
Lisp_Object chartable, idx, elt;
{
{
Lisp_Object indices[3];
elt = Fcopy_sequence (elt);
- map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices);
+ map_char_table (copy_keymap_1, Qnil, elt, elt, elt, 0, indices);
}
else if (VECTORP (elt))
{
/* GC is possible in this function if it autoloads a keymap. */
DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
- doc: /* Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.
+ doc: /* In KEYMAP, define key sequence KEY as DEF.
KEYMAP is a keymap.
KEY is a string or a vector of symbols and characters meaning a
sequence of keystrokes and events. Non-ASCII characters with codes
above 127 (such as ISO Latin-1) can be included if you use a vector.
Using [t] for KEY creates a default definition, which applies to any
-event type that has no other definition in thus keymap.
+event type that has no other definition in this keymap.
DEF is anything that can be a key's definition:
nil (means key is undefined in this keymap),
(DEFN should be a valid definition in its own right),
or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
-If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at
-the front of KEYMAP. */)
+If KEYMAP is a sparse keymap with a binding for KEY, the existing
+binding is altered. If there is no binding for KEY, the new pair
+binding KEY to DEF is added at the front of KEYMAP. */)
(keymap, key, def)
Lisp_Object keymap;
Lisp_Object key;
/* We must use Fkey_description rather than just passing key to
error; key might be a vector, not a string. */
error ("Key sequence %s uses invalid prefix characters",
- XSTRING (Fkey_description (key))->data);
+ SDATA (Fkey_description (key)));
}
}
/* This function may GC (it calls Fkey_binding). */
-DEFUN ("remap-command", Fremap_command, Sremap_command, 1, 1, 0,
+DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 1, 0,
doc: /* Return the remapping for command COMMAND in current keymaps.
-Returns nil if COMMAND is not remapped. */)
+Returns nil if COMMAND is not remapped (or not a symbol). */)
(command)
Lisp_Object command;
{
- ASET (remap_command_vector, 1, command);
- return Fkey_binding (remap_command_vector, Qnil, Qt);
+ if (!SYMBOLP (command))
+ return Qnil;
+
+ ASET (command_remapping_vector, 1, command);
+ return Fkey_binding (command_remapping_vector, Qnil, Qt);
}
/* Value is number if KEY is too long; nil if valid but has no definition. */
error ((modifiers & ~meta_modifier
? "To bind the key %s, use [?%s], not [%s]"
: "To bind the key %s, use \"%s\", not [%s]"),
- XSTRING (SYMBOL_NAME (c))->data, XSTRING (keystring)->data,
- XSTRING (SYMBOL_NAME (c))->data);
+ SDATA (SYMBOL_NAME (c)), SDATA (keystring),
+ SDATA (SYMBOL_NAME (c)));
}
}
\f
Like the normal command loop, `key-binding' will remap the command
resulting from looking up KEY by looking up the command in the
-currrent keymaps. However, if the optional third argument NO-REMAP
+current keymaps. However, if the optional third argument NO-REMAP
is non-nil, `key-binding' returns the unmapped command. */)
(key, accept_default, no_remap)
Lisp_Object key, accept_default, no_remap;
if (NILP (no_remap) && SYMBOLP (value))
{
Lisp_Object value1;
- if (value1 = Fremap_command (value), !NILP (value1))
+ if (value1 = Fcommand_remapping (value), !NILP (value1))
value = value1;
}
{
Lisp_Object tem;
- cmd = get_keyelt (cmd, 0);
+ cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
if (NILP (cmd))
return;
- tem = get_keymap (cmd, 0, 0);
- if (CONSP (tem))
+ /* Look for and break cycles. */
+ while (!NILP (tem = Frassq (cmd, maps)))
{
- cmd = tem;
- /* Ignore keymaps that are already added to maps. */
- tem = Frassq (cmd, maps);
- if (NILP (tem))
- {
- /* If the last key in thisseq is meta-prefix-char,
- turn it into a meta-ized keystroke. We know
- that the event we're about to append is an
- ascii keystroke since we're processing a
- keymap table. */
- 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 (key) | meta_bit));
-
- /* This new sequence is the same length as
- thisseq, so stick it in the list right
- after this one. */
- XSETCDR (tail,
- Fcons (Fcons (tem, cmd), XCDR (tail)));
- }
- else
- {
- tem = append_key (thisseq, key);
- nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
- }
+ Lisp_Object prefix = XCAR (tem);
+ int lim = XINT (Flength (XCAR (tem)));
+ if (lim <= XINT (Flength (thisseq)))
+ { /* This keymap was already seen with a smaller prefix. */
+ int i = 0;
+ while (i < lim && EQ (Faref (prefix, make_number (i)),
+ Faref (thisseq, make_number (i))))
+ i++;
+ if (i >= lim)
+ /* `prefix' is a prefix of `thisseq' => there's a cycle. */
+ return;
}
+ /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
+ but maybe `cmd' occurs again further down in `maps', so keep
+ looking. */
+ maps = XCDR (Fmemq (tem, maps));
+ }
+
+ /* If the last key in thisseq is meta-prefix-char,
+ turn it into a meta-ized keystroke. We know
+ that the event we're about to append is an
+ ascii keystroke since we're processing a
+ keymap table. */
+ 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 (key) | meta_bit));
+
+ /* This new sequence is the same length as
+ thisseq, so stick it in the list right
+ after this one. */
+ XSETCDR (tail,
+ Fcons (Fcons (tem, cmd), XCDR (tail)));
+ }
+ else
+ {
+ tem = append_key (thisseq, key);
+ nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
}
}
(keymap, prefix)
Lisp_Object keymap, prefix;
{
- Lisp_Object maps, good_maps, tail;
+ Lisp_Object maps, tail;
int prefixlen = 0;
/* no need for gcpro because we don't autoload any keymaps. */
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;)
+ copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
+ for (i = 0, i_byte = 0; i < SCHARS (prefix);)
{
int i_before = i;
{
Lisp_Object indices[3];
- map_char_table (accessible_keymaps_char_table, Qnil,
+ map_char_table (accessible_keymaps_char_table, Qnil, elt,
elt, Fcons (Fcons (maps, make_number (is_metized)),
Fcons (tail, thisseq)),
0, indices);
}
}
- if (NILP (prefix))
- return maps;
-
- /* Now find just the maps whose access prefixes start with PREFIX. */
-
- good_maps = Qnil;
- for (; CONSP (maps); maps = XCDR (maps))
- {
- Lisp_Object elt, thisseq;
- elt = XCAR (maps);
- thisseq = XCAR (elt);
- /* The access prefix must be at least as long as PREFIX,
- and the first elements must match those of PREFIX. */
- 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);
+ return maps;
}
\f
Lisp_Object Qsingle_key_description, Qkey_description;
{
Lisp_Object vector;
vector = Fmake_vector (Flength (keys), Qnil);
- for (i = 0, i_byte = 0; i < XSTRING (keys)->size; )
+ for (i = 0, i_byte = 0; i < SCHARS (keys); )
{
int c;
int i_before = i;
if (NILP (no_angles))
{
char *buffer
- = (char *) alloca (STRING_BYTES (XSTRING (SYMBOL_NAME (key))) + 5);
- sprintf (buffer, "<%s>", XSTRING (SYMBOL_NAME (key))->data);
+ = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
+ sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
return build_string (buffer);
}
else
return Qnil;
}
+static Lisp_Object Vmenu_events;
+
/* This function can GC if Flookup_key autoloads any keymaps. */
static Lisp_Object
if (NILP (no_remap) && SYMBOLP (definition))
{
Lisp_Object tem;
- if (tem = Fremap_command (definition), !NILP (tem))
+ if (tem = Fcommand_remapping (definition), !NILP (tem))
return Qnil;
}
for (; !NILP (maps); maps = Fcdr (maps))
{
/* Key sequence to reach map, and the map that it reaches */
- register Lisp_Object this, map;
+ register Lisp_Object this, map, tem;
/* In order to fold [META-PREFIX-CHAR CHAR] sequences into
[M-CHAR] sequences, check if last character of the sequence
/* if (nomenus && !ascii_sequence_p (this)) */
if (nomenus && XINT (last) >= 0
- && !INTEGERP (Faref (this, make_number (0))))
+ && SYMBOLP (tem = Faref (this, make_number (0)))
+ && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmenu_events)))
/* If no menu entries should be returned, skip over the
keymaps bound to `menu-bar' and `tool-bar' and other
non-ascii prefixes like `C-down-mouse-2'. */
Fcons (Fcons (this, last),
Fcons (make_number (nomenus),
make_number (last_is_meta))));
- map_char_table (where_is_internal_2, Qnil, elt, args,
+ map_char_table (where_is_internal_2, Qnil, elt, elt, args,
0, indices);
sequences = XCDR (XCAR (args));
}
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;
+ const unsigned char *translate = SDATA (Vkeyboard_translate_table);
+ int translate_len = SCHARS (Vkeyboard_translate_table);
for (c = 0; c < translate_len; c++)
if (translate[c] != c)
if (!SYMBOLP (modes[i]))
abort();
- p = title = (char *) alloca (42 + XSTRING (SYMBOL_NAME (modes[i]))->size);
+ p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
*p++ = '\f';
*p++ = '\n';
*p++ = '`';
- bcopy (XSTRING (SYMBOL_NAME (modes[i]))->data, p,
- XSTRING (SYMBOL_NAME (modes[i]))->size);
- p += XSTRING (SYMBOL_NAME (modes[i]))->size;
+ bcopy (SDATA (SYMBOL_NAME (modes[i])), p,
+ SCHARS (SYMBOL_NAME (modes[i])));
+ p += SCHARS (SYMBOL_NAME (modes[i]));
*p++ = '\'';
bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
p += sizeof (" Minor Mode Bindings") - 1;
/* If the sequence by which we reach this keymap is zero-length,
then the shadow map for this keymap is just SHADOW. */
- if ((STRINGP (prefix) && XSTRING (prefix)->size == 0)
+ if ((STRINGP (prefix) && SCHARS (prefix) == 0)
|| (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
;
/* If the sequence by which we reach this keymap actually has
(vector, describer)
Lisp_Object vector, describer;
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
if (NILP (describer))
describer = intern ("princ");
specbind (Qstandard_output, Fcurrent_buffer ());
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);
+ insert_from_string (tem2, 0, 0, SCHARS (tem2),
+ SBYTES (tem2), 0);
else
insert ("?", 1);
insert (">", 1);
}
\f
/* Apropos - finding all symbols whose names match a regexp. */
-Lisp_Object apropos_predicate;
-Lisp_Object apropos_accumulate;
+static Lisp_Object apropos_predicate;
+static Lisp_Object apropos_accumulate;
static void
apropos_accum (symbol, string)
(regexp, predicate)
Lisp_Object regexp, predicate;
{
- struct gcpro gcpro1, gcpro2;
+ Lisp_Object tem;
CHECK_STRING (regexp);
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;
+ tem = Fsort (apropos_accumulate, Qstring_lessp);
+ apropos_accumulate = Qnil;
+ apropos_predicate = Qnil;
+ return tem;
}
\f
void
{
Qkeymap = intern ("keymap");
staticpro (&Qkeymap);
+ staticpro (&apropos_predicate);
+ staticpro (&apropos_accumulate);
+ apropos_predicate = Qnil;
+ apropos_accumulate = Qnil;
/* Now we are ready to set up this property, so we can
create char tables. */
and applies even for keys that have ordinary bindings. */);
Vkey_translation_map = Qnil;
+ staticpro (&Vmenu_events);
+ Vmenu_events = Fcons (intern ("menu-bar"),
+ Fcons (intern ("tool-bar"),
+ Fcons (intern ("mouse-1"),
+ Fcons (intern ("mouse-2"),
+ Fcons (intern ("mouse-3"),
+ Qnil)))));
+
+
Qsingle_key_description = intern ("single-key-description");
staticpro (&Qsingle_key_description);
Qremap = intern ("remap");
staticpro (&Qremap);
- remap_command_vector = Fmake_vector (make_number (2), Qremap);
- staticpro (&remap_command_vector);
+ command_remapping_vector = Fmake_vector (make_number (2), Qremap);
+ staticpro (&command_remapping_vector);
where_is_cache_keymaps = Qt;
where_is_cache = Qnil;
defsubr (&Sset_keymap_parent);
defsubr (&Smake_keymap);
defsubr (&Smake_sparse_keymap);
+ defsubr (&Smap_keymap);
defsubr (&Scopy_keymap);
- defsubr (&Sremap_command);
+ defsubr (&Scommand_remapping);
defsubr (&Skey_binding);
defsubr (&Slocal_key_binding);
defsubr (&Sglobal_key_binding);