/* Manipulation of keymaps
- Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 2001
+ Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 01, 2004
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "buffer.h"
#include "charset.h"
#include "keyboard.h"
+#include "frame.h"
#include "termhooks.h"
#include "blockinput.h"
#include "puresize.h"
/* 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
static void describe_map P_ ((Lisp_Object, Lisp_Object,
void (*) P_ ((Lisp_Object, Lisp_Object)),
int, Lisp_Object, Lisp_Object*, 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));
static void silly_event_symbol_error P_ ((Lisp_Object));
\f
/* Keymap object support - constructors and predicates. */
{
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;
+ 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, Qnil)));
}
}
/* 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);
+ 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));
+ }
- Faset (tem, last, make_number (XINT (key) | meta_bit));
+ /* 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);
- /* 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));
- }
- }
+ 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;
/* This function cannot GC. */
-DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
+DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
doc: /* Return a pretty description of key-sequence KEYS.
+Optional arg PREFIX is the sequence of keys leading up to KEYS.
Control characters turn into "C-foo" sequences, meta into "M-foo"
spaces are put between sequence elements, etc. */)
- (keys)
- Lisp_Object keys;
+ (keys, prefix)
+ Lisp_Object keys, prefix;
{
int len = 0;
int i, i_byte;
- Lisp_Object sep;
- Lisp_Object *args = NULL;
+ Lisp_Object *args;
+ int size = Flength (keys);
+ Lisp_Object list;
+ Lisp_Object sep = build_string (" ");
+ Lisp_Object key;
+ int add_meta = 0;
+
+ if (!NILP (prefix))
+ size += Flength (prefix);
+
+ /* This has one extra element at the end that we don't pass to Fconcat. */
+ args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
- if (STRINGP (keys))
+ /* In effect, this computes
+ (mapconcat 'single-key-description keys " ")
+ but we shouldn't use mapconcat because it can do GC. */
+
+ next_list:
+ if (!NILP (prefix))
+ list = prefix, prefix = Qnil;
+ else if (!NILP (keys))
+ list = keys, keys = Qnil;
+ else
{
- Lisp_Object vector;
- vector = Fmake_vector (Flength (keys), Qnil);
- for (i = 0, i_byte = 0; i < XSTRING (keys)->size; )
+ if (add_meta)
{
- 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);
+ args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
+ len += 2;
}
- keys = vector;
+ else if (len == 0)
+ return empty_string;
+ return Fconcat (len - 1, args);
}
- if (VECTORP (keys))
- {
- /* In effect, this computes
- (mapconcat 'single-key-description keys " ")
- but we shouldn't use mapconcat because it can do GC. */
+ if (STRINGP (list))
+ size = SCHARS (list);
+ else if (VECTORP (list))
+ size = XVECTOR (list)->size;
+ else if (CONSP (list))
+ size = Flength (list);
+ else
+ wrong_type_argument (Qarrayp, list);
- len = XVECTOR (keys)->size;
- sep = build_string (" ");
- /* This has one extra element at the end that we don't pass to Fconcat. */
- args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
+ i = i_byte = 0;
- for (i = 0; i < len; i++)
+ while (i < size)
+ {
+ if (STRINGP (list))
+ {
+ int c;
+ FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
+ if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
+ c ^= 0200 | meta_modifier;
+ XSETFASTINT (key, c);
+ }
+ else if (VECTORP (list))
{
- args[i * 2] = Fsingle_key_description (AREF (keys, i), Qnil);
- args[i * 2 + 1] = sep;
+ key = AREF (list, i++);
+ }
+ else
+ {
+ key = XCAR (list);
+ list = XCDR (list);
+ i++;
}
- }
- else if (CONSP (keys))
- {
- /* In effect, this computes
- (mapconcat 'single-key-description keys " ")
- but we shouldn't use mapconcat because it can do GC. */
-
- len = XFASTINT (Flength (keys));
- sep = build_string (" ");
- /* This has one extra element at the end that we don't pass to Fconcat. */
- args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
- for (i = 0; i < len; i++)
+ if (add_meta)
+ {
+ if (!INTEGERP (key)
+ || EQ (key, meta_prefix_char)
+ || (XINT (key) & meta_modifier))
+ {
+ args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
+ args[len++] = sep;
+ if (EQ (key, meta_prefix_char))
+ continue;
+ }
+ else
+ XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
+ add_meta = 0;
+ }
+ else if (EQ (key, meta_prefix_char))
{
- args[i * 2] = Fsingle_key_description (XCAR (keys), Qnil);
- args[i * 2 + 1] = sep;
- keys = XCDR (keys);
+ add_meta = 1;
+ continue;
}
+ args[len++] = Fsingle_key_description (key, Qnil);
+ args[len++] = sep;
}
- else
- keys = wrong_type_argument (Qarrayp, keys);
-
- if (len == 0)
- return empty_string;
- return Fconcat (len * 2 - 1, args);
+ goto next_list;
}
+
char *
push_key_description (c, p, force_multibyte)
register unsigned int c;
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 Vmouse_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)), Vmouse_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 (!NILP (prefix))
{
insert_string (" Starting With ");
- insert1 (Fkey_description (prefix));
+ insert1 (Fkey_description (prefix, Qnil));
}
insert_string (":\n");
}
/* 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
}
else if (STRINGP (definition) || VECTORP (definition))
{
- insert1 (Fkey_description (definition));
+ insert1 (Fkey_description (definition, Qnil));
insert_string ("\n");
}
else if (KEYMAPP (definition))
}
/* Describe the contents of map MAP, assuming that this map itself is
- reached by the sequence of prefix keys KEYS (a string or vector).
+ reached by the sequence of prefix keys PREFIX (a string or vector).
PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
static void
-describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
+describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
register Lisp_Object map;
- Lisp_Object keys;
+ Lisp_Object prefix;
void (*elt_describer) P_ ((Lisp_Object, 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;
suppress = Qnil;
- if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
- {
- /* Call Fkey_description first, to avoid GC bug for the other string. */
- 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);
+ GCPRO3 (prefix, definition, kludge);
for (tail = map; CONSP (tail); tail = XCDR (tail))
{
if (VECTORP (XCAR (tail))
|| CHAR_TABLE_P (XCAR (tail)))
describe_vector (XCAR (tail),
- elt_prefix, Qnil, elt_describer, partial, shadow, map,
- (int *)0, 0);
+ prefix, Qnil, elt_describer, partial, shadow, map,
+ (int *)0, 0, 1);
else if (CONSP (XCAR (tail)))
{
event = XCAR (XCAR (tail));
- /* Ignore bindings whose "keys" are not really valid events.
+ /* Ignore bindings whose "prefix" are not really valid events.
(We get these in the frames and buffers menu.) */
if (!(SYMBOLP (event) || INTEGERP (event)))
continue;
first = 0;
}
- if (!NILP (elt_prefix))
- insert1 (elt_prefix);
-
/* THIS gets the string to describe the character EVENT. */
- insert1 (Fsingle_key_description (event, Qnil));
+ insert1 (Fkey_description (kludge, prefix));
/* Print a description of the definition of this character.
elt_describer will take care of spacing out far enough
using an inherited keymap. So skip anything we've already
encountered. */
tem = Fassq (tail, *seen);
- if (CONSP (tem) && !NILP (Fequal (XCAR (tem), keys)))
+ if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
break;
- *seen = Fcons (Fcons (tail, keys), *seen);
+ *seen = Fcons (Fcons (tail, prefix), *seen);
}
}
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);
+ Qnil, Qnil, (int *)0, 0, 0);
return unbind_to (count, Qnil);
}
indices at higher levels in this char-table,
and CHAR_TABLE_DEPTH says how many levels down we have gone.
+ KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
+
ARGS is simply passed as the second argument to ELT_DESCRIBER. */
-void
-describe_vector (vector, elt_prefix, args, elt_describer,
+static void
+describe_vector (vector, prefix, args, elt_describer,
partial, shadow, entire_map,
- indices, char_table_depth)
+ indices, char_table_depth, keymap_p)
register Lisp_Object vector;
- Lisp_Object elt_prefix, args;
+ Lisp_Object prefix, args;
void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
int partial;
Lisp_Object shadow;
Lisp_Object entire_map;
int *indices;
int char_table_depth;
+ int keymap_p;
{
Lisp_Object definition;
Lisp_Object tem2;
+ Lisp_Object elt_prefix = Qnil;
register int i;
Lisp_Object suppress;
Lisp_Object kludge;
int first = 1;
- struct gcpro gcpro1, gcpro2, gcpro3;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
/* Range of elements to be handled. */
int from, to;
/* A flag to tell if a leaf in this level of char-table is not a
definition = Qnil;
+ if (!keymap_p)
+ {
+ /* Call Fkey_description first, to avoid GC bug for the other string. */
+ if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
+ {
+ Lisp_Object tem;
+ tem = Fkey_description (prefix, Qnil);
+ elt_prefix = concat2 (tem, build_string (" "));
+ }
+ prefix = Qnil;
+ }
+
/* This vector gets used to present single keys to Flookup_key. Since
that is done once per vector element, we don't want to cons up a
fresh vector every time. */
kludge = Fmake_vector (make_number (1), Qnil);
- GCPRO3 (elt_prefix, definition, kludge);
+ GCPRO4 (elt_prefix, prefix, definition, kludge);
if (partial)
suppress = intern ("suppress-keymap");
else
character = i;
+ ASET (kludge, 0, make_number (character));
+
/* If this binding is shadowed by some other map, ignore it. */
if (!NILP (shadow) && complete_char)
{
Lisp_Object tem;
- ASET (kludge, 0, make_number (character));
tem = shadow_lookup (shadow, kludge, Qt);
if (!NILP (tem)) continue;
{
Lisp_Object tem;
- ASET (kludge, 0, make_number (character));
tem = Flookup_key (entire_map, kludge, Qt);
if (!EQ (tem, definition))
else if (CHAR_TABLE_P (vector))
{
if (complete_char)
- insert1 (Fsingle_key_description (make_number (character), Qnil));
+ insert1 (Fkey_description (kludge, prefix));
else
{
/* Print the information for this character set. */
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);
}
else
{
- insert1 (Fsingle_key_description (make_number (character), Qnil));
+ insert1 (Fkey_description (kludge, prefix));
}
/* If we find a sub char-table within a char-table,
if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
{
insert ("\n", 1);
- describe_vector (definition, elt_prefix, args, elt_describer,
+ describe_vector (definition, prefix, args, elt_describer,
partial, shadow, entire_map,
- indices, char_table_depth + 1);
+ indices, char_table_depth + 1, keymap_p);
continue;
}
{
insert (" .. ", 4);
+ ASET (kludge, 0, make_number (i));
+
if (!NILP (elt_prefix))
insert1 (elt_prefix);
{
if (char_table_depth == 0)
{
- insert1 (Fsingle_key_description (make_number (i), Qnil));
+ insert1 (Fkey_description (kludge, prefix));
}
else if (complete_char)
{
}
else
{
- insert1 (Fsingle_key_description (make_number (i), Qnil));
+ insert1 (Fkey_description (kludge, prefix));
}
}
}
\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 (&Vmouse_events);
+ Vmouse_events = Fcons (intern ("menu-bar"),
+ Fcons (intern ("tool-bar"),
+ Fcons (intern ("header-line"),
+ Fcons (intern ("mode-line"),
+ Fcons (intern ("mouse-1"),
+ Fcons (intern ("mouse-2"),
+ Fcons (intern ("mouse-3"),
+ Fcons (intern ("mouse-4"),
+ Fcons (intern ("mouse-5"),
+ 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);
initial_define_key (global_map, 033, "ESC-prefix");
initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
}
+
+/* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
+ (do not change this comment) */
HCoop / bpt / emacs.git / blobdiff