#include <config.h>
#include <stdio.h>
+#if HAVE_ALLOCA_H
+# include <alloca.h>
+#endif
#include "lisp.h"
#include "commands.h"
#include "buffer.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)
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);
store_in_keymap (keymap, idx, def)
Lisp_Object keymap;
register Lisp_Object idx;
- register Lisp_Object def;
+ Lisp_Object def;
{
/* Flush any reverse-map cache. */
where_is_cache = Qnil;
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)
{
if (!CONSP (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, Qnil)));
+ error ("Key sequence %s starts with non-prefix key %s",
+ SDATA (Fkey_description (key, Qnil)),
+ SDATA (Fkey_description (Fsubstring (key, make_number (0),
+ make_number (idx)),
+ Qnil)));
}
}
/* 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;
+
+ kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
+ if (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))
+ {
+ 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 (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 (local, key, accept_default);
+ 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;
}
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)
+ {
+ /* KEY_DESCRIPTION_SIZE is large enough for this. */
+ p += sprintf (p, "[%d]", c);
+ return p;
+ }
+
if (c & alt_modifier)
{
*p++ = 'A';
}
else
{
- int valid_p = SINGLE_BYTE_CHAR_P (c) || char_valid_p (c, 0);
-
- if (force_multibyte && valid_p)
+ 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)
- || valid_p)
+ else if (NILP (current_buffer->enable_multibyte_characters))
{
int bit_offset;
*p++ = '\\';
else
SPLIT_CHAR (without_bits, charset, c1, c2);
- if (charset
- && CHARSET_DEFINED_P (charset)
- && ((c1 >= 0 && c1 < 32)
- || (c2 >= 0 && c2 < 32)))
+ 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;
- name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX);
+ char buf[256];
+
+ name = CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX);
CHECK_STRING (name);
- return concat2 (build_string ("Character set "), 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
{
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;
}
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 (vect[i].shadowed)
{
SET_PT (PT - 1);
- insert_string (" (shadowed)");
+ insert_string ("\n (that binding is currently shadowed by another mode)");
SET_PT (PT + 1);
}
}
HCoop / bpt / emacs.git / blobdiff