#include <config.h>
#include <stdio.h>
+#if HAVE_ALLOCA_H
+# include <alloca.h>
+#endif
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
+#include "character.h"
#include "charset.h"
#include "keyboard.h"
#include "termhooks.h"
#include "puresize.h"
#include "intervals.h"
#include "keymap.h"
+#include "window.h"
/* The number of elements in keymap vectors. */
#define DENSE_TABLE_SIZE (0200)
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;
DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
doc: /* Call FUNCTION once for each event binding in KEYMAP.
FUNCTION is called with two arguments: the event that is bound, and
-the definition it is bound to.
+the definition it is bound to. If the event is an integer, it may be
+a generic character (see Info node `(elisp)Splitting Characters'), and
+that means that all actual character events belonging to that generic
+character are bound to the definition.
If KEYMAP has a parent, the parent's bindings are included as well.
This works recursively: if the parent has itself a parent, then the
if (INTEGERP (function))
/* We have to stop integers early since map_keymap gives them special
significance. */
- Fsignal (Qinvalid_function, Fcons (function, Qnil));
+ xsignal1 (Qinvalid_function, function);
if (! NILP (sort_first))
return call3 (intern ("map-keymap-internal"), function, keymap, Qt);
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))
{
GCPRO3 (keymap, key, def);
keymap = get_keymap (keymap, 1, 1);
- if (!VECTORP (key) && !STRINGP (key))
- key = wrong_type_argument (Qarrayp, key);
+ CHECK_VECTOR_OR_STRING (key);
length = XFASTINT (Flength (key));
if (length == 0)
meta_bit = VECTORP (key) ? meta_modifier : 0x80;
+ if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
+ { /* DEF is apparently an XEmacs-style keyboard macro. */
+ Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
+ int i = ASIZE (def);
+ while (--i >= 0)
+ {
+ Lisp_Object c = AREF (def, i);
+ if (CONSP (c) && lucid_event_type_list_p (c))
+ c = Fevent_convert_list (c);
+ ASET (tmp, i, c);
+ }
+ def = tmp;
+ }
+
idx = 0;
while (1)
{
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)
/* This function may GC (it calls Fkey_binding). */
-DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 1, 0,
+DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 2, 0,
doc: /* Return the remapping for command COMMAND in current keymaps.
-Returns nil if COMMAND is not remapped (or not a symbol). */)
- (command)
- Lisp_Object command;
+Returns nil if COMMAND is not remapped (or not a symbol).
+
+If the optional argument POSITION is non-nil, it specifies a mouse
+position as returned by `event-start' and `event-end', and the
+remapping occurs in the keymaps associated with it. It can also be a
+number or marker, in which case the keymap properties at the specified
+buffer position instead of point are used. */)
+ (command, position)
+ Lisp_Object command, position;
{
if (!SYMBOLP (command))
return Qnil;
ASET (command_remapping_vector, 1, command);
- return Fkey_binding (command_remapping_vector, Qnil, Qt);
+ return Fkey_binding (command_remapping_vector, Qnil, Qt, position);
}
/* Value is number if KEY is too long; nil if valid but has no definition. */
GCPRO2 (keymap, key);
keymap = get_keymap (keymap, 1, 1);
- if (!VECTORP (key) && !STRINGP (key))
- key = wrong_type_argument (Qarrayp, key);
+ CHECK_VECTOR_OR_STRING (key);
length = XFASTINT (Flength (key));
if (length == 0)
/* GC is possible in this function if it autoloads a keymap. */
-DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 3, 0,
+DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
doc: /* Return the binding for command KEY in current keymaps.
KEY is a string or vector, a sequence of keystrokes.
The binding is probably a symbol with a function definition.
Like the normal command loop, `key-binding' will remap the command
resulting from looking up KEY by looking up the command in the
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;
+is non-nil, `key-binding' returns the unmapped command.
+
+If KEY is a key sequence initiated with the mouse, the used keymaps
+will depend on the clicked mouse position with regard to the buffer
+and possible local keymaps on strings.
+
+If the optional argument POSITION is non-nil, it specifies a mouse
+position as returned by `event-start' and `event-end', and the lookup
+occurs in the keymaps associated with it instead of KEY. It can also
+be a number or marker, in which case the keymap properties at the
+specified buffer position instead of point are used.
+ */)
+ (key, accept_default, no_remap, position)
+ Lisp_Object key, accept_default, no_remap, position;
{
Lisp_Object *maps, value;
int nmaps, i;
- struct gcpro gcpro1;
+ struct gcpro gcpro1, gcpro2;
+ int count = SPECPDL_INDEX ();
- GCPRO1 (key);
+ GCPRO2 (key, position);
- if (!NILP (current_kboard->Voverriding_terminal_local_map))
+ if (NILP (position) && VECTORP (key))
+ {
+ Lisp_Object event
+ /* mouse events may have a symbolic prefix indicating the
+ scrollbar or mode line */
+ = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
+
+ /* We are not interested in locations without event data */
+
+ if (EVENT_HAS_PARAMETERS (event))
+ {
+ Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
+ if (CONSP (XCDR (event)) && EQ (kind, Qmouse_click))
+ position = EVENT_START (event);
+ }
+ }
+
+ /* Key sequences beginning with mouse clicks
+ are read using the keymaps of 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));
+ }
+ }
+
+ if (! NILP (current_kboard->Voverriding_terminal_local_map))
{
value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
key, accept_default);
if (! NILP (value) && !INTEGERP (value))
goto done;
}
- else if (!NILP (Voverriding_local_map))
+ else if (! NILP (Voverriding_local_map))
{
value = Flookup_key (Voverriding_local_map, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
}
else
{
- Lisp_Object local;
+ Lisp_Object keymap, local_map;
+ EMACS_INT pt;
- local = get_local_map (PT, current_buffer, Qkeymap);
- if (! NILP (local))
+ pt = INTEGERP (position) ? XINT (position)
+ : MARKERP (position) ? marker_position (position)
+ : PT;
+
+ local_map = get_local_map (pt, current_buffer, Qlocal_map);
+ keymap = get_local_map (pt, current_buffer, Qkeymap);
+
+ if (CONSP (position))
{
- value = Flookup_key (local, key, accept_default);
+ 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 (keymap))
+ {
+ value = Flookup_key (keymap, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
goto done;
}
goto done;
}
- local = get_local_map (PT, current_buffer, Qlocal_map);
- if (! NILP (local))
+ if (! NILP (local_map))
{
- value = Flookup_key (local, key, accept_default);
+ value = Flookup_key (local_map, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
goto done;
}
value = Flookup_key (current_global_map, key, accept_default);
done:
+ unbind_to (count, Qnil);
+
UNGCPRO;
if (NILP (value) || INTEGERP (value))
return Qnil;
if (NILP (no_remap) && SYMBOLP (value))
{
Lisp_Object value1;
- if (value1 = Fcommand_remapping (value), !NILP (value1))
+ if (value1 = Fcommand_remapping (value, position), !NILP (value1))
value = value1;
}
if (CHAR_TABLE_P (elt))
{
- Lisp_Object indices[3];
-
- map_char_table (accessible_keymaps_char_table, Qnil, elt,
+ map_char_table (accessible_keymaps_char_table, Qnil,
elt, Fcons (Fcons (maps, make_number (is_metized)),
- Fcons (tail, thisseq)),
- 0, indices);
+ Fcons (tail, thisseq)));
}
else if (VECTORP (elt))
{
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 (c) || char_valid_p (c, 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);
+ char tem[KEY_DESCRIPTION_SIZE];
- if (charset
- && CHARSET_DEFINED_P (charset)
- && ((c1 >= 0 && c1 < 32)
- || (c2 >= 0 && c2 < 32)))
- {
- /* Handle a generic character. */
- Lisp_Object name;
- name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX);
- CHECK_STRING (name);
- return concat2 (build_string ("Character set "), name);
- }
- else
- {
- char tem[KEY_DESCRIPTION_SIZE], *end;
- int nbytes, nchars;
- Lisp_Object string;
-
- 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);
if (NILP (no_remap) && SYMBOLP (definition))
{
Lisp_Object tem;
- if (tem = Fcommand_remapping (definition), !NILP (tem))
+ if (tem = Fcommand_remapping (definition, Qnil), !NILP (tem))
return Qnil;
}
}
else if (CHAR_TABLE_P (elt))
{
- Lisp_Object indices[3];
Lisp_Object args;
args = Fcons (Fcons (Fcons (definition, noindirect),
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);
+ map_char_table (where_is_internal_2, Qnil, elt, args);
sequences = XCDR (XCAR (args));
}
else if (CONSP (elt))
/* This is the function that Fwhere_is_internal calls using map_char_table.
ARGS has the form
- (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
+ (((DEFINITION . NOINDIRECT) . 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.
+ KEY may be a cons (FROM . TO) where both FROM and TO are integers
+ (i.e. character events).
+
This function can GC because it calls where_is_internal_1 which can
GC. */
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)));
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);
+ result = Qnil;
+ if (CONSP (key) && INTEGERP (XCAR (key)) && INTEGERP (XCDR (key)))
+ {
+ /* Try all ASCII characters. Try also non-ASCII characters but
+ only the first and last one because trying all of them is
+ extremely memory and time consuming.
+
+ Fixme: Perhaps it should be allowed to store a cons directly
+ in RESULT. -- handa@m17n.org */
+ int from = XINT (XCAR (key)), to = XINT (XCDR (key));
+ Lisp_Object k;
+
+ for (; from <= to; to--)
+ {
+ k = make_number (to);
+ sequence = where_is_internal_1 (binding, k, definition, noindirect,
+ this, last, nomenus, last_is_meta);
+ if (!NILP (sequence))
+ result = Fcons (sequence, result);
+ if (to > 129)
+ to = 129;
+ }
+ }
+ else
+ {
+ sequence = where_is_internal_1 (binding, key, definition, noindirect,
+ this, last, nomenus, last_is_meta);
+ if (!NILP (sequence))
+ result = Fcons (sequence, Qnil);
+ }
- if (!NILP (sequence))
- XSETCDR (XCAR (args), Fcons (sequence, result));
+ if (! NILP (result))
+ nconc2 (XCAR (args), result);
UNGCPRO;
}
tem = shadow_lookup (shadow, kludge, Qt);
if (!NILP (tem))
{
- if (mention_shadow)
+ /* Avoid generating duplicate entries if the
+ shadowed binding has the same definition. */
+ if (mention_shadow && !EQ (tem, definition))
this_shadowed = 1;
else
continue;
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);
}