#include "intervals.h"
#define min(a, b) ((a) < (b) ? (a) : (b))
+#define KEYMAPP(m) (!NILP (Fkeymapp (m)))
/* The number of elements in keymap vectors. */
#define DENSE_TABLE_SIZE (0200)
extern Lisp_Object Voverriding_local_map;
-static Lisp_Object define_as_prefix ();
-static Lisp_Object describe_buffer_bindings ();
-static void describe_command (), describe_translation ();
-static void describe_map ();
+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));
\f
/* Keymap object support - constructors and predicates. */
(object)
Lisp_Object object;
{
+ /* FIXME: Maybe this should return t for autoloaded keymaps? -sm */
return (NILP (get_keymap_1 (object, 0, 0)) ? Qnil : Qt);
}
Functions like Faccessible_keymaps which scan entire keymap trees
shouldn't load every autoloaded keymap. I'm not sure about this,
but it seems to me that only read_key_sequence, Flookup_key, and
- Fdefine_key should cause keymaps to be autoloaded. */
+ Fdefine_key should cause keymaps to be autoloaded.
+
+ This function can GC when AUTOLOAD is non-zero, because it calls
+ do_autoload which can GC. */
Lisp_Object
get_keymap_1 (object, error, autoload)
end:
if (error)
wrong_type_argument (Qkeymapp, object);
- else
- return Qnil;
+ return Qnil;
}
for (; CONSP (list); list = XCDR (list))
{
/* See if there is another `keymap'. */
- if (EQ (Qkeymap, XCAR (list)))
+ if (KEYMAPP (list))
return list;
}
return Qnil;
}
+
/* Set the parent keymap of MAP to PARENT. */
DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
Lisp_Object keymap, parent;
{
Lisp_Object list, prev;
+ struct gcpro gcpro1;
int i;
keymap = get_keymap_1 (keymap, 1, 1);
+ GCPRO1 (keymap);
+
if (!NILP (parent))
- parent = get_keymap_1 (parent, 1, 1);
+ {
+ Lisp_Object k;
+
+ parent = get_keymap_1 (parent, 1, 1);
+
+ /* Check for cycles. */
+ k = parent;
+ while (KEYMAPP (k) && !EQ (keymap, k))
+ k = Fkeymap_parent (k);
+ if (EQ (keymap, k))
+ error ("Cyclic keymap inheritance");
+ }
/* Skip past the initial element `keymap'. */
prev = keymap;
list = XCDR (prev);
/* If there is a parent keymap here, replace it.
If we came to the end, add the parent in PREV. */
- if (! CONSP (list) || EQ (Qkeymap, XCAR (list)))
+ if (! CONSP (list) || KEYMAPP (list))
{
/* If we already have the right parent, return now
so that we avoid the loops below. */
if (EQ (XCDR (prev), parent))
- return parent;
+ RETURN_UNGCPRO (parent);
XCDR (prev) = parent;
break;
}
}
- return parent;
+ RETURN_UNGCPRO (parent);
}
/* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
if EVENT is also a prefix in MAP's parent,
make sure that SUBMAP inherits that definition as its own parent. */
-void
+static void
fix_submap_inheritance (map, event, submap)
Lisp_Object map, event, submap;
{
/* If the contents are (KEYMAP . ELEMENT), go indirect. */
else
{
- register Lisp_Object map;
+ Lisp_Object map;
+
map = get_keymap_1 (Fcar_safe (object), 0, autoload);
if (NILP (map))
/* Invalid keymap */
}
}
-Lisp_Object
+static Lisp_Object
store_in_keymap (keymap, idx, def)
Lisp_Object keymap;
register Lisp_Object idx;
BLOCK_INPUT;
cmm_size = 30;
newmodes
- = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
+ = (Lisp_Object *) xmalloc (cmm_size * sizeof (Lisp_Object));
newmaps
- = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
+ = (Lisp_Object *) xmalloc (cmm_size * sizeof (Lisp_Object));
UNBLOCK_INPUT;
}
(keys)
Lisp_Object keys;
{
- int len;
+ int len = 0;
int i, i_byte;
Lisp_Object sep;
- Lisp_Object *args;
+ Lisp_Object *args = NULL;
if (STRINGP (keys))
{
for (i = 0; i < len; i++)
{
- args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i]);
+ args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i],
+ Qnil);
args[i * 2 + 1] = sep;
}
}
for (i = 0; i < len; i++)
{
- args[i * 2] = Fsingle_key_description (XCAR (keys));
+ args[i * 2] = Fsingle_key_description (XCAR (keys), Qnil);
args[i * 2 + 1] = sep;
keys = XCDR (keys);
}
register unsigned int c;
register char *p;
{
+ unsigned c2;
+
/* Clear all the meaningless bits above the meta bit. */
c &= meta_modifier | ~ - meta_modifier;
+ c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
+ | meta_modifier | shift_modifier | super_modifier);
if (c & alt_modifier)
{
*p++ = '-';
c -= alt_modifier;
}
- if (c & ctrl_modifier)
+ if ((c & ctrl_modifier) != 0
+ || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
{
*p++ = 'C';
*p++ = '-';
- c -= ctrl_modifier;
+ c &= ~ctrl_modifier;
}
if (c & hyper_modifier)
{
}
else
{
- *p++ = 'C';
- *p++ = '-';
+ /* `C-' already added above. */
if (c > 0 && c <= Ctl ('Z'))
*p++ = c + 0140;
else
/* This function cannot GC. */
-DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0,
+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.")
- (key)
- Lisp_Object key;
+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);
}
else if (SYMBOLP (key)) /* Function key or event-symbol */
{
- char *buffer = (char *) alloca (STRING_BYTES (XSYMBOL (key)->name) + 5);
- sprintf (buffer, "<%s>", XSYMBOL (key)->name->data);
- return build_string (buffer);
+ 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)) /* Buffer names in the menubar. */
return Fcopy_sequence (key);
else
error ("KEY must be an integer, cons, symbol, or string");
+ return Qnil;
}
char *
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 (XCDR (XCAR (args)));
.
((THIS . LAST) . (NOMENUS . LAST_IS_META)))
Since map_char_table doesn't really use the return value from this function,
- we the result append to RESULT, the slot in ARGS. */
+ we the result append to RESULT, the slot in ARGS.
+
+ This function can GC because it calls where_is_internal_1 which can
+ GC. */
static void
where_is_internal_2 (args, key, binding)
Lisp_Object definition, noindirect, keymap, this, last;
Lisp_Object result, sequence;
int nomenus, last_is_meta;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ GCPRO3 (args, key, binding);
result = XCDR (XCDR (XCAR (args)));
definition = XCAR (XCAR (XCAR (args)));
noindirect = XCDR (XCAR (XCAR (args)));
this, last, nomenus, last_is_meta);
if (!NILP (sequence))
- XCDR (XCDR (XCAR (args)))
- = Fcons (sequence, result);
+ XCDR (XCDR (XCAR (args))) = Fcons (sequence, result);
+
+ UNGCPRO;
}
+
+/* This function can GC.because Flookup_key calls get_keymap_1 with
+ non-zero argument AUTOLOAD. */
+
static Lisp_Object
where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last,
nomenus, last_is_meta)
{
Lisp_Object sequence;
int keymap_specified = !NILP (keymap);
+ struct gcpro gcpro1, gcpro2;
/* Search through indirections unless that's not wanted. */
if (NILP (noindirect))
Either nil or number as value from Flookup_key
means undefined. */
+ GCPRO2 (sequence, binding);
if (keymap_specified)
{
binding = Flookup_key (keymap, sequence, Qnil);
Lisp_Object tem;
tem = Fequal (binding, definition);
if (NILP (tem))
- return Qnil;
+ RETURN_UNGCPRO (Qnil);
}
else
if (!EQ (binding, definition))
- return Qnil;
+ RETURN_UNGCPRO (Qnil);
}
}
else
{
binding = Fkey_binding (sequence, Qnil);
if (!EQ (binding, definition))
- return Qnil;
+ RETURN_UNGCPRO (Qnil);
}
- return sequence;
+ RETURN_UNGCPRO (sequence);
}
\f
/* describe-bindings - summarizing all the bindings in a set of keymaps. */
int first = 1;
struct gcpro gcpro1, gcpro2, gcpro3;
+ suppress = Qnil;
+
if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
{
/* Call Fkey_description first, to avoid GC bug for the other string. */
insert1 (elt_prefix);
/* THIS gets the string to describe the character EVENT. */
- insert1 (Fsingle_key_description (event));
+ insert1 (Fsingle_key_description (event, Qnil));
/* Print a description of the definition of this character.
elt_describer will take care of spacing out far enough
int character;
int starting_i;
+ suppress = Qnil;
+
if (indices == 0)
indices = (int *) alloca (3 * sizeof (int));
else if (CHAR_TABLE_P (vector))
{
if (complete_char)
- insert1 (Fsingle_key_description (make_number (character)));
+ insert1 (Fsingle_key_description (make_number (character), Qnil));
else
{
/* Print the information for this character set. */
}
else
{
- insert1 (Fsingle_key_description (make_number (character)));
+ insert1 (Fsingle_key_description (make_number (character), Qnil));
}
/* If we find a sub char-table within a char-table,
{
if (char_table_depth == 0)
{
- insert1 (Fsingle_key_description (make_number (i)));
+ insert1 (Fsingle_key_description (make_number (i), Qnil));
}
else if (complete_char)
{
}
else
{
- insert1 (Fsingle_key_description (make_number (i)));
+ insert1 (Fsingle_key_description (make_number (i), Qnil));
}
}