Remove C version of substitute-command-keys
* src/doc.c (Fsubstitute_command_keys_old): Remove. (syms_of_doc): Remove defsubr for Fsubstitute_command_keys_old. * src/keymap.c (describe_map, describe_map_tree) (describe_map_compare, describe_map_elt): Remove. * src/keymap.h: Remove 'describe_map_tree'. * test/lisp/help-tests.el (with-substitute-command-keys-test) (help-tests-substitute-command-keys/compare) (help-tests-substitute-command-keys/compare-all): Don't test the C version of 'substitute-command-keys' removed above.
This commit is contained in:
Stefan Kangas
parent
8a1441310a
commit
ef5a604f08
4 changed files with 3 additions and 673 deletions
303
src/doc.c
303
src/doc.c
|
|
@ -715,308 +715,6 @@ See variable `text-quoting-style'. */)
|
|||
}
|
||||
}
|
||||
|
||||
DEFUN ("substitute-command-keys-old", Fsubstitute_command_keys_old,
|
||||
Ssubstitute_command_keys_old, 1, 1, 0,
|
||||
doc: /* Substitute key descriptions for command names in STRING.
|
||||
Each substring of the form \\=\\[COMMAND] is replaced by either a
|
||||
keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
|
||||
is not on any keys.
|
||||
|
||||
Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
|
||||
the value of MAPVAR as a keymap. This summary is similar to the one
|
||||
produced by `describe-bindings'. The summary ends in two newlines
|
||||
\(used by the helper function `help-make-xrefs' to find the end of the
|
||||
summary).
|
||||
|
||||
Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
|
||||
as the keymap for future \\=\\[COMMAND] substrings.
|
||||
|
||||
Each grave accent \\=` is replaced by left quote, and each apostrophe \\='
|
||||
is replaced by right quote. Left and right quote characters are
|
||||
specified by `text-quoting-style'.
|
||||
|
||||
\\=\\= quotes the following character and is discarded; thus, \\=\\=\\=\\= puts \\=\\=
|
||||
into the output, \\=\\=\\=\\[ puts \\=\\[ into the output, and \\=\\=\\=` puts \\=` into the
|
||||
output.
|
||||
|
||||
Return the original STRING if no substitutions are made.
|
||||
Otherwise, return a new string (without any text properties). */)
|
||||
(Lisp_Object string)
|
||||
{
|
||||
char *buf;
|
||||
bool changed = false;
|
||||
bool nonquotes_changed = false;
|
||||
unsigned char *strp;
|
||||
char *bufp;
|
||||
ptrdiff_t idx;
|
||||
ptrdiff_t bsize;
|
||||
Lisp_Object tem;
|
||||
Lisp_Object keymap;
|
||||
unsigned char const *start;
|
||||
ptrdiff_t length, length_byte;
|
||||
Lisp_Object name;
|
||||
ptrdiff_t nchars;
|
||||
|
||||
if (NILP (string))
|
||||
return Qnil;
|
||||
|
||||
/* If STRING contains non-ASCII unibyte data, process its
|
||||
properly-encoded multibyte equivalent instead. This simplifies
|
||||
the implementation and is OK since substitute-command-keys is
|
||||
intended for use only on text strings. Keep STRING around, since
|
||||
it will be returned if no changes occur. */
|
||||
Lisp_Object str = Fstring_make_multibyte (string);
|
||||
|
||||
enum text_quoting_style quoting_style = text_quoting_style ();
|
||||
|
||||
nchars = 0;
|
||||
|
||||
/* KEYMAP is either nil (which means search all the active keymaps)
|
||||
or a specified local map (which means search just that and the
|
||||
global map). If non-nil, it might come from Voverriding_local_map,
|
||||
or from a \\<mapname> construct in STRING itself.. */
|
||||
keymap = Voverriding_local_map;
|
||||
|
||||
ptrdiff_t strbytes = SBYTES (str);
|
||||
bsize = strbytes;
|
||||
|
||||
/* Fixed-size stack buffer. */
|
||||
char sbuf[MAX_ALLOCA];
|
||||
|
||||
/* Heap-allocated buffer, if any. */
|
||||
char *abuf;
|
||||
|
||||
/* Extra room for expansion due to replacing ‘\[]’ with ‘M-x ’. */
|
||||
enum { EXTRA_ROOM = sizeof "M-x " - sizeof "\\[]" };
|
||||
|
||||
ptrdiff_t count = SPECPDL_INDEX ();
|
||||
|
||||
if (bsize <= sizeof sbuf - EXTRA_ROOM)
|
||||
{
|
||||
abuf = NULL;
|
||||
buf = sbuf;
|
||||
bsize = sizeof sbuf;
|
||||
}
|
||||
else
|
||||
{
|
||||
buf = abuf = xpalloc (NULL, &bsize, EXTRA_ROOM, STRING_BYTES_BOUND, 1);
|
||||
record_unwind_protect_ptr (xfree, abuf);
|
||||
}
|
||||
bufp = buf;
|
||||
|
||||
strp = SDATA (str);
|
||||
while (strp < SDATA (str) + strbytes)
|
||||
{
|
||||
unsigned char *close_bracket;
|
||||
|
||||
if (strp[0] == '\\' && strp[1] == '='
|
||||
&& strp + 2 < SDATA (str) + strbytes)
|
||||
{
|
||||
/* \= quotes the next character;
|
||||
thus, to put in \[ without its special meaning, use \=\[. */
|
||||
changed = nonquotes_changed = true;
|
||||
strp += 2;
|
||||
/* Fall through to copy one char. */
|
||||
}
|
||||
else if (strp[0] == '\\' && strp[1] == '['
|
||||
&& (close_bracket
|
||||
= memchr (strp + 2, ']',
|
||||
SDATA (str) + strbytes - (strp + 2))))
|
||||
{
|
||||
bool follow_remap = 1;
|
||||
|
||||
start = strp + 2;
|
||||
length_byte = close_bracket - start;
|
||||
idx = close_bracket + 1 - SDATA (str);
|
||||
|
||||
name = Fintern (make_string ((char *) start, length_byte), Qnil);
|
||||
|
||||
do_remap:
|
||||
tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
|
||||
|
||||
if (VECTORP (tem) && ASIZE (tem) > 1
|
||||
&& EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
|
||||
&& follow_remap)
|
||||
{
|
||||
name = AREF (tem, 1);
|
||||
follow_remap = 0;
|
||||
goto do_remap;
|
||||
}
|
||||
|
||||
/* Fwhere_is_internal can GC, so take relocation of string
|
||||
contents into account. */
|
||||
strp = SDATA (str) + idx;
|
||||
start = strp - length_byte - 1;
|
||||
|
||||
if (NILP (tem)) /* but not on any keys */
|
||||
{
|
||||
memcpy (bufp, "M-x ", 4);
|
||||
bufp += 4;
|
||||
nchars += 4;
|
||||
length = multibyte_chars_in_text (start, length_byte);
|
||||
goto subst;
|
||||
}
|
||||
else
|
||||
{ /* function is on a key */
|
||||
tem = Fkey_description (tem, Qnil);
|
||||
goto subst_string;
|
||||
}
|
||||
}
|
||||
/* \{foo} is replaced with a summary of the keymap (symbol-value foo).
|
||||
\<foo> just sets the keymap used for \[cmd]. */
|
||||
else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<')
|
||||
&& (close_bracket
|
||||
= memchr (strp + 2, strp[1] == '{' ? '}' : '>',
|
||||
SDATA (str) + strbytes - (strp + 2))))
|
||||
{
|
||||
{
|
||||
bool generate_summary = strp[1] == '{';
|
||||
/* This is for computing the SHADOWS arg for describe_map_tree. */
|
||||
Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
|
||||
ptrdiff_t count = SPECPDL_INDEX ();
|
||||
|
||||
start = strp + 2;
|
||||
length_byte = close_bracket - start;
|
||||
idx = close_bracket + 1 - SDATA (str);
|
||||
|
||||
/* Get the value of the keymap in TEM, or nil if undefined.
|
||||
Do this while still in the user's current buffer
|
||||
in case it is a local variable. */
|
||||
name = Fintern (make_string ((char *) start, length_byte), Qnil);
|
||||
tem = Fboundp (name);
|
||||
if (! NILP (tem))
|
||||
{
|
||||
tem = Fsymbol_value (name);
|
||||
if (! NILP (tem))
|
||||
tem = get_keymap (tem, 0, 1);
|
||||
}
|
||||
|
||||
/* Now switch to a temp buffer. */
|
||||
struct buffer *oldbuf = current_buffer;
|
||||
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
|
||||
/* This is for an unusual case where some after-change
|
||||
function uses 'format' or 'prin1' or something else that
|
||||
will thrash Vprin1_to_string_buffer we are using. */
|
||||
specbind (Qinhibit_modification_hooks, Qt);
|
||||
|
||||
if (NILP (tem))
|
||||
{
|
||||
name = Fsymbol_name (name);
|
||||
AUTO_STRING (msg_prefix, "\nUses keymap `");
|
||||
insert1 (Fsubstitute_command_keys_old (msg_prefix));
|
||||
insert_from_string (name, 0, 0,
|
||||
SCHARS (name),
|
||||
SBYTES (name), 1);
|
||||
AUTO_STRING (msg_suffix, "', which is not currently defined.\n");
|
||||
insert1 (Fsubstitute_command_keys_old (msg_suffix));
|
||||
if (!generate_summary)
|
||||
keymap = Qnil;
|
||||
}
|
||||
else if (!generate_summary)
|
||||
keymap = tem;
|
||||
else
|
||||
{
|
||||
/* Get the list of active keymaps that precede this one.
|
||||
If this one's not active, get nil. */
|
||||
Lisp_Object earlier_maps
|
||||
= Fcdr (Fmemq (tem, Freverse (active_maps)));
|
||||
describe_map_tree (tem, 1, Fnreverse (earlier_maps),
|
||||
Qnil, 0, 1, 0, 0, 1);
|
||||
}
|
||||
tem = Fbuffer_string ();
|
||||
Ferase_buffer ();
|
||||
set_buffer_internal (oldbuf);
|
||||
unbind_to (count, Qnil);
|
||||
}
|
||||
|
||||
subst_string:
|
||||
/* Convert non-ASCII unibyte data to properly-encoded multibyte,
|
||||
for the same reason STRING was converted to STR. */
|
||||
tem = Fstring_make_multibyte (tem);
|
||||
start = SDATA (tem);
|
||||
length = SCHARS (tem);
|
||||
length_byte = SBYTES (tem);
|
||||
subst:
|
||||
nonquotes_changed = true;
|
||||
subst_quote:
|
||||
changed = true;
|
||||
{
|
||||
ptrdiff_t offset = bufp - buf;
|
||||
ptrdiff_t avail = bsize - offset;
|
||||
ptrdiff_t need = strbytes - idx;
|
||||
if (INT_ADD_WRAPV (need, length_byte + EXTRA_ROOM, &need))
|
||||
string_overflow ();
|
||||
if (avail < need)
|
||||
{
|
||||
abuf = xpalloc (abuf, &bsize, need - avail,
|
||||
STRING_BYTES_BOUND, 1);
|
||||
if (buf == sbuf)
|
||||
{
|
||||
record_unwind_protect_ptr (xfree, abuf);
|
||||
memcpy (abuf, sbuf, offset);
|
||||
}
|
||||
else
|
||||
set_unwind_protect_ptr (count, xfree, abuf);
|
||||
buf = abuf;
|
||||
bufp = buf + offset;
|
||||
}
|
||||
memcpy (bufp, start, length_byte);
|
||||
bufp += length_byte;
|
||||
nchars += length;
|
||||
|
||||
/* Some of the previous code can GC, so take relocation of
|
||||
string contents into account. */
|
||||
strp = SDATA (str) + idx;
|
||||
|
||||
continue;
|
||||
}
|
||||
}
|
||||
else if ((strp[0] == '`' || strp[0] == '\'')
|
||||
&& quoting_style == CURVE_QUOTING_STYLE)
|
||||
{
|
||||
start = (unsigned char const *) (strp[0] == '`' ? uLSQM : uRSQM);
|
||||
length = 1;
|
||||
length_byte = sizeof uLSQM - 1;
|
||||
idx = strp - SDATA (str) + 1;
|
||||
goto subst_quote;
|
||||
}
|
||||
else if (strp[0] == '`' && quoting_style == STRAIGHT_QUOTING_STYLE)
|
||||
{
|
||||
*bufp++ = '\'';
|
||||
strp++;
|
||||
nchars++;
|
||||
changed = true;
|
||||
continue;
|
||||
}
|
||||
|
||||
/* Copy one char. */
|
||||
do
|
||||
*bufp++ = *strp++;
|
||||
while (! CHAR_HEAD_P (*strp));
|
||||
nchars++;
|
||||
}
|
||||
|
||||
if (changed) /* don't bother if nothing substituted */
|
||||
{
|
||||
tem = make_string_from_bytes (buf, nchars, bufp - buf);
|
||||
if (!nonquotes_changed)
|
||||
{
|
||||
/* Nothing has changed other than quoting, so copy the string’s
|
||||
text properties. FIXME: Text properties should survive other
|
||||
changes too; see bug#17052. */
|
||||
INTERVAL interval_copy = copy_intervals (string_intervals (string),
|
||||
0, SCHARS (string));
|
||||
if (interval_copy)
|
||||
{
|
||||
set_interval_object (interval_copy, tem);
|
||||
set_string_intervals (tem, interval_copy);
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
tem = string;
|
||||
return unbind_to (count, tem);
|
||||
}
|
||||
|
||||
void
|
||||
syms_of_doc (void)
|
||||
|
|
@ -1058,5 +756,4 @@ otherwise. */);
|
|||
defsubr (&Sdocumentation_property);
|
||||
defsubr (&Ssnarf_documentation);
|
||||
defsubr (&Sget_quoting_style);
|
||||
defsubr (&Ssubstitute_command_keys_old);
|
||||
}
|
||||
|
|
|
|||
334
src/keymap.c
334
src/keymap.c
|
|
@ -91,9 +91,6 @@ static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object);
|
|||
static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object);
|
||||
static void describe_command (Lisp_Object, Lisp_Object);
|
||||
static void describe_translation (Lisp_Object, Lisp_Object);
|
||||
static void describe_map (Lisp_Object, Lisp_Object,
|
||||
void (*) (Lisp_Object, Lisp_Object),
|
||||
bool, Lisp_Object, Lisp_Object *, bool, bool);
|
||||
static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object,
|
||||
void (*) (Lisp_Object, Lisp_Object), bool,
|
||||
Lisp_Object, Lisp_Object, bool, bool);
|
||||
|
|
@ -2946,119 +2943,6 @@ You type Translation\n\
|
|||
return Qnil;
|
||||
}
|
||||
|
||||
/* Insert a description of the key bindings in STARTMAP,
|
||||
followed by those of all maps reachable through STARTMAP.
|
||||
If PARTIAL, omit certain "uninteresting" commands
|
||||
(such as `undefined').
|
||||
If SHADOW is non-nil, it is a list of maps;
|
||||
don't mention keys which would be shadowed by any of them.
|
||||
PREFIX, if non-nil, says mention only keys that start with PREFIX.
|
||||
TITLE, if not 0, is a string to insert at the beginning.
|
||||
TITLE should not end with a colon or a newline; we supply that.
|
||||
If NOMENU, then omit menu-bar commands.
|
||||
|
||||
If TRANSL, the definitions are actually key translations
|
||||
so print strings and vectors differently.
|
||||
|
||||
If ALWAYS_TITLE, print the title even if there are no maps
|
||||
to look through.
|
||||
|
||||
If MENTION_SHADOW, then when something is shadowed by SHADOW,
|
||||
don't omit it; instead, mention it but say it is shadowed.
|
||||
|
||||
Any inserted text ends in two newlines (used by `help-make-xrefs'). */
|
||||
|
||||
void
|
||||
describe_map_tree (Lisp_Object startmap, bool partial, Lisp_Object shadow,
|
||||
Lisp_Object prefix, const char *title, bool nomenu,
|
||||
bool transl, bool always_title, bool mention_shadow)
|
||||
{
|
||||
Lisp_Object maps, orig_maps, seen, sub_shadows;
|
||||
bool something = 0;
|
||||
const char *key_heading
|
||||
= "\
|
||||
key binding\n\
|
||||
--- -------\n";
|
||||
|
||||
orig_maps = maps = Faccessible_keymaps (startmap, prefix);
|
||||
seen = Qnil;
|
||||
sub_shadows = Qnil;
|
||||
|
||||
if (nomenu)
|
||||
{
|
||||
Lisp_Object list;
|
||||
|
||||
/* Delete from MAPS each element that is for the menu bar. */
|
||||
for (list = maps; CONSP (list); list = XCDR (list))
|
||||
{
|
||||
Lisp_Object elt, elt_prefix, tem;
|
||||
|
||||
elt = XCAR (list);
|
||||
elt_prefix = Fcar (elt);
|
||||
if (ASIZE (elt_prefix) >= 1)
|
||||
{
|
||||
tem = Faref (elt_prefix, make_fixnum (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, Qnil));
|
||||
}
|
||||
insert_string (":\n");
|
||||
}
|
||||
insert_string (key_heading);
|
||||
something = 1;
|
||||
}
|
||||
|
||||
for (; CONSP (maps); maps = XCDR (maps))
|
||||
{
|
||||
register Lisp_Object elt, elt_prefix, tail;
|
||||
|
||||
elt = XCAR (maps);
|
||||
elt_prefix = Fcar (elt);
|
||||
|
||||
sub_shadows = Flookup_key (shadow, elt_prefix, Qt);
|
||||
if (FIXNATP (sub_shadows))
|
||||
sub_shadows = Qnil;
|
||||
else if (!KEYMAPP (sub_shadows)
|
||||
&& !NILP (sub_shadows)
|
||||
&& !(CONSP (sub_shadows)
|
||||
&& KEYMAPP (XCAR (sub_shadows))))
|
||||
/* If elt_prefix is bound to something that's not a keymap,
|
||||
it completely shadows this map, so don't
|
||||
describe this map at all. */
|
||||
goto skip;
|
||||
|
||||
/* Maps we have already listed in this loop shadow this map. */
|
||||
for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
|
||||
{
|
||||
Lisp_Object tem;
|
||||
tem = Fequal (Fcar (XCAR (tail)), elt_prefix);
|
||||
if (!NILP (tem))
|
||||
sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
|
||||
}
|
||||
|
||||
describe_map (Fcdr (elt), elt_prefix,
|
||||
transl ? describe_translation : describe_command,
|
||||
partial, sub_shadows, &seen, nomenu, mention_shadow);
|
||||
|
||||
skip: ;
|
||||
}
|
||||
|
||||
if (something)
|
||||
insert_string ("\n");
|
||||
}
|
||||
|
||||
static int previous_description_column;
|
||||
|
||||
static void
|
||||
|
|
@ -3121,224 +3005,6 @@ describe_translation (Lisp_Object definition, Lisp_Object args)
|
|||
insert_string ("??\n");
|
||||
}
|
||||
|
||||
/* describe_map puts all the usable elements of a sparse keymap
|
||||
into an array of `struct describe_map_elt',
|
||||
then sorts them by the events. */
|
||||
|
||||
struct describe_map_elt
|
||||
{
|
||||
Lisp_Object event;
|
||||
Lisp_Object definition;
|
||||
bool shadowed;
|
||||
};
|
||||
|
||||
/* qsort comparison function for sorting `struct describe_map_elt' by
|
||||
the event field. */
|
||||
|
||||
static int
|
||||
describe_map_compare (const void *aa, const void *bb)
|
||||
{
|
||||
const struct describe_map_elt *a = aa, *b = bb;
|
||||
if (FIXNUMP (a->event) && FIXNUMP (b->event))
|
||||
return ((XFIXNUM (a->event) > XFIXNUM (b->event))
|
||||
- (XFIXNUM (a->event) < XFIXNUM (b->event)));
|
||||
if (!FIXNUMP (a->event) && FIXNUMP (b->event))
|
||||
return 1;
|
||||
if (FIXNUMP (a->event) && !FIXNUMP (b->event))
|
||||
return -1;
|
||||
if (SYMBOLP (a->event) && SYMBOLP (b->event))
|
||||
/* Sort the keystroke names in the "natural" way, with (for
|
||||
instance) "<f2>" coming between "<f1>" and "<f11>". */
|
||||
return string_version_cmp (SYMBOL_NAME (a->event), SYMBOL_NAME (b->event));
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Describe the contents of map MAP, assuming that this map itself is
|
||||
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 (Lisp_Object map, Lisp_Object prefix,
|
||||
void (*elt_describer) (Lisp_Object, Lisp_Object),
|
||||
bool partial, Lisp_Object shadow,
|
||||
Lisp_Object *seen, bool nomenu, bool mention_shadow)
|
||||
{
|
||||
Lisp_Object tail, definition, event;
|
||||
Lisp_Object tem;
|
||||
Lisp_Object suppress;
|
||||
Lisp_Object kludge;
|
||||
bool first = 1;
|
||||
|
||||
/* These accumulate the values from sparse keymap bindings,
|
||||
so we can sort them and handle them in order. */
|
||||
ptrdiff_t length_needed = 0;
|
||||
struct describe_map_elt *vect;
|
||||
ptrdiff_t slots_used = 0;
|
||||
ptrdiff_t i;
|
||||
|
||||
suppress = Qnil;
|
||||
|
||||
if (partial)
|
||||
suppress = intern ("suppress-keymap");
|
||||
|
||||
/* This vector gets used to present single keys to Flookup_key. Since
|
||||
that is done once per keymap element, we don't want to cons up a
|
||||
fresh vector every time. */
|
||||
kludge = make_nil_vector (1);
|
||||
definition = Qnil;
|
||||
|
||||
map = call1 (Qkeymap_canonicalize, map);
|
||||
|
||||
for (tail = map; CONSP (tail); tail = XCDR (tail))
|
||||
length_needed++;
|
||||
|
||||
USE_SAFE_ALLOCA;
|
||||
SAFE_NALLOCA (vect, 1, length_needed);
|
||||
|
||||
for (tail = map; CONSP (tail); tail = XCDR (tail))
|
||||
{
|
||||
maybe_quit ();
|
||||
|
||||
if (VECTORP (XCAR (tail))
|
||||
|| CHAR_TABLE_P (XCAR (tail)))
|
||||
describe_vector (XCAR (tail),
|
||||
prefix, Qnil, elt_describer, partial, shadow, map,
|
||||
1, mention_shadow);
|
||||
else if (CONSP (XCAR (tail)))
|
||||
{
|
||||
bool this_shadowed = 0;
|
||||
|
||||
event = XCAR (XCAR (tail));
|
||||
|
||||
/* Ignore bindings whose "prefix" are not really valid events.
|
||||
(We get these in the frames and buffers menu.) */
|
||||
if (!(SYMBOLP (event) || FIXNUMP (event)))
|
||||
continue;
|
||||
|
||||
if (nomenu && EQ (event, Qmenu_bar))
|
||||
continue;
|
||||
|
||||
definition = get_keyelt (XCDR (XCAR (tail)), 0);
|
||||
|
||||
/* Don't show undefined commands or suppressed commands. */
|
||||
if (NILP (definition)) continue;
|
||||
if (SYMBOLP (definition) && partial)
|
||||
{
|
||||
tem = Fget (definition, suppress);
|
||||
if (!NILP (tem))
|
||||
continue;
|
||||
}
|
||||
|
||||
/* Don't show a command that isn't really visible
|
||||
because a local definition of the same key shadows it. */
|
||||
|
||||
ASET (kludge, 0, event);
|
||||
if (!NILP (shadow))
|
||||
{
|
||||
tem = shadow_lookup (shadow, kludge, Qt, 0);
|
||||
if (!NILP (tem))
|
||||
{
|
||||
/* If both bindings are keymaps, this key is a prefix key,
|
||||
so don't say it is shadowed. */
|
||||
if (KEYMAPP (definition) && KEYMAPP (tem))
|
||||
;
|
||||
/* Avoid generating duplicate entries if the
|
||||
shadowed binding has the same definition. */
|
||||
else if (mention_shadow && !EQ (tem, definition))
|
||||
this_shadowed = 1;
|
||||
else
|
||||
continue;
|
||||
}
|
||||
}
|
||||
|
||||
tem = Flookup_key (map, kludge, Qt);
|
||||
if (!EQ (tem, definition)) continue;
|
||||
|
||||
vect[slots_used].event = event;
|
||||
vect[slots_used].definition = definition;
|
||||
vect[slots_used].shadowed = this_shadowed;
|
||||
slots_used++;
|
||||
}
|
||||
else if (EQ (XCAR (tail), Qkeymap))
|
||||
{
|
||||
/* The same keymap might be in the structure twice, if we're
|
||||
using an inherited keymap. So skip anything we've already
|
||||
encountered. */
|
||||
tem = Fassq (tail, *seen);
|
||||
if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
|
||||
break;
|
||||
*seen = Fcons (Fcons (tail, prefix), *seen);
|
||||
}
|
||||
}
|
||||
|
||||
/* If we found some sparse map events, sort them. */
|
||||
|
||||
qsort (vect, slots_used, sizeof (struct describe_map_elt),
|
||||
describe_map_compare);
|
||||
|
||||
/* Now output them in sorted order. */
|
||||
|
||||
for (i = 0; i < slots_used; i++)
|
||||
{
|
||||
Lisp_Object start, end;
|
||||
|
||||
if (first)
|
||||
{
|
||||
previous_description_column = 0;
|
||||
insert ("\n", 1);
|
||||
first = 0;
|
||||
}
|
||||
|
||||
ASET (kludge, 0, vect[i].event);
|
||||
start = vect[i].event;
|
||||
end = start;
|
||||
|
||||
definition = vect[i].definition;
|
||||
|
||||
/* Find consecutive chars that are identically defined. */
|
||||
if (FIXNUMP (vect[i].event))
|
||||
{
|
||||
while (i + 1 < slots_used
|
||||
&& EQ (vect[i+1].event, make_fixnum (XFIXNUM (vect[i].event) + 1))
|
||||
&& !NILP (Fequal (vect[i + 1].definition, definition))
|
||||
&& vect[i].shadowed == vect[i + 1].shadowed)
|
||||
i++;
|
||||
end = vect[i].event;
|
||||
}
|
||||
|
||||
/* Now START .. END is the range to describe next. */
|
||||
|
||||
/* Insert the string to describe the event START. */
|
||||
insert1 (Fkey_description (kludge, prefix));
|
||||
|
||||
if (!EQ (start, end))
|
||||
{
|
||||
insert (" .. ", 4);
|
||||
|
||||
ASET (kludge, 0, end);
|
||||
/* Insert the string to describe the character END. */
|
||||
insert1 (Fkey_description (kludge, prefix));
|
||||
}
|
||||
|
||||
/* Print a description of the definition of this character.
|
||||
elt_describer will take care of spacing out far enough
|
||||
for alignment purposes. */
|
||||
(*elt_describer) (vect[i].definition, Qnil);
|
||||
|
||||
if (vect[i].shadowed)
|
||||
{
|
||||
ptrdiff_t pt = max (PT - 1, BEG);
|
||||
|
||||
SET_PT (pt);
|
||||
insert_string ("\n (this binding is currently shadowed)");
|
||||
pt = min (PT + 1, Z);
|
||||
SET_PT (pt);
|
||||
}
|
||||
}
|
||||
|
||||
SAFE_FREE ();
|
||||
}
|
||||
|
||||
static void
|
||||
describe_vector_princ (Lisp_Object elt, Lisp_Object fun)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -36,8 +36,6 @@ extern Lisp_Object current_global_map;
|
|||
extern char *push_key_description (EMACS_INT, char *);
|
||||
extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool);
|
||||
extern Lisp_Object get_keymap (Lisp_Object, bool, bool);
|
||||
extern void describe_map_tree (Lisp_Object, bool, Lisp_Object, Lisp_Object,
|
||||
const char *, bool, bool, bool, bool);
|
||||
extern ptrdiff_t current_minor_maps (Lisp_Object **, Lisp_Object **);
|
||||
extern void initial_define_key (Lisp_Object, int, const char *);
|
||||
extern void initial_define_lispy_key (Lisp_Object, const char *, const char *);
|
||||
|
|
|
|||
|
|
@ -58,23 +58,15 @@
|
|||
;;; substitute-command-keys
|
||||
|
||||
(defmacro with-substitute-command-keys-test (&rest body)
|
||||
`(cl-flet* ((should-be-same-as-c-version
|
||||
;; TODO: Remove this when old C function is removed.
|
||||
(lambda (orig)
|
||||
(should (equal-including-properties
|
||||
(substitute-command-keys orig)
|
||||
(substitute-command-keys-old orig)))))
|
||||
(test
|
||||
`(cl-flet* ((test
|
||||
(lambda (orig result)
|
||||
(should (equal-including-properties
|
||||
(substitute-command-keys orig)
|
||||
result))
|
||||
(should-be-same-as-c-version orig)))
|
||||
result))))
|
||||
(test-re
|
||||
(lambda (orig regexp)
|
||||
(should (string-match (concat "^" regexp "$")
|
||||
(substitute-command-keys orig)))
|
||||
(should-be-same-as-c-version orig))))
|
||||
(substitute-command-keys orig))))))
|
||||
,@body))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/no-change ()
|
||||
|
|
@ -369,29 +361,6 @@ C-b undefined
|
|||
|
||||
")))))
|
||||
|
||||
;; TODO: This is a temporary test that should be removed together with
|
||||
;; substitute-command-keys-old.
|
||||
(ert-deftest help-tests-substitute-command-keys/compare ()
|
||||
(with-substitute-command-keys-test
|
||||
(with-temp-buffer
|
||||
(Info-mode)
|
||||
(outline-minor-mode)
|
||||
(test-re "\\{Info-mode-map}" ".*")))
|
||||
(with-substitute-command-keys-test
|
||||
(with-temp-buffer
|
||||
(c-mode)
|
||||
(outline-minor-mode)
|
||||
(test-re "\\{c-mode-map}" ".*"))))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/compare-all ()
|
||||
(let (keymaps)
|
||||
(mapatoms (lambda (var)
|
||||
(when (keymapp var)
|
||||
(push var keymaps))))
|
||||
(dolist (keymap keymaps)
|
||||
(with-substitute-command-keys-test
|
||||
(test-re (concat "\\{" (symbol-name keymap) "}") ".*")))))
|
||||
|
||||
(provide 'help-tests)
|
||||
|
||||
;;; help-tests.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue