#include "lisp.h"
#include "commands.h"
#include "buffer.h"
+#include "character.h"
#include "charset.h"
#include "keyboard.h"
#include "termhooks.h"
if (CHAR_TABLE_P (XCAR (list)))
{
- Lisp_Object indices[3];
-
- map_char_table (fix_submap_inheritance, Qnil,
- XCAR (list), XCAR (list),
- keymap, 0, indices);
+ map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap);
}
}
GCPRO4 (map, tail, idx, t_binding);
- /* If `t_ok' is 2, both `t' and generic-char bindings are accepted.
- If it is 1, only generic-char bindings are accepted.
- Otherwise, neither are. */
+ /* If `t_ok' is 2, both `t' is accepted. */
t_ok = t_ok ? 2 : 0;
for (tail = XCDR (map);
if (EQ (key, idx))
val = XCDR (binding);
- else if (t_ok
- && INTEGERP (idx)
- && (XINT (idx) & CHAR_MODIFIER_MASK) == 0
- && INTEGERP (key)
- && (XINT (key) & CHAR_MODIFIER_MASK) == 0
- && !SINGLE_BYTE_CHAR_P (XINT (idx))
- && !SINGLE_BYTE_CHAR_P (XINT (key))
- && CHAR_VALID_P (XINT (key), 1)
- && !CHAR_VALID_P (XINT (key), 0)
- && (CHAR_CHARSET (XINT (key))
- == CHAR_CHARSET (XINT (idx))))
- {
- /* KEY is the generic character of the charset of IDX.
- Use KEY's binding if there isn't a binding for IDX
- itself. */
- t_binding = XCDR (binding);
- t_ok = 0;
- }
else if (t_ok > 1 && EQ (key, Qt))
{
t_binding = XCDR (binding);
}
else if (CHAR_TABLE_P (binding))
{
- Lisp_Object indices[3];
- map_char_table (map_keymap_char_table_item, Qnil, binding, binding,
+ map_char_table (map_keymap_char_table_item, Qnil, binding,
Fcons (make_save_value (fun, 0),
Fcons (make_save_value (data, 0),
- args)),
- 0, indices);
+ args)));
}
}
UNGCPRO;
if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
error ("attempt to define a key in a non-keymap");
- /* If idx is a list (some sort of mouse click, perhaps?),
- the index we want to use is the car of the list, which
- ought to be a symbol. */
- idx = EVENT_HEAD (idx);
+ /* If idx is a cons, and the car part is a character, idx must be of
+ the form (FROM-CHAR . TO-CHAR). */
+ if (CONSP (idx) && CHARACTERP (XCAR (idx)))
+ CHECK_CHARACTER_CDR (idx);
+ else
+ /* If idx is a list (some sort of mouse click, perhaps?),
+ the index we want to use is the car of the list, which
+ ought to be a symbol. */
+ idx = EVENT_HEAD (idx);
/* If idx is a symbol, it might have modifiers, which need to
be put in the canonical order. */
ASET (elt, XFASTINT (idx), def);
return def;
}
+ else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
+ {
+ int from = XFASTINT (XCAR (idx));
+ int to = XFASTINT (XCDR (idx));
+
+ if (to >= ASIZE (elt))
+ to = ASIZE (elt) - 1;
+ for (; from <= to; from++)
+ ASET (elt, from, def);
+ if (to == XFASTINT (XCDR (idx)))
+ /* We have defined all keys in IDX. */
+ return def;
+ }
insertion_point = tail;
}
else if (CHAR_TABLE_P (elt))
NILP (def) ? Qt : def);
return def;
}
+ else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
+ {
+ Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
+ return def;
+ }
insertion_point = tail;
}
else if (CONSP (elt))
XSETCDR (elt, def);
return def;
}
+ else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
+ {
+ int from = XFASTINT (XCAR (idx));
+ int to = XFASTINT (XCDR (idx));
+
+ if (from <= XFASTINT (XCAR (elt))
+ && to >= XFASTINT (XCAR (elt)))
+ {
+ XSETCDR (elt, def);
+ if (from == to)
+ return def;
+ }
+ }
}
else if (EQ (elt, Qkeymap))
/* If we find a 'keymap' symbol in the spine of KEYMAP,
keymap_end:
/* We have scanned the entire keymap, and not found a binding for
IDX. Let's add one. */
- CHECK_IMPURE (insertion_point);
- XSETCDR (insertion_point,
- Fcons (Fcons (idx, def), XCDR (insertion_point)));
+ {
+ Lisp_Object elt;
+
+ if (CONSP (idx) && CHARACTERP (XCAR (idx)))
+ {
+ /* IDX specifies a range of characters, and not all of them
+ were handled yet, which means this keymap doesn't have a
+ char-table. So, we insert a char-table now. */
+ elt = Fmake_char_table (Qkeymap, Qnil);
+ Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
+ }
+ else
+ elt = Fcons (idx, def);
+ CHECK_IMPURE (insertion_point);
+ XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
+ }
}
return def;
copy_keymap_1 (chartable, idx, elt)
Lisp_Object chartable, idx, elt;
{
- Faset (chartable, idx, copy_keymap_item (elt));
+ Fset_char_table_range (chartable, idx, copy_keymap_item (elt));
}
DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
Lisp_Object elt = XCAR (keymap);
if (CHAR_TABLE_P (elt))
{
- Lisp_Object indices[3];
elt = Fcopy_sequence (elt);
- map_char_table (copy_keymap_1, Qnil, elt, elt, elt, 0, indices);
+ map_char_table (copy_keymap_1, Qnil, elt, elt);
}
else if (VECTORP (elt))
{
a cons (STRING . DEFN), meaning that DEFN is the definition
(DEFN should be a valid definition in its own right),
or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
- or an extended menu item definition. (See info node `Extended Menu Items'.)
+ or an extended menu item definition.
+ (See info node `(elisp)Extended Menu Items'.)
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
if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
- meta_bit = VECTORP (key) ? meta_modifier : 0x80;
+ meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key))
+ ? meta_modifier : 0x80);
if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
{ /* DEF is apparently an XEmacs-style keyboard macro. */
{
c = Faref (key, make_number (idx));
- if (CONSP (c) && lucid_event_type_list_p (c))
- c = Fevent_convert_list (c);
+ if (CONSP (c))
+ {
+ /* C may be a Lucid style event type list or a cons (FROM .
+ TO) specifying a range of characters. */
+ if (lucid_event_type_list_p (c))
+ c = Fevent_convert_list (c);
+ else if (CHARACTERP (XCAR (c)))
+ CHECK_CHARACTER_CDR (c);
+ }
if (SYMBOLP (c))
silly_event_symbol_error (c);
idx++;
}
- if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c))
+ if (!INTEGERP (c) && !SYMBOLP (c)
+ && (!CONSP (c)
+ /* If C is a range, it must be a leaf. */
+ || (INTEGERP (XCAR (c)) && idx != length)))
error ("Key sequence contains invalid event");
if (idx == length)
c = Fevent_convert_list (c);
/* Turn the 8th bit of string chars into a meta modifier. */
- if (INTEGERP (c) && XINT (c) & 0x80 && STRINGP (key))
+ if (STRINGP (key) && XINT (c) & 0x80 && !STRING_MULTIBYTE (key))
XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
/* Allow string since binding for `menu-bar-select-buffer'
}
DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
- 0, 1, 0,
+ 0, 2, 0,
doc: /* Return a list of the currently active keymaps.
OLP if non-nil indicates that we should obey `overriding-local-map' and
-`overriding-terminal-local-map'. */)
- (olp)
- Lisp_Object olp;
+`overriding-terminal-local-map'. POSITION can specify a click position
+like in the respective argument of `key-binding'. */)
+ (olp, position)
+ Lisp_Object olp, position;
{
- Lisp_Object keymaps = Fcons (current_global_map, Qnil);
+ int count = SPECPDL_INDEX ();
+
+ Lisp_Object keymaps;
+
+ /* If a mouse click position is given, our variables are based on
+ the buffer clicked on, not the current buffer. So we may have to
+ switch the buffer here. */
+
+ if (CONSP (position))
+ {
+ Lisp_Object window;
+
+ window = POSN_WINDOW (position);
+
+ if (WINDOWP (window)
+ && BUFFERP (XWINDOW (window)->buffer)
+ && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
+ {
+ /* Arrange to go back to the original buffer once we're done
+ processing the key sequence. We don't use
+ save_excursion_{save,restore} here, in analogy to
+ `read-key-sequence' to avoid saving point. Maybe this
+ would not be a problem here, but it is easier to keep
+ things the same.
+ */
+
+ record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+
+ set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
+ }
+ }
+
+ keymaps = Fcons (current_global_map, Qnil);
if (!NILP (olp))
{
}
if (NILP (XCDR (keymaps)))
{
- Lisp_Object local;
Lisp_Object *maps;
int nmaps, i;
- /* This usually returns the buffer's local map,
- but that can be overridden by a `local-map' property. */
- local = get_local_map (PT, current_buffer, Qlocal_map);
- if (!NILP (local))
- keymaps = Fcons (local, keymaps);
+ Lisp_Object keymap, local_map;
+ EMACS_INT pt;
+
+ pt = INTEGERP (position) ? XINT (position)
+ : MARKERP (position) ? marker_position (position)
+ : PT;
+
+ /* Get the buffer local maps, possibly overriden by text or
+ overlay properties */
+
+ local_map = get_local_map (pt, current_buffer, Qlocal_map);
+ keymap = get_local_map (pt, current_buffer, Qkeymap);
+
+ if (CONSP (position))
+ {
+ Lisp_Object string;
+
+ /* For a mouse click, get the local text-property keymap
+ of the place clicked on, rather than point. */
+
+ if (POSN_INBUFFER_P (position))
+ {
+ Lisp_Object pos;
+
+ pos = POSN_BUFFER_POSN (position);
+ if (INTEGERP (pos)
+ && XINT (pos) >= BEG && XINT (pos) <= Z)
+ {
+ local_map = get_local_map (XINT (pos),
+ current_buffer, Qlocal_map);
+
+ keymap = get_local_map (XINT (pos),
+ current_buffer, Qkeymap);
+ }
+ }
+
+ /* If on a mode line string with a local keymap,
+ or for a click on a string, i.e. overlay string or a
+ string displayed via the `display' property,
+ consider `local-map' and `keymap' properties of
+ that string. */
+
+ if (string = POSN_STRING (position),
+ (CONSP (string) && STRINGP (XCAR (string))))
+ {
+ Lisp_Object pos, map;
+
+ pos = XCDR (string);
+ string = XCAR (string);
+ if (INTEGERP (pos)
+ && XINT (pos) >= 0
+ && XINT (pos) < SCHARS (string))
+ {
+ map = Fget_text_property (pos, Qlocal_map, string);
+ if (!NILP (map))
+ local_map = map;
+
+ map = Fget_text_property (pos, Qkeymap, string);
+ if (!NILP (map))
+ keymap = map;
+ }
+ }
+
+ }
+
+ if (!NILP (local_map))
+ keymaps = Fcons (local_map, keymaps);
/* Now put all the minor mode keymaps on the list. */
nmaps = current_minor_maps (0, &maps);
if (!NILP (maps[i]))
keymaps = Fcons (maps[i], keymaps);
- /* This returns nil unless there is a `keymap' property. */
- local = get_local_map (PT, current_buffer, Qkeymap);
- if (!NILP (local))
- keymaps = Fcons (local, keymaps);
+ if (!NILP (keymap))
+ keymaps = Fcons (keymap, keymaps);
}
+ unbind_to (count, Qnil);
+
return keymaps;
}
\f
/* Help functions for describing and documenting keymaps. */
+struct accessible_keymaps_data {
+ Lisp_Object maps, tail, thisseq;
+ /* Does the current sequence end in the meta-prefix-char? */
+ int is_metized;
+};
static void
-accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized)
- Lisp_Object maps, tail, thisseq, key, cmd;
- int is_metized; /* If 1, `key' is assumed to be INTEGERP. */
+accessible_keymaps_1 (key, cmd, args, data)
+ Lisp_Object key, cmd, args;
+ /* Use void* to be compatible with map_keymap_function_t. */
+ void *data;
{
+ struct accessible_keymaps_data *d = data; /* Cast! */
+ Lisp_Object maps = d->maps;
+ Lisp_Object tail = d->tail;
+ Lisp_Object thisseq = d->thisseq;
+ int is_metized = d->is_metized && INTEGERP (key);
Lisp_Object tem;
cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
}
}
-static void
-accessible_keymaps_char_table (args, index, cmd)
- Lisp_Object args, index, cmd;
-{
- accessible_keymaps_1 (index, cmd,
- XCAR (XCAR (args)),
- XCAR (XCDR (args)),
- XCDR (XCDR (args)),
- XINT (XCDR (XCAR (args))));
-}
-
/* This function cannot GC. */
DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
Lisp_Object keymap, prefix;
{
Lisp_Object maps, tail;
- int prefixlen = 0;
+ int prefixlen = XINT (Flength (prefix));
/* no need for gcpro because we don't autoload any keymaps. */
- if (!NILP (prefix))
- prefixlen = XINT (Flength (prefix));
-
if (!NILP (prefix))
{
/* If a prefix was specified, start with the keymap (if any) for
if the prefix is not defined in this particular map.
It might even give us a list that isn't a keymap. */
tem = get_keymap (tem, 0, 0);
- if (CONSP (tem))
+ /* If the keymap is autoloaded `tem' is not a cons-cell, but we still
+ want to return it. */
+ if (!NILP (tem))
{
/* Convert PREFIX to a vector now, so that later on
we don't have to deal with the possibility of a string. */
for (tail = maps; CONSP (tail); tail = XCDR (tail))
{
- register Lisp_Object thisseq, thismap;
+ struct accessible_keymaps_data data;
+ register Lisp_Object thismap = Fcdr (XCAR (tail));
Lisp_Object last;
- /* Does the current sequence end in the meta-prefix-char? */
- int is_metized;
- thisseq = Fcar (Fcar (tail));
- thismap = Fcdr (Fcar (tail));
- last = make_number (XINT (Flength (thisseq)) - 1);
- is_metized = (XINT (last) >= 0
+ data.thisseq = Fcar (XCAR (tail));
+ data.maps = maps;
+ data.tail = tail;
+ last = make_number (XINT (Flength (data.thisseq)) - 1);
+ /* Does the current sequence end in the meta-prefix-char? */
+ data.is_metized = (XINT (last) >= 0
/* Don't metize the last char of PREFIX. */
&& XINT (last) >= prefixlen
- && EQ (Faref (thisseq, last), meta_prefix_char));
-
- for (; CONSP (thismap); thismap = XCDR (thismap))
- {
- Lisp_Object elt;
-
- elt = XCAR (thismap);
-
- QUIT;
-
- if (CHAR_TABLE_P (elt))
- {
- Lisp_Object indices[3];
+ && EQ (Faref (data.thisseq, last), meta_prefix_char));
- map_char_table (accessible_keymaps_char_table, Qnil, elt,
- elt, Fcons (Fcons (maps, make_number (is_metized)),
- Fcons (tail, thisseq)),
- 0, indices);
- }
- else if (VECTORP (elt))
- {
- register int i;
-
- /* Vector keymap. Scan all the elements. */
- for (i = 0; i < ASIZE (elt); i++)
- accessible_keymaps_1 (make_number (i), AREF (elt, i),
- maps, tail, thisseq, is_metized);
-
- }
- else if (CONSP (elt))
- accessible_keymaps_1 (XCAR (elt), XCDR (elt),
- maps, tail, thisseq,
- is_metized && INTEGERP (XCAR (elt)));
-
- }
+ /* Since we can't run lisp code, we can't scan autoloaded maps. */
+ if (CONSP (thismap))
+ map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0);
}
-
return maps;
}
-\f
Lisp_Object Qsingle_key_description, Qkey_description;
/* This function cannot GC. */
len += 2;
}
else if (len == 0)
- return empty_string;
+ return empty_unibyte_string;
return Fconcat (len - 1, args);
}
int force_multibyte;
{
unsigned c2;
- int valid_p;
/* 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);
- valid_p = SINGLE_BYTE_CHAR_P (c2) || char_valid_p (c2, 0);
- if (! valid_p)
+ if (! CHARACTERP (make_number (c2)))
{
/* KEY_DESCRIPTION_SIZE is large enough for this. */
p += sprintf (p, "[%d]", c);
}
else
{
- if (force_multibyte)
- {
- if (SINGLE_BYTE_CHAR_P (c))
- c = unibyte_char_to_multibyte (c);
- p += CHAR_STRING (c, p);
- }
- else if (NILP (current_buffer->enable_multibyte_characters))
- {
- int bit_offset;
- *p++ = '\\';
- /* The biggest character code uses 19 bits. */
- for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
- {
- if (c >= (1 << bit_offset))
- *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
- }
- }
+ /* Now we are sure that C is a valid character code. */
+ if (NILP (current_buffer->enable_multibyte_characters)
+ && ! force_multibyte)
+ *p++ = multibyte_char_to_unibyte (c, Qnil);
else
- p += CHAR_STRING (c, p);
+ p += CHAR_STRING (c, (unsigned char *) p);
}
return p;
if (INTEGERP (key)) /* Normal character */
{
- unsigned int charset, c1, c2;
- int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
-
- if (SINGLE_BYTE_CHAR_P (without_bits))
- charset = 0;
- else
- SPLIT_CHAR (without_bits, charset, c1, c2);
-
- if (! CHAR_VALID_P (without_bits, 1))
- {
- char buf[256];
-
- sprintf (buf, "Invalid char code %d", XINT (key));
- return build_string (buf);
- }
- else if (charset
- && ((c1 == 0 && c2 == -1) || c2 == 0))
- {
- /* Handle a generic character. */
- Lisp_Object name;
- char buf[256];
-
- name = CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX);
- CHECK_STRING (name);
- if (c1 == 0)
- /* Only a charset is specified. */
- sprintf (buf, "Generic char %d: all of ", without_bits);
- else
- /* 1st code-point of 2-dimensional charset is specified. */
- sprintf (buf, "Generic char %d: row %d of ", without_bits, c1);
- return concat2 (build_string (buf), name);
- }
- else
- {
- char tem[KEY_DESCRIPTION_SIZE], *end;
- int nbytes, nchars;
- Lisp_Object string;
+ char tem[KEY_DESCRIPTION_SIZE];
- end = push_key_description (XUINT (key), tem, 1);
- nbytes = end - tem;
- nchars = multibyte_chars_in_text (tem, nbytes);
- if (nchars == nbytes)
- {
- *end = '\0';
- string = build_string (tem);
- }
- else
- string = make_multibyte_string (tem, nchars, nbytes);
- return string;
- }
+ *push_key_description (XUINT (key), tem, 1) = 0;
+ return build_string (tem);
}
else if (SYMBOLP (key)) /* Function key or event-symbol */
{
CHECK_NUMBER (character);
c = XINT (character);
- if (!SINGLE_BYTE_CHAR_P (c))
+ if (!ASCII_CHAR_P (c))
{
int len = CHAR_STRING (c, str);
/* where-is - finding a command in a set of keymaps. */
static Lisp_Object where_is_internal ();
-static Lisp_Object where_is_internal_1 ();
-static void where_is_internal_2 ();
+static void where_is_internal_1 P_ ((Lisp_Object key, Lisp_Object binding,
+ Lisp_Object args, void *data));
/* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
Returns the first non-nil binding found in any of those maps. */
static Lisp_Object Vmouse_events;
+struct where_is_internal_data {
+ Lisp_Object definition, noindirect, this, last;
+ int last_is_meta;
+ Lisp_Object sequences;
+};
+
/* This function can GC if Flookup_key autoloads any keymaps. */
static Lisp_Object
{
/* Key sequence to reach map, and the map that it reaches */
register Lisp_Object this, map, tem;
+ struct where_is_internal_data data;
/* In order to fold [META-PREFIX-CHAR CHAR] sequences into
[M-CHAR] sequences, check if last character of the sequence
QUIT;
- while (CONSP (map))
- {
- /* Because the code we want to run on each binding is rather
- large, we don't want to have two separate loop bodies for
- sparse keymap bindings and tables; we want to iterate one
- loop body over both keymap and vector bindings.
-
- For this reason, if Fcar (map) is a vector, we don't
- advance map to the next element until i indicates that we
- have finished off the vector. */
- Lisp_Object elt, key, binding;
- elt = XCAR (map);
- map = XCDR (map);
-
- sequences = Qnil;
-
- QUIT;
-
- /* Set key and binding to the current key and binding, and
- advance map and i to the next binding. */
- if (VECTORP (elt))
+ data.definition = definition;
+ data.noindirect = noindirect;
+ data.this = this;
+ data.last = last;
+ data.last_is_meta = last_is_meta;
+ data.sequences = Qnil;
+
+ if (CONSP (map))
+ map_keymap (map, where_is_internal_1, Qnil, &data, 0);
+
+ sequences = data.sequences;
+
+ while (CONSP (sequences))
+ {
+ Lisp_Object sequence, remapped, function;
+
+ sequence = XCAR (sequences);
+ sequences = XCDR (sequences);
+
+ /* If the current sequence is a command remapping with
+ format [remap COMMAND], find the key sequences
+ which run COMMAND, and use those sequences instead. */
+ remapped = Qnil;
+ if (NILP (no_remap)
+ && VECTORP (sequence) && XVECTOR (sequence)->size == 2
+ && EQ (AREF (sequence, 0), Qremap)
+ && (function = AREF (sequence, 1), SYMBOLP (function)))
{
- Lisp_Object sequence;
- int i;
- /* In a vector, look at each element. */
- for (i = 0; i < XVECTOR (elt)->size; i++)
+ Lisp_Object remapped1;
+
+ remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
+ if (CONSP (remapped1))
{
- binding = AREF (elt, i);
- XSETFASTINT (key, i);
- sequence = where_is_internal_1 (binding, key, definition,
- noindirect, this,
- last, nomenus, last_is_meta);
- if (!NILP (sequence))
- sequences = Fcons (sequence, sequences);
+ /* Verify that this key binding actually maps to the
+ remapped command (see below). */
+ if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
+ continue;
+ sequence = XCAR (remapped1);
+ remapped = XCDR (remapped1);
+ goto record_sequence;
}
}
- else if (CHAR_TABLE_P (elt))
- {
- Lisp_Object indices[3];
- Lisp_Object args;
-
- args = Fcons (Fcons (Fcons (definition, noindirect),
- Qnil), /* Result accumulator. */
- Fcons (Fcons (this, last),
- Fcons (make_number (nomenus),
- make_number (last_is_meta))));
- map_char_table (where_is_internal_2, Qnil, elt, elt, args,
- 0, indices);
- sequences = XCDR (XCAR (args));
- }
- else if (CONSP (elt))
- {
- Lisp_Object sequence;
- key = XCAR (elt);
- binding = XCDR (elt);
+ /* Verify that this key binding is not shadowed by another
+ binding for the same key, before we say it exists.
- sequence = where_is_internal_1 (binding, key, definition,
- noindirect, this,
- last, nomenus, last_is_meta);
- if (!NILP (sequence))
- sequences = Fcons (sequence, sequences);
- }
+ Mechanism: look for local definition of this key and if
+ it is defined and does not match what we found then
+ ignore this key.
+ Either nil or number as value from Flookup_key
+ means undefined. */
+ if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
+ continue;
- while (!NILP (sequences))
+ record_sequence:
+ /* Don't annoy user with strings from a menu such as
+ Select Paste. Change them all to "(any string)",
+ so that there seems to be only one menu item
+ to report. */
+ if (! NILP (sequence))
{
- Lisp_Object sequence, remapped, function;
-
- sequence = XCAR (sequences);
- sequences = XCDR (sequences);
-
- /* If the current sequence is a command remapping with
- format [remap COMMAND], find the key sequences
- which run COMMAND, and use those sequences instead. */
- remapped = Qnil;
- if (NILP (no_remap)
- && VECTORP (sequence) && XVECTOR (sequence)->size == 2
- && EQ (AREF (sequence, 0), Qremap)
- && (function = AREF (sequence, 1), SYMBOLP (function)))
- {
- Lisp_Object remapped1;
-
- remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
- if (CONSP (remapped1))
- {
- /* Verify that this key binding actually maps to the
- remapped command (see below). */
- if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
- continue;
- sequence = XCAR (remapped1);
- remapped = XCDR (remapped1);
- goto record_sequence;
- }
- }
-
- /* Verify that this key binding is not shadowed by another
- binding for the same key, before we say it exists.
-
- Mechanism: look for local definition of this key and if
- it is defined and does not match what we found then
- ignore this key.
-
- Either nil or number as value from Flookup_key
- means undefined. */
- if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
- continue;
-
- record_sequence:
- /* Don't annoy user with strings from a menu such as
- Select Paste. Change them all to "(any string)",
- so that there seems to be only one menu item
- to report. */
- if (! NILP (sequence))
- {
- Lisp_Object tem;
- tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
- if (STRINGP (tem))
- Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
- build_string ("(any string)"));
- }
+ Lisp_Object tem;
+ tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
+ if (STRINGP (tem))
+ Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
+ build_string ("(any string)"));
+ }
- /* It is a true unshadowed match. Record it, unless it's already
- been seen (as could happen when inheriting keymaps). */
- if (NILP (Fmember (sequence, found)))
- found = Fcons (sequence, found);
-
- /* If firstonly is Qnon_ascii, then we can return the first
- binding we find. If firstonly is not Qnon_ascii but not
- nil, then we should return the first ascii-only binding
- we find. */
- if (EQ (firstonly, Qnon_ascii))
- RETURN_UNGCPRO (sequence);
- else if (!NILP (firstonly) && ascii_sequence_p (sequence))
- RETURN_UNGCPRO (sequence);
-
- if (CONSP (remapped))
- {
- sequence = XCAR (remapped);
- remapped = XCDR (remapped);
- goto record_sequence;
- }
+ /* It is a true unshadowed match. Record it, unless it's already
+ been seen (as could happen when inheriting keymaps). */
+ if (NILP (Fmember (sequence, found)))
+ found = Fcons (sequence, found);
+
+ /* If firstonly is Qnon_ascii, then we can return the first
+ binding we find. If firstonly is not Qnon_ascii but not
+ nil, then we should return the first ascii-only binding
+ we find. */
+ if (EQ (firstonly, Qnon_ascii))
+ RETURN_UNGCPRO (sequence);
+ else if (!NILP (firstonly) && ascii_sequence_p (sequence))
+ RETURN_UNGCPRO (sequence);
+
+ if (CONSP (remapped))
+ {
+ sequence = XCAR (remapped);
+ remapped = XCDR (remapped);
+ goto record_sequence;
}
}
}
else if (!NILP (keymap))
keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
else
- keymaps = Fcurrent_active_maps (Qnil);
+ keymaps = Fcurrent_active_maps (Qnil, Qnil);
/* Only use caching for the menubar (i.e. called with (def nil t nil).
We don't really need to check `keymap'. */
return result;
}
-/* This is the function that Fwhere_is_internal calls using map_char_table.
- ARGS has the form
- (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
- .
- ((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.
-
- 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 args, key, binding;
-{
- Lisp_Object definition, noindirect, this, last;
- Lisp_Object result, sequence;
- int nomenus, last_is_meta;
- struct gcpro gcpro1, gcpro2, gcpro3;
-
- GCPRO3 (args, key, binding);
- result = XCDR (XCAR (args));
- definition = XCAR (XCAR (XCAR (args)));
- noindirect = XCDR (XCAR (XCAR (args)));
- this = XCAR (XCAR (XCDR (args)));
- last = XCDR (XCAR (XCDR (args)));
- nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
- last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));
-
- sequence = where_is_internal_1 (binding, key, definition, noindirect,
- this, last, nomenus, last_is_meta);
-
- if (!NILP (sequence))
- XSETCDR (XCAR (args), Fcons (sequence, result));
-
- UNGCPRO;
-}
-
-
/* This function can GC because get_keyelt can. */
-static Lisp_Object
-where_is_internal_1 (binding, key, definition, noindirect, this, last,
- nomenus, last_is_meta)
- Lisp_Object binding, key, definition, noindirect, this, last;
- int nomenus, last_is_meta;
+static void
+where_is_internal_1 (key, binding, args, data)
+ Lisp_Object key, binding, args;
+ void *data;
{
+ struct where_is_internal_data *d = data; /* Cast! */
+ Lisp_Object definition = d->definition;
+ Lisp_Object noindirect = d->noindirect;
+ Lisp_Object this = d->this;
+ Lisp_Object last = d->last;
+ int last_is_meta = d->last_is_meta;
Lisp_Object sequence;
/* Search through indirections unless that's not wanted. */
|| EQ (binding, definition)
|| (CONSP (definition) && !NILP (Fequal (binding, definition)))))
/* Doesn't match. */
- return Qnil;
+ return;
/* We have found a match. Construct the key sequence where we found it. */
if (INTEGERP (key) && last_is_meta)
{
Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
- return Qnil;
}
else
- return sequence;
+ d->sequences = Fcons (sequence, d->sequences);
}
\f
/* describe-bindings - summarizing all the bindings in a set of keymaps. */
If the definition in effect in the whole map does not match
the one in this vector, we ignore this one.
- When describing a sub-char-table, INDICES is a list of
- indices at higher levels in this char-table,
- and CHAR_TABLE_DEPTH says how many levels down we have gone.
+ ARGS is simply passed as the second argument to ELT_DESCRIBER.
+
+ INDICES and CHAR_TABLE_DEPTH are ignored. They will be removed in
+ the near future.
KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
Lisp_Object definition;
Lisp_Object tem2;
Lisp_Object elt_prefix = Qnil;
- register int i;
+ int i;
Lisp_Object suppress;
Lisp_Object kludge;
int first = 1;
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
- generic character (i.e. a complete multibyte character). */
- int complete_char;
- int character;
+ Lisp_Object character;
int starting_i;
suppress = Qnil;
- if (indices == 0)
- indices = (int *) alloca (3 * sizeof (int));
-
definition = Qnil;
if (!keymap_p)
if (partial)
suppress = intern ("suppress-keymap");
- if (CHAR_TABLE_P (vector))
- {
- if (char_table_depth == 0)
- {
- /* VECTOR is a top level char-table. */
- complete_char = 1;
- from = 0;
- to = CHAR_TABLE_ORDINARY_SLOTS;
- }
- else
- {
- /* VECTOR is a sub char-table. */
- if (char_table_depth >= 3)
- /* A char-table is never that deep. */
- error ("Too deep char table");
-
- complete_char
- = (CHARSET_VALID_P (indices[0])
- && ((CHARSET_DIMENSION (indices[0]) == 1
- && char_table_depth == 1)
- || char_table_depth == 2));
-
- /* Meaningful elements are from 32th to 127th. */
- from = 32;
- to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
- }
- }
- else
- {
- /* This does the right thing for ordinary vectors. */
-
- complete_char = 1;
- from = 0;
- to = XVECTOR (vector)->size;
- }
+ from = 0;
+ to = CHAR_TABLE_P (vector) ? MAX_CHAR + 1 : XVECTOR (vector)->size;
for (i = from; i < to; i++)
{
int this_shadowed = 0;
- QUIT;
+ int range_beg, range_end;
+ Lisp_Object val;
- if (CHAR_TABLE_P (vector))
- {
- if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
- complete_char = 0;
+ QUIT;
- if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
- && !CHARSET_DEFINED_P (i - 128))
- continue;
+ starting_i = i;
- definition
- = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
- }
+ if (CHAR_TABLE_P (vector))
+ val = char_table_ref_and_range (vector, i, &range_beg, &i);
else
- definition = get_keyelt (AREF (vector, i), 0);
+ val = AREF (vector, i);
+ definition = get_keyelt (val, 0);
if (NILP (definition)) continue;
if (!NILP (tem)) continue;
}
- /* Set CHARACTER to the character this entry describes, if any.
- Also update *INDICES. */
- if (CHAR_TABLE_P (vector))
- {
- indices[char_table_depth] = i;
-
- if (char_table_depth == 0)
- {
- character = i;
- indices[0] = i - 128;
- }
- else if (complete_char)
- {
- character = MAKE_CHAR (indices[0], indices[1], indices[2]);
- }
- else
- character = 0;
- }
- else
- character = i;
-
- ASET (kludge, 0, make_number (character));
+ character = make_number (starting_i);
+ ASET (kludge, 0, character);
/* If this binding is shadowed by some other map, ignore it. */
- if (!NILP (shadow) && complete_char)
+ if (!NILP (shadow))
{
Lisp_Object tem;
/* Ignore this definition if it is shadowed by an earlier
one in the same keymap. */
- if (!NILP (entire_map) && complete_char)
+ if (!NILP (entire_map))
{
Lisp_Object tem;
if (first)
{
- if (char_table_depth == 0)
- insert ("\n", 1);
+ insert ("\n", 1);
first = 0;
}
- /* For a sub char-table, show the depth by indentation.
- CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
- if (char_table_depth > 0)
- insert (" ", char_table_depth * 2); /* depth is 1 or 2. */
-
/* Output the prefix that applies to every entry in this map. */
if (!NILP (elt_prefix))
insert1 (elt_prefix);
- /* Insert or describe the character this slot is for,
- or a description of what it is for. */
- if (SUB_CHAR_TABLE_P (vector))
- {
- if (complete_char)
- insert_char (character);
- else
- {
- /* We need an octal representation for this block of
- characters. */
- char work[16];
- sprintf (work, "(row %d)", i);
- insert (work, strlen (work));
- }
- }
- else if (CHAR_TABLE_P (vector))
- {
- if (complete_char)
- 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, SCHARS (tem2),
- SBYTES (tem2), 0);
- else
- insert ("?", 1);
- insert (">", 1);
- }
- }
- else
- {
- insert1 (Fkey_description (kludge, prefix));
- }
-
- /* If we find a sub char-table within a char-table,
- scan it recursively; it defines the details for
- a character set or a portion of a character set. */
- if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
- {
- insert ("\n", 1);
- describe_vector (definition, prefix, args, elt_describer,
- partial, shadow, entire_map,
- indices, char_table_depth + 1, keymap_p,
- mention_shadow);
- continue;
- }
-
- starting_i = i;
+ insert1 (Fkey_description (kludge, prefix));
/* Find all consecutive characters or rows that have the same
definition. But, for elements of a top level char table, if
they are for charsets, we had better describe one by one even
if they have the same definition. */
if (CHAR_TABLE_P (vector))
- {
- int limit = to;
-
- if (char_table_depth == 0)
- limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
-
- while (i + 1 < limit
- && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
- !NILP (tem2))
- && !NILP (Fequal (tem2, definition)))
- i++;
- }
+ while (i + 1 < to
+ && (val = char_table_ref_and_range (vector, i + 1,
+ &range_beg, &range_end),
+ tem2 = get_keyelt (val, 0),
+ !NILP (tem2))
+ && !NILP (Fequal (tem2, definition)))
+ i = range_end;
else
while (i + 1 < to
&& (tem2 = get_keyelt (AREF (vector, i + 1), 0),
&& !NILP (Fequal (tem2, definition)))
i++;
-
/* If we have a range of more than one character,
print where the range reaches to. */
if (!NILP (elt_prefix))
insert1 (elt_prefix);
- if (CHAR_TABLE_P (vector))
- {
- if (char_table_depth == 0)
- {
- insert1 (Fkey_description (kludge, prefix));
- }
- else if (complete_char)
- {
- indices[char_table_depth] = i;
- character = MAKE_CHAR (indices[0], indices[1], indices[2]);
- insert_char (character);
- }
- else
- {
- /* We need an octal representation for this block of
- characters. */
- char work[16];
- sprintf (work, "(row %d)", i);
- insert (work, strlen (work));
- }
- }
- else
- {
- insert1 (Fkey_description (kludge, prefix));
- }
+ insert1 (Fkey_description (kludge, prefix));
}
/* Print a description of the definition of this character.
}
}
- /* For (sub) char-table, print `defalt' slot at last. */
- if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
+ if (CHAR_TABLE_P (vector) && ! NILP (XCHAR_TABLE (vector)->defalt))
{
- insert (" ", char_table_depth * 2);
- insert_string ("<<default>>");
+ if (!NILP (elt_prefix))
+ insert1 (elt_prefix);
+ insert ("default", 7);
(*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
}
HCoop / bpt / emacs.git / blobdiff