Skip to content

GitLab

Commit f8d8ba40 authored by Kim F. Storm's avatar Kim F. Storm
Browse files

(Fkey_description): Add optional PREFIX arg. 

Combine prefix with KEYS to make up the full key sequence to describe.
Correlate meta_prefix_char and following (simple) key to describe
as meta modifier.  All callers changed.
(describe_map): Rename arg `keys' to `prefix'.  Remove local
`elt_prefix' var.  Use Fkey_description with prefix instead of
elt_prefix combined with Fsingle_key_description.
(describe_vector): Declare static.  Replace arg `elt_prefix' with
`prefix'.  Add KEYMAP_P arg.  Add local var `elt_prefix'; use it
if !KEYMAP_P. Use Fkey_description with prefix instead of
Fsingle_key_description.
parent 60962ec4
Hide whitespace changes
Inline Side-by-side
Showing with 133 additions and 94 deletions
src/keymap.c
View file @ f8d8ba40
......@@ -121,6 +121,9 @@ static void describe_translation P_ ((Lisp_Object, Lisp_Object));
static void describe_map P_ ((Lisp_Object, Lisp_Object,
void (*) P_ ((Lisp_Object, Lisp_Object)),
int, Lisp_Object, Lisp_Object*, int));
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));
/* Keymap object support - constructors and predicates. */
......@@ -687,7 +690,7 @@ map_keymap (map, fun, args, data, autoload)
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))
......@@ -1160,7 +1163,7 @@ binding KEY to DEF is added at the front of KEYMAP. */)
/* 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",
SDATA (Fkey_description (key)));
SDATA (Fkey_description (key, Qnil)));
}
}
......@@ -1791,9 +1794,9 @@ accessible_keymaps_1 (key, cmd, maps, tail, thisseq, 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. */
......@@ -1944,78 +1947,109 @@ 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));
/* In effect, this computes
(mapconcat 'single-key-description keys " ")
but we shouldn't use mapconcat because it can do GC. */
if (STRINGP (keys))
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 < SCHARS (keys); )
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))
{
args[i * 2] = Fsingle_key_description (AREF (keys, i), Qnil);
args[i * 2 + 1] = sep;
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))
{
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;
......@@ -2937,7 +2971,7 @@ key binding\n\
if (!NILP (prefix))
{
insert_string (" Starting With ");
insert1 (Fkey_description (prefix));
insert1 (Fkey_description (prefix, Qnil));
}
insert_string (":\n");
}
......@@ -3062,7 +3096,7 @@ describe_translation (definition, args)
}
else if (STRINGP (definition) || VECTORP (definition))
{
insert1 (Fkey_description (definition));
insert1 (Fkey_description (definition, Qnil));
insert_string ("\n");
}
else if (KEYMAPP (definition))
......@@ -3072,20 +3106,19 @@ describe_translation (definition, args)
}
/* 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;
......@@ -3095,15 +3128,6 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
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");
......@@ -3113,7 +3137,7 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
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))
{
......@@ -3122,13 +3146,13 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
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;
......@@ -3167,11 +3191,8 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
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
......@@ -3184,9 +3205,9 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
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);
}
}
......@@ -3214,7 +3235,7 @@ This is text showing the elements of vector matched against indices. */)
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);
}
......@@ -3249,28 +3270,32 @@ This is text showing the elements of vector matched against indices. */)
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
......@@ -3286,11 +3311,23 @@ describe_vector (vector, elt_prefix, args, elt_describer,
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");
......@@ -3383,12 +3420,13 @@ describe_vector (vector, elt_prefix, args, elt_describer,
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;
......@@ -3400,7 +3438,6 @@ describe_vector (vector, elt_prefix, args, elt_describer,
{
Lisp_Object tem;
ASET (kludge, 0, make_number (character));
tem = Flookup_key (entire_map, kludge, Qt);
if (!EQ (tem, definition))
......@@ -3441,7 +3478,7 @@ describe_vector (vector, elt_prefix, args, elt_describer,
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. */
......@@ -3457,7 +3494,7 @@ describe_vector (vector, elt_prefix, args, elt_describer,
}
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,
......@@ -3466,9 +3503,9 @@ describe_vector (vector, elt_prefix, args, elt_describer,
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;
}
......@@ -3506,6 +3543,8 @@ describe_vector (vector, elt_prefix, args, elt_describer,
{
insert (" .. ", 4);
ASET (kludge, 0, make_number (i));
if (!NILP (elt_prefix))
insert1 (elt_prefix);
......@@ -3513,7 +3552,7 @@ describe_vector (vector, elt_prefix, args, elt_describer,
{
if (char_table_depth == 0)
{
insert1 (Fsingle_key_description (make_number (i), Qnil));
insert1 (Fkey_description (kludge, prefix));
}
else if (complete_char)
{
......@@ -3532,7 +3571,7 @@ describe_vector (vector, elt_prefix, args, elt_describer,
}
else
{
insert1 (Fsingle_key_description (make_number (i), Qnil));
insert1 (Fkey_description (kludge, prefix));
}
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment