/* Manipulation of keymaps
- Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 2001
+ Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 01, 2004
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
+#include "character.h"
#include "charset.h"
#include "keyboard.h"
#include "termhooks.h"
minibuf */
/* was MinibufLocalNSMap */
-Lisp_Object Vminibuffer_local_ns_map;
+Lisp_Object Vminibuffer_local_ns_map;
/* The keymap used by the minibuf for local
bindings when spaces are not encouraged
in the minibuf */
minor mode variables and keymaps. */
Lisp_Object Vminor_mode_overriding_map_alist;
+/* List of emulation mode keymap alists. */
+Lisp_Object Vemulation_mode_map_alists;
+
/* Keymap mapping ASCII function key sequences onto their preferred forms.
Initialized by the terminal-specific lisp files. See DEFVAR for more
documentation. */
when Emacs starts up. t means don't record anything here. */
Lisp_Object Vdefine_key_rebound_commands;
-Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item;
+Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item, Qremap;
+
+/* Alist of elements like (DEL . "\d"). */
+static Lisp_Object exclude_keys;
+
+/* Pre-allocated 2-element vector for Fcommand_remapping to use. */
+static Lisp_Object command_remapping_vector;
/* A char with the CHAR_META bit set in a vector or the 0200 bit set
in a string key sequence is equivalent to prefixing with this
static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object));
-static Lisp_Object describe_buffer_bindings P_ ((Lisp_Object));
-static void describe_command P_ ((Lisp_Object));
-static void describe_translation P_ ((Lisp_Object));
+static void describe_command P_ ((Lisp_Object, Lisp_Object));
+static void describe_translation P_ ((Lisp_Object, Lisp_Object));
static void describe_map P_ ((Lisp_Object, Lisp_Object,
- void (*) P_ ((Lisp_Object)),
+ void (*) P_ ((Lisp_Object, Lisp_Object)),
int, Lisp_Object, Lisp_Object*, int));
+static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
+ void (*) (Lisp_Object, Lisp_Object), int,
+ Lisp_Object, Lisp_Object, int *, int, int));
+static void silly_event_symbol_error P_ ((Lisp_Object));
\f
/* Keymap object support - constructors and predicates. */
DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
- "Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).\n\
-CHARTABLE is a char-table that holds the bindings for the ASCII\n\
-characters. ALIST is an assoc-list which holds bindings for function keys,\n\
-mouse events, and any other things that appear in the input stream.\n\
-All entries in it are initially nil, meaning \"command undefined\".\n\n\
-The optional arg STRING supplies a menu name for the keymap\n\
-in case you use it as a menu with `x-popup-menu'.")
- (string)
+ doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
+CHARTABLE is a char-table that holds the bindings for the ASCII
+characters. ALIST is an assoc-list which holds bindings for function keys,
+mouse events, and any other things that appear in the input stream.
+All entries in it are initially nil, meaning "command undefined".
+
+The optional arg STRING supplies a menu name for the keymap
+in case you use it as a menu with `x-popup-menu'. */)
+ (string)
Lisp_Object string;
{
Lisp_Object tail;
}
DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
- "Construct and return a new sparse keymap.\n\
-Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\
-which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\
-which binds the function key or mouse event SYMBOL to DEFINITION.\n\
-Initially the alist is nil.\n\n\
-The optional arg STRING supplies a menu name for the keymap\n\
-in case you use it as a menu with `x-popup-menu'.")
- (string)
+ doc: /* Construct and return a new sparse keymap.
+Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
+which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
+which binds the function key or mouse event SYMBOL to DEFINITION.
+Initially the alist is nil.
+
+The optional arg STRING supplies a menu name for the keymap
+in case you use it as a menu with `x-popup-menu'. */)
+ (string)
Lisp_Object string;
{
if (!NILP (string))
}
DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
- "Return t if OBJECT is a keymap.\n\
-\n\
-A keymap is a list (keymap . ALIST),\n\
-or a symbol whose function definition is itself a keymap.\n\
-ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\
-a vector of densely packed bindings for small character codes\n\
-is also allowed as an element.")
- (object)
+ doc: /* Return t if OBJECT is a keymap.
+
+A keymap is a list (keymap . ALIST),
+or a symbol whose function definition is itself a keymap.
+ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
+a vector of densely packed bindings for small character codes
+is also allowed as an element. */)
+ (object)
Lisp_Object object;
{
return (KEYMAPP (object) ? Qt : Qnil);
}
DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
- "Return the prompt-string of a keymap MAP.\n\
-If non-nil, the prompt is shown in the echo-area\n\
-when reading a key-sequence to be looked-up in this keymap.")
- (map)
+ doc: /* Return the prompt-string of a keymap MAP.
+If non-nil, the prompt is shown in the echo-area
+when reading a key-sequence to be looked-up in this keymap. */)
+ (map)
Lisp_Object map;
{
while (CONSP (map))
if (autoload)
{
struct gcpro gcpro1, gcpro2;
-
+
GCPRO2 (tem, object);
do_autoload (tem, object);
UNGCPRO;
-
+
goto autoload_retry;
}
else
return Qnil;
}
\f
-/* Return the parent map of the keymap MAP, or nil if it has none.
- We assume that MAP is a valid keymap. */
+/* Return the parent map of KEYMAP, or nil if it has none.
+ We assume that KEYMAP is a valid keymap. */
-DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
- "Return the parent keymap of KEYMAP.")
- (keymap)
+Lisp_Object
+keymap_parent (keymap, autoload)
Lisp_Object keymap;
+ int autoload;
{
Lisp_Object list;
- keymap = get_keymap (keymap, 1, 1);
+ keymap = get_keymap (keymap, 1, autoload);
/* Skip past the initial element `keymap'. */
list = XCDR (keymap);
return list;
}
- return get_keymap (list, 0, 1);
+ return get_keymap (list, 0, autoload);
}
+DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
+ doc: /* Return the parent keymap of KEYMAP. */)
+ (keymap)
+ Lisp_Object keymap;
+{
+ return keymap_parent (keymap, 1);
+}
/* Check whether MAP is one of MAPS parents. */
int
{
if (NILP (map)) return 0;
while (KEYMAPP (maps) && !EQ (map, maps))
- maps = Fkeymap_parent (maps);
+ maps = keymap_parent (maps, 0);
return (EQ (map, maps));
}
/* Set the parent keymap of MAP to PARENT. */
DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
- "Modify KEYMAP to set its parent map to PARENT.\n\
-PARENT should be nil or another keymap.")
- (keymap, parent)
+ doc: /* Modify KEYMAP to set its parent map to PARENT.
+PARENT should be nil or another keymap. */)
+ (keymap, parent)
Lisp_Object keymap, parent;
{
Lisp_Object list, prev;
- struct gcpro gcpro1;
+ struct gcpro gcpro1, gcpro2;
int i;
/* Force a keymap flush for the next call to where-is.
This is a very minor correctness (rather than safety) issue. */
where_is_cache_keymaps = Qt;
+ GCPRO2 (keymap, parent);
keymap = get_keymap (keymap, 1, 1);
- GCPRO1 (keymap);
-
+
if (!NILP (parent))
{
parent = get_keymap (parent, 1, 1);
if (EQ (XCDR (prev), parent))
RETURN_UNGCPRO (parent);
- XCDR (prev) = parent;
+ XSETCDR (prev, parent);
break;
}
prev = list;
if (CHAR_TABLE_P (XCAR (list)))
{
- Lisp_Object indices[3];
-
- map_char_table (fix_submap_inheritance, Qnil, XCAR (list),
- keymap, 0, indices);
+ map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap);
}
}
if (!CONSP (submap))
return;
- map_parent = Fkeymap_parent (map);
+ map_parent = keymap_parent (map, 0);
if (!NILP (map_parent))
parent_entry =
get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
{
Lisp_Object tem;
- tem = Fkeymap_parent (submap_parent);
+ tem = keymap_parent (submap_parent, 0);
if (KEYMAPP (tem))
{
\f
/* Look up IDX in MAP. IDX may be any sort of event.
Note that this does only one level of lookup; IDX must be a single
- event, not a sequence.
+ event, not a sequence.
If T_OK is non-zero, bindings for Qt are treated as default
bindings; any key left unmentioned by other tables and bindings is
- given the binding of Qt.
+ given the binding of Qt.
If T_OK is zero, bindings for Qt are not treated specially.
int noinherit;
int autoload;
{
- int noprefix = 0;
Lisp_Object val;
+ /* Qunbound in VAL means we have found no binding yet. */
+ val = Qunbound;
+
/* 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. */
{
/* See if there is a meta-map. If there's none, there is
no binding for IDX, unless a default binding exists in MAP. */
- Lisp_Object meta_map =
- get_keymap (access_keymap (map, meta_prefix_char,
- t_ok, noinherit, autoload),
- 0, autoload);
+ struct gcpro gcpro1;
+ Lisp_Object meta_map;
+ GCPRO1 (map);
+ meta_map = get_keymap (access_keymap (map, meta_prefix_char,
+ t_ok, noinherit, autoload),
+ 0, autoload);
+ UNGCPRO;
if (CONSP (meta_map))
{
map = meta_map;
return Qnil;
}
+ /* t_binding is where we put a default binding that applies,
+ to use in case we do not find a binding specifically
+ for this key sequence. */
{
Lisp_Object tail;
- Lisp_Object t_binding;
- Lisp_Object generic_binding;
+ Lisp_Object t_binding = Qnil;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+ GCPRO4 (map, tail, idx, t_binding);
+
+ /* If `t_ok' is 2, both `t' is accepted. */
+ t_ok = t_ok ? 2 : 0;
- t_binding = Qnil;
- generic_binding = Qnil;
-
for (tail = XCDR (map);
(CONSP (tail)
|| (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
/* If NOINHERIT, stop finding prefix definitions
after we pass a second occurrence of the `keymap' symbol. */
if (noinherit && EQ (binding, Qkeymap))
- noprefix = 1;
+ RETURN_UNGCPRO (Qnil);
}
else if (CONSP (binding))
{
Lisp_Object key = XCAR (binding);
- int c1, c2, charset;
-
+
if (EQ (key, idx))
+ val = XCDR (binding);
+ else if (t_ok > 1 && EQ (key, Qt))
{
- val = XCDR (binding);
- if (noprefix && KEYMAPP (val))
- return Qnil;
- if (CONSP (val))
- fix_submap_inheritance (map, idx, val);
- return get_keyelt (val, autoload);
- }
- else if (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. */
- generic_binding = XCDR (binding);
+ t_binding = XCDR (binding);
+ t_ok = 1;
}
- else if (t_ok && EQ (XCAR (binding), Qt))
- t_binding = XCDR (binding);
}
else if (VECTORP (binding))
{
- if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (binding)->size)
- {
- val = XVECTOR (binding)->contents[XFASTINT (idx)];
- if (noprefix && KEYMAPP (val))
- return Qnil;
- if (CONSP (val))
- fix_submap_inheritance (map, idx, val);
- return get_keyelt (val, autoload);
- }
+ if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding))
+ val = AREF (binding, XFASTINT (idx));
}
else if (CHAR_TABLE_P (binding))
{
/* Character codes with modifiers
are not included in a char-table.
All character codes without modifiers are included. */
- if (NATNUMP (idx)
- && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
+ if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
{
val = Faref (binding, idx);
- if (noprefix && KEYMAPP (val))
- return Qnil;
- if (CONSP (val))
- fix_submap_inheritance (map, idx, val);
- return get_keyelt (val, autoload);
+ /* `nil' has a special meaning for char-tables, so
+ we use something else to record an explicitly
+ unbound entry. */
+ if (NILP (val))
+ val = Qunbound;
}
}
+ /* If we found a binding, clean it up and return it. */
+ if (!EQ (val, Qunbound))
+ {
+ if (EQ (val, Qt))
+ /* A Qt binding is just like an explicit nil binding
+ (i.e. it shadows any parent binding but not bindings in
+ keymaps of lower precedence). */
+ val = Qnil;
+ val = get_keyelt (val, autoload);
+ if (KEYMAPP (val))
+ fix_submap_inheritance (map, idx, val);
+ RETURN_UNGCPRO (val);
+ }
QUIT;
}
-
- if (!NILP (generic_binding))
- return get_keyelt (generic_binding, autoload);
-
+ UNGCPRO;
return get_keyelt (t_binding, autoload);
}
}
+static void
+map_keymap_item (fun, args, key, val, data)
+ map_keymap_function_t fun;
+ Lisp_Object args, key, val;
+ void *data;
+{
+ /* We should maybe try to detect bindings shadowed by previous
+ ones and things like that. */
+ if (EQ (val, Qt))
+ val = Qnil;
+ (*fun) (key, val, args, data);
+}
+
+static void
+map_keymap_char_table_item (args, key, val)
+ Lisp_Object args, key, val;
+{
+ if (!NILP (val))
+ {
+ map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer;
+ args = XCDR (args);
+ map_keymap_item (fun, XCDR (args), key, val,
+ XSAVE_VALUE (XCAR (args))->pointer);
+ }
+}
+
+/* Call FUN for every binding in MAP.
+ FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
+ AUTOLOAD if non-zero means that we can autoload keymaps if necessary. */
+void
+map_keymap (map, fun, args, data, autoload)
+ map_keymap_function_t fun;
+ Lisp_Object map, args;
+ void *data;
+ int autoload;
+{
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object tail;
+
+ GCPRO3 (map, args, tail);
+ map = get_keymap (map, 1, autoload);
+ for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
+ CONSP (tail) || (tail = get_keymap (tail, 0, autoload), CONSP (tail));
+ tail = XCDR (tail))
+ {
+ Lisp_Object binding = XCAR (tail);
+
+ if (CONSP (binding))
+ map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
+ else if (VECTORP (binding))
+ {
+ /* Loop over the char values represented in the vector. */
+ int len = ASIZE (binding);
+ int c;
+ for (c = 0; c < len; c++)
+ {
+ Lisp_Object character;
+ XSETFASTINT (character, c);
+ map_keymap_item (fun, args, character, AREF (binding, c), data);
+ }
+ }
+ else if (CHAR_TABLE_P (binding))
+ {
+ map_char_table (map_keymap_char_table_item, Qnil, binding,
+ Fcons (make_save_value (fun, 0),
+ Fcons (make_save_value (data, 0),
+ args)));
+ }
+ }
+ UNGCPRO;
+}
+
+static void
+map_keymap_call (key, val, fun, dummy)
+ Lisp_Object key, val, fun;
+ void *dummy;
+{
+ call2 (fun, key, val);
+}
+
+DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 2, 0,
+ doc: /* Call FUNCTION for every binding in KEYMAP.
+FUNCTION is called with two arguments: the event and its binding. */)
+ (function, keymap)
+ Lisp_Object function, keymap;
+{
+ if (INTEGERP (function))
+ /* We have to stop integers early since map_keymap gives them special
+ significance. */
+ Fsignal (Qinvalid_function, Fcons (function, Qnil));
+ map_keymap (keymap, map_keymap_call, function, NULL, 1);
+ return Qnil;
+}
+
/* Given OBJECT which was found in a slot in a keymap,
trace indirect definitions to get the actual definition of that slot.
An indirect definition is a list of the form
Lisp_Object
get_keyelt (object, autoload)
- register Lisp_Object object;
+ Lisp_Object object;
int autoload;
{
while (1)
}
}
else
- /* Invalid keymap */
+ /* Invalid keymap. */
return object;
}
/* If the contents are (KEYMAP . ELEMENT), go indirect. */
else
{
+ struct gcpro gcpro1;
Lisp_Object map;
+ GCPRO1 (object);
map = get_keymap (Fcar_safe (object), 0, autoload);
+ UNGCPRO;
return (!CONSP (map) ? object /* Invalid keymap */
: access_keymap (map, Fcdr (object), 0, 0, autoload));
}
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))
/* Character codes with modifiers
are not included in a char-table.
All character codes without modifiers are included. */
- if (NATNUMP (idx)
- && ! (XFASTINT (idx)
- & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
- | CHAR_SHIFT | CHAR_CTL | CHAR_META)))
+ if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK))
+ {
+ Faset (elt, idx,
+ /* `nil' has a special meaning for char-tables, so
+ we use something else to record an explicitly
+ unbound entry. */
+ NILP (def) ? Qt : def);
+ return def;
+ }
+ else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
{
- Faset (elt, idx, def);
+ Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
return def;
}
insertion_point = tail;
{
if (EQ (idx, XCAR (elt)))
{
- XCDR (elt) = def;
+ 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. */
- XCDR (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);
+ XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
+ }
}
-
+
return def;
}
-void
+EXFUN (Fcopy_keymap, 1);
+
+Lisp_Object
+copy_keymap_item (elt)
+ Lisp_Object elt;
+{
+ Lisp_Object res, tem;
+
+ if (!CONSP (elt))
+ return elt;
+
+ res = tem = elt;
+
+ /* Is this a new format menu item. */
+ if (EQ (XCAR (tem), Qmenu_item))
+ {
+ /* Copy cell with menu-item marker. */
+ res = elt = Fcons (XCAR (tem), XCDR (tem));
+ tem = XCDR (elt);
+ if (CONSP (tem))
+ {
+ /* Copy cell with menu-item name. */
+ XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
+ elt = XCDR (elt);
+ tem = XCDR (elt);
+ }
+ if (CONSP (tem))
+ {
+ /* Copy cell with binding and if the binding is a keymap,
+ copy that. */
+ XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
+ elt = XCDR (elt);
+ tem = XCAR (elt);
+ if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
+ XSETCAR (elt, Fcopy_keymap (tem));
+ tem = XCDR (elt);
+ if (CONSP (tem) && CONSP (XCAR (tem)))
+ /* Delete cache for key equivalences. */
+ XSETCDR (elt, XCDR (tem));
+ }
+ }
+ else
+ {
+ /* It may be an old fomat menu item.
+ Skip the optional menu string. */
+ if (STRINGP (XCAR (tem)))
+ {
+ /* Copy the cell, since copy-alist didn't go this deep. */
+ res = elt = Fcons (XCAR (tem), XCDR (tem));
+ tem = XCDR (elt);
+ /* Also skip the optional menu help string. */
+ if (CONSP (tem) && STRINGP (XCAR (tem)))
+ {
+ XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
+ elt = XCDR (elt);
+ tem = XCDR (elt);
+ }
+ /* There may also be a list that caches key equivalences.
+ Just delete it for the new keymap. */
+ if (CONSP (tem)
+ && CONSP (XCAR (tem))
+ && (NILP (XCAR (XCAR (tem)))
+ || VECTORP (XCAR (XCAR (tem)))))
+ {
+ XSETCDR (elt, XCDR (tem));
+ tem = XCDR (tem);
+ }
+ if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
+ XSETCDR (elt, Fcopy_keymap (tem));
+ }
+ else if (EQ (XCAR (tem), Qkeymap))
+ res = Fcopy_keymap (elt);
+ }
+ return res;
+}
+
+static void
copy_keymap_1 (chartable, idx, elt)
Lisp_Object chartable, idx, elt;
{
- if (CONSP (elt) && EQ (XCAR (elt), Qkeymap))
- Faset (chartable, idx, Fcopy_keymap (elt));
+ Fset_char_table_range (chartable, idx, copy_keymap_item (elt));
}
DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
- "Return a copy of the keymap KEYMAP.\n\
-The copy starts out with the same definitions of KEYMAP,\n\
-but changing either the copy or KEYMAP does not affect the other.\n\
-Any key definitions that are subkeymaps are recursively copied.\n\
-However, a key definition which is a symbol whose definition is a keymap\n\
-is not copied.")
- (keymap)
+ doc: /* Return a copy of the keymap KEYMAP.
+The copy starts out with the same definitions of KEYMAP,
+but changing either the copy or KEYMAP does not affect the other.
+Any key definitions that are subkeymaps are recursively copied.
+However, a key definition which is a symbol whose definition is a keymap
+is not copied. */)
+ (keymap)
Lisp_Object keymap;
{
- /* FIXME: This doesn't properly copy menu-items in vectors. */
- /* FIXME: This also copies the parent keymap. */
-
register Lisp_Object copy, tail;
+ keymap = get_keymap (keymap, 1, 0);
+ copy = tail = Fcons (Qkeymap, Qnil);
+ keymap = XCDR (keymap); /* Skip the `keymap' symbol. */
- copy = Fcopy_alist (get_keymap (keymap, 1, 0));
-
- for (tail = copy; CONSP (tail); tail = XCDR (tail))
+ while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
{
- Lisp_Object elt;
-
- elt = XCAR (tail);
+ Lisp_Object elt = XCAR (keymap);
if (CHAR_TABLE_P (elt))
{
- Lisp_Object indices[3];
-
elt = Fcopy_sequence (elt);
- XCAR (tail) = elt;
-
- map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices);
+ map_char_table (copy_keymap_1, Qnil, elt, elt);
}
else if (VECTORP (elt))
{
int i;
-
elt = Fcopy_sequence (elt);
- XCAR (tail) = elt;
-
for (i = 0; i < ASIZE (elt); i++)
- if (CONSP (AREF (elt, i)) && EQ (XCAR (AREF (elt, i)), Qkeymap))
- ASET (elt, i, Fcopy_keymap (AREF (elt, i)));
- }
- else if (CONSP (elt) && CONSP (XCDR (elt)))
- {
- Lisp_Object tem;
- tem = XCDR (elt);
-
- /* Is this a new format menu item. */
- if (EQ (XCAR (tem),Qmenu_item))
- {
- /* Copy cell with menu-item marker. */
- XCDR (elt)
- = Fcons (XCAR (tem), XCDR (tem));
- elt = XCDR (elt);
- tem = XCDR (elt);
- if (CONSP (tem))
- {
- /* Copy cell with menu-item name. */
- XCDR (elt)
- = Fcons (XCAR (tem), XCDR (tem));
- elt = XCDR (elt);
- tem = XCDR (elt);
- };
- if (CONSP (tem))
- {
- /* Copy cell with binding and if the binding is a keymap,
- copy that. */
- XCDR (elt)
- = Fcons (XCAR (tem), XCDR (tem));
- elt = XCDR (elt);
- tem = XCAR (elt);
- if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
- XCAR (elt) = Fcopy_keymap (tem);
- tem = XCDR (elt);
- if (CONSP (tem) && CONSP (XCAR (tem)))
- /* Delete cache for key equivalences. */
- XCDR (elt) = XCDR (tem);
- }
- }
- else
- {
- /* It may be an old fomat menu item.
- Skip the optional menu string.
- */
- if (STRINGP (XCAR (tem)))
- {
- /* Copy the cell, since copy-alist didn't go this deep. */
- XCDR (elt)
- = Fcons (XCAR (tem), XCDR (tem));
- elt = XCDR (elt);
- tem = XCDR (elt);
- /* Also skip the optional menu help string. */
- if (CONSP (tem) && STRINGP (XCAR (tem)))
- {
- XCDR (elt)
- = Fcons (XCAR (tem), XCDR (tem));
- elt = XCDR (elt);
- tem = XCDR (elt);
- }
- /* There may also be a list that caches key equivalences.
- Just delete it for the new keymap. */
- if (CONSP (tem)
- && CONSP (XCAR (tem))
- && (NILP (XCAR (XCAR (tem)))
- || VECTORP (XCAR (XCAR (tem)))))
- XCDR (elt) = XCDR (tem);
- }
- if (CONSP (elt)
- && CONSP (XCDR (elt))
- && EQ (XCAR (XCDR (elt)), Qkeymap))
- XCDR (elt) = Fcopy_keymap (XCDR (elt));
- }
-
+ ASET (elt, i, copy_keymap_item (AREF (elt, i)));
}
+ else if (CONSP (elt))
+ elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
+ XSETCDR (tail, Fcons (elt, Qnil));
+ tail = XCDR (tail);
+ keymap = XCDR (keymap);
}
-
+ XSETCDR (tail, keymap);
return copy;
}
\f
/* GC is possible in this function if it autoloads a keymap. */
DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
- "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\
-KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\
-meaning a sequence of keystrokes and events.\n\
-Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
-can be included if you use a vector.\n\
-DEF is anything that can be a key's definition:\n\
- nil (means key is undefined in this keymap),\n\
- a command (a Lisp function suitable for interactive calling)\n\
- a string (treated as a keyboard macro),\n\
- a keymap (to define a prefix key),\n\
- a symbol. When the key is looked up, the symbol will stand for its\n\
- function definition, which should at that time be one of the above,\n\
- or another symbol whose function definition is used, etc.\n\
- a cons (STRING . DEFN), meaning that DEFN is the definition\n\
- (DEFN should be a valid definition in its own right),\n\
- or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\
-\n\
-If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\
-the front of KEYMAP.")
- (keymap, key, def)
+ doc: /* In KEYMAP, define key sequence KEY as DEF.
+KEYMAP is a keymap.
+
+KEY is a string or a vector of symbols and characters meaning a
+sequence of keystrokes and events. Non-ASCII characters with codes
+above 127 (such as ISO Latin-1) can be included if you use a vector.
+Using [t] for KEY creates a default definition, which applies to any
+event type that has no other definition in this keymap.
+
+DEF is anything that can be a key's definition:
+ nil (means key is undefined in this keymap),
+ a command (a Lisp function suitable for interactive calling),
+ a string (treated as a keyboard macro),
+ a keymap (to define a prefix key),
+ a symbol (when the key is looked up, the symbol will stand for its
+ function definition, which should at that time be one of the above,
+ or another symbol whose function definition is used, etc.),
+ 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.
+
+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
+binding KEY to DEF is added at the front of KEYMAP. */)
+ (keymap, key, def)
Lisp_Object keymap;
Lisp_Object key;
Lisp_Object def;
int length;
struct gcpro gcpro1, gcpro2, gcpro3;
+ GCPRO3 (keymap, key, def);
keymap = get_keymap (keymap, 1, 1);
if (!VECTORP (key) && !STRINGP (key))
length = XFASTINT (Flength (key));
if (length == 0)
- return Qnil;
+ RETURN_UNGCPRO (Qnil);
if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
- GCPRO3 (keymap, key, def);
-
- if (VECTORP (key))
- meta_bit = meta_modifier;
- else
- meta_bit = 0x80;
+ meta_bit = VECTORP (key) ? meta_modifier : 0x80;
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);
if (INTEGERP (c)
&& (XINT (c) & meta_bit)
idx++;
}
- if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c))
- error ("Key sequence contains invalid events");
+ 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)
RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
/* 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",
- XSTRING (Fkey_description (key))->data);
+ SDATA (Fkey_description (key, Qnil)));
}
}
-/* Value is number if KEY is too long; NIL if valid but has no definition. */
+/* This function may GC (it calls Fkey_binding). */
+
+DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 1, 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;
+{
+ if (!SYMBOLP (command))
+ return Qnil;
+
+ ASET (command_remapping_vector, 1, command);
+ return Fkey_binding (command_remapping_vector, Qnil, Qt);
+}
+
+/* Value is number if KEY is too long; nil if valid but has no definition. */
/* GC is possible in this function if it autoloads a keymap. */
DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
- "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\
-nil means undefined. See doc of `define-key' for kinds of definitions.\n\
-\n\
-A number as value means KEY is \"too long\";\n\
-that is, characters or symbols in it except for the last one\n\
-fail to be a valid sequence of prefix characters in KEYMAP.\n\
-The number is how many characters at the front of KEY\n\
-it takes to reach a non-prefix command.\n\
-\n\
-Normally, `lookup-key' ignores bindings for t, which act as default\n\
-bindings, used when nothing else in the keymap applies; this makes it\n\
-usable as a general function for probing keymaps. However, if the\n\
-third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\
-recognize the default bindings, just as `read-key-sequence' does.")
- (keymap, key, accept_default)
- register Lisp_Object keymap;
+ doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
+nil means undefined. See doc of `define-key' for kinds of definitions.
+
+A number as value means KEY is "too long";
+that is, characters or symbols in it except for the last one
+fail to be a valid sequence of prefix characters in KEYMAP.
+The number is how many characters at the front of KEY
+it takes to reach a non-prefix command.
+
+Normally, `lookup-key' ignores bindings for t, which act as default
+bindings, used when nothing else in the keymap applies; this makes it
+usable as a general function for probing keymaps. However, if the
+third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
+recognize the default bindings, just as `read-key-sequence' does. */)
+ (keymap, key, accept_default)
+ Lisp_Object keymap;
Lisp_Object key;
Lisp_Object accept_default;
{
register Lisp_Object c;
int length;
int t_ok = !NILP (accept_default);
- struct gcpro gcpro1;
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (keymap, key);
keymap = get_keymap (keymap, 1, 1);
if (!VECTORP (key) && !STRINGP (key))
length = XFASTINT (Flength (key));
if (length == 0)
- return keymap;
-
- GCPRO1 (key);
+ RETURN_UNGCPRO (keymap);
idx = 0;
while (1)
if (XINT (c) & 0x80 && STRINGP (key))
XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
+ /* Allow string since binding for `menu-bar-select-buffer'
+ includes the buffer name in the key sequence. */
+ if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
+ error ("Key sequence contains invalid event");
+
cmd = access_keymap (keymap, c, t_ok, 0, 1);
if (idx == length)
RETURN_UNGCPRO (cmd);
return Fvconcat (2, args);
}
+/* Given a event type C which is a symbol,
+ signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
+
+static void
+silly_event_symbol_error (c)
+ Lisp_Object c;
+{
+ Lisp_Object parsed, base, name, assoc;
+ int modifiers;
+
+ parsed = parse_modifiers (c);
+ modifiers = (int) XUINT (XCAR (XCDR (parsed)));
+ base = XCAR (parsed);
+ name = Fsymbol_name (base);
+ /* This alist includes elements such as ("RET" . "\\r"). */
+ assoc = Fassoc (name, exclude_keys);
+
+ if (! NILP (assoc))
+ {
+ char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
+ char *p = new_mods;
+ Lisp_Object keystring;
+ if (modifiers & alt_modifier)
+ { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
+ if (modifiers & ctrl_modifier)
+ { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
+ if (modifiers & hyper_modifier)
+ { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
+ if (modifiers & meta_modifier)
+ { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
+ if (modifiers & shift_modifier)
+ { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
+ if (modifiers & super_modifier)
+ { *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
+ *p = 0;
+
+ c = reorder_modifiers (c);
+ keystring = concat2 (build_string (new_mods), XCDR (assoc));
+
+ error ((modifiers & ~meta_modifier
+ ? "To bind the key %s, use [?%s], not [%s]"
+ : "To bind the key %s, use \"%s\", not [%s]"),
+ SDATA (SYMBOL_NAME (c)), SDATA (keystring),
+ SDATA (SYMBOL_NAME (c)));
+ }
+}
\f
/* Global, local, and minor mode keymap stuff. */
/* We can't put these variables inside current_minor_maps, since under
some systems, static gets macro-defined to be the empty string.
Ickypoo. */
-static Lisp_Object *cmm_modes, *cmm_maps;
-static int cmm_size;
+static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
+static int cmm_size = 0;
/* Error handler used in current_minor_maps. */
static Lisp_Object
int i = 0;
int list_number = 0;
Lisp_Object alist, assoc, var, val;
+ Lisp_Object emulation_alists;
Lisp_Object lists[2];
+ emulation_alists = Vemulation_mode_map_alists;
lists[0] = Vminor_mode_overriding_map_alist;
lists[1] = Vminor_mode_map_alist;
for (list_number = 0; list_number < 2; list_number++)
- for (alist = lists[list_number];
- CONSP (alist);
- alist = XCDR (alist))
- if ((assoc = XCAR (alist), CONSP (assoc))
- && (var = XCAR (assoc), SYMBOLP (var))
- && (val = find_symbol_value (var), !EQ (val, Qunbound))
- && !NILP (val))
+ {
+ if (CONSP (emulation_alists))
{
- Lisp_Object temp;
+ alist = XCAR (emulation_alists);
+ emulation_alists = XCDR (emulation_alists);
+ if (SYMBOLP (alist))
+ alist = find_symbol_value (alist);
+ list_number = -1;
+ }
+ else
+ alist = lists[list_number];
- /* If a variable has an entry in Vminor_mode_overriding_map_alist,
- and also an entry in Vminor_mode_map_alist,
- ignore the latter. */
- if (list_number == 1)
- {
- val = assq_no_quit (var, lists[0]);
- if (!NILP (val))
- break;
- }
+ for ( ; CONSP (alist); alist = XCDR (alist))
+ if ((assoc = XCAR (alist), CONSP (assoc))
+ && (var = XCAR (assoc), SYMBOLP (var))
+ && (val = find_symbol_value (var), !EQ (val, Qunbound))
+ && !NILP (val))
+ {
+ Lisp_Object temp;
- if (i >= cmm_size)
- {
- Lisp_Object *newmodes, *newmaps;
+ /* If a variable has an entry in Vminor_mode_overriding_map_alist,
+ and also an entry in Vminor_mode_map_alist,
+ ignore the latter. */
+ if (list_number == 1)
+ {
+ val = assq_no_quit (var, lists[0]);
+ if (!NILP (val))
+ continue;
+ }
- /* Use malloc/realloc here. See the comment above
- this function. */
- if (cmm_maps)
- {
- BLOCK_INPUT;
- cmm_size *= 2;
- newmodes
- = (Lisp_Object *) realloc (cmm_modes,
- cmm_size * sizeof *newmodes);
- newmaps
- = (Lisp_Object *) realloc (cmm_maps,
- cmm_size * sizeof *newmaps);
- UNBLOCK_INPUT;
- }
- else
- {
- BLOCK_INPUT;
- cmm_size = 30;
- newmodes
- = (Lisp_Object *) malloc (cmm_size * sizeof *newmodes);
- newmaps
- = (Lisp_Object *) malloc (cmm_size * sizeof *newmaps);
- UNBLOCK_INPUT;
- }
+ if (i >= cmm_size)
+ {
+ int newsize, allocsize;
+ Lisp_Object *newmodes, *newmaps;
- if (newmodes)
- cmm_modes = newmodes;
- if (newmaps)
- cmm_maps = newmaps;
-
- if (newmodes == NULL || newmaps == NULL)
- break;
- }
+ newsize = cmm_size == 0 ? 30 : cmm_size * 2;
+ allocsize = newsize * sizeof *newmodes;
- /* Get the keymap definition--or nil if it is not defined. */
- temp = internal_condition_case_1 (Findirect_function,
- XCDR (assoc),
- Qerror, current_minor_maps_error);
- if (!NILP (temp))
- {
- cmm_modes[i] = var;
- cmm_maps [i] = temp;
- i++;
- }
- }
+ /* Use malloc here. See the comment above this function.
+ Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
+ BLOCK_INPUT;
+ newmodes = (Lisp_Object *) malloc (allocsize);
+ if (newmodes)
+ {
+ if (cmm_modes)
+ {
+ bcopy (cmm_modes, newmodes, cmm_size * sizeof cmm_modes[0]);
+ free (cmm_modes);
+ }
+ cmm_modes = newmodes;
+ }
+
+ newmaps = (Lisp_Object *) malloc (allocsize);
+ if (newmaps)
+ {
+ if (cmm_maps)
+ {
+ bcopy (cmm_maps, newmaps, cmm_size * sizeof cmm_maps[0]);
+ free (cmm_maps);
+ }
+ cmm_maps = newmaps;
+ }
+ UNBLOCK_INPUT;
+
+ if (newmodes == NULL || newmaps == NULL)
+ break;
+ cmm_size = newsize;
+ }
+
+ /* Get the keymap definition--or nil if it is not defined. */
+ temp = internal_condition_case_1 (Findirect_function,
+ XCDR (assoc),
+ Qerror, current_minor_maps_error);
+ if (!NILP (temp))
+ {
+ cmm_modes[i] = var;
+ cmm_maps [i] = temp;
+ i++;
+ }
+ }
+ }
if (modeptr) *modeptr = cmm_modes;
if (mapptr) *mapptr = cmm_maps;
}
DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
- 0, 1, 0,
- "Return a list of the currently active keymaps.\n\
-OLP if non-nil indicates that we should obey `overriding-local-map' and\n\
-`overriding-terminal-local-map'.")
+ 0, 1, 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;
{
if (!NILP (local))
keymaps = Fcons (local, keymaps);
- local = get_local_map (PT, current_buffer, Qkeymap);
- if (!NILP (local))
- keymaps = Fcons (local, keymaps);
-
nmaps = current_minor_maps (0, &maps);
for (i = --nmaps; i >= 0; i--)
if (!NILP (maps[i]))
keymaps = Fcons (maps[i], keymaps);
+
+ local = get_local_map (PT, current_buffer, Qkeymap);
+ if (!NILP (local))
+ keymaps = Fcons (local, keymaps);
}
-
+
return keymaps;
}
/* GC is possible in this function if it autoloads a keymap. */
-DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
- "Return the binding for command KEY in current keymaps.\n\
-KEY is a string or vector, a sequence of keystrokes.\n\
-The binding is probably a symbol with a function definition.\n\
-\n\
-Normally, `key-binding' ignores bindings for t, which act as default\n\
-bindings, used when nothing else in the keymap applies; this makes it\n\
-usable as a general function for probing keymaps. However, if the\n\
-optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\
-recognize the default bindings, just as `read-key-sequence' does.")
- (key, accept_default)
- Lisp_Object key, accept_default;
+DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 3, 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.
+
+Normally, `key-binding' ignores bindings for t, which act as default
+bindings, used when nothing else in the keymap applies; this makes it
+usable as a general function for probing keymaps. However, if the
+optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
+recognize the default bindings, just as `read-key-sequence' does.
+
+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;
{
Lisp_Object *maps, value;
int nmaps, i;
value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
key, accept_default);
if (! NILP (value) && !INTEGERP (value))
- RETURN_UNGCPRO (value);
+ goto done;
}
else if (!NILP (Voverriding_local_map))
{
value = Flookup_key (Voverriding_local_map, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
- RETURN_UNGCPRO (value);
+ goto done;
}
else
- {
+ {
Lisp_Object local;
+ local = get_local_map (PT, current_buffer, Qkeymap);
+ if (! NILP (local))
+ {
+ value = Flookup_key (local, key, accept_default);
+ if (! NILP (value) && !INTEGERP (value))
+ goto done;
+ }
+
nmaps = current_minor_maps (0, &maps);
/* Note that all these maps are GCPRO'd
in the places where we found them. */
{
value = Flookup_key (maps[i], key, accept_default);
if (! NILP (value) && !INTEGERP (value))
- RETURN_UNGCPRO (value);
+ goto done;
}
- local = get_local_map (PT, current_buffer, Qkeymap);
- if (! NILP (local))
- {
- value = Flookup_key (local, key, accept_default);
- if (! NILP (value) && !INTEGERP (value))
- RETURN_UNGCPRO (value);
- }
-
local = get_local_map (PT, current_buffer, Qlocal_map);
-
if (! NILP (local))
{
value = Flookup_key (local, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
- RETURN_UNGCPRO (value);
+ goto done;
}
}
value = Flookup_key (current_global_map, key, accept_default);
+
+ done:
UNGCPRO;
- if (! NILP (value) && !INTEGERP (value))
- return value;
-
- return Qnil;
+ if (NILP (value) || INTEGERP (value))
+ return Qnil;
+
+ /* If the result of the ordinary keymap lookup is an interactive
+ command, look for a key binding (ie. remapping) for that command. */
+
+ if (NILP (no_remap) && SYMBOLP (value))
+ {
+ Lisp_Object value1;
+ if (value1 = Fcommand_remapping (value), !NILP (value1))
+ value = value1;
+ }
+
+ return value;
}
/* GC is possible in this function if it autoloads a keymap. */
DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
- "Return the binding for command KEYS in current local keymap only.\n\
-KEYS is a string, a sequence of keystrokes.\n\
-The binding is probably a symbol with a function definition.\n\
-\n\
-If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
-bindings; see the description of `lookup-key' for more details about this.")
- (keys, accept_default)
+ doc: /* Return the binding for command KEYS in current local keymap only.
+KEYS is a string, a sequence of keystrokes.
+The binding is probably a symbol with a function definition.
+
+If optional argument ACCEPT-DEFAULT is non-nil, recognize default
+bindings; see the description of `lookup-key' for more details about this. */)
+ (keys, accept_default)
Lisp_Object keys, accept_default;
{
register Lisp_Object map;
/* GC is possible in this function if it autoloads a keymap. */
DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
- "Return the binding for command KEYS in current global keymap only.\n\
-KEYS is a string, a sequence of keystrokes.\n\
-The binding is probably a symbol with a function definition.\n\
-This function's return values are the same as those of lookup-key\n\
-\(which see).\n\
-\n\
-If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
-bindings; see the description of `lookup-key' for more details about this.")
- (keys, accept_default)
+ doc: /* Return the binding for command KEYS in current global keymap only.
+KEYS is a string, a sequence of keystrokes.
+The binding is probably a symbol with a function definition.
+This function's return values are the same as those of `lookup-key'
+\(which see).
+
+If optional argument ACCEPT-DEFAULT is non-nil, recognize default
+bindings; see the description of `lookup-key' for more details about this. */)
+ (keys, accept_default)
Lisp_Object keys, accept_default;
{
return Flookup_key (current_global_map, keys, accept_default);
/* GC is possible in this function if it autoloads a keymap. */
DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
- "Find the visible minor mode bindings of KEY.\n\
-Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
-the symbol which names the minor mode binding KEY, and BINDING is\n\
-KEY's definition in that mode. In particular, if KEY has no\n\
-minor-mode bindings, return nil. If the first binding is a\n\
-non-prefix, all subsequent bindings will be omitted, since they would\n\
-be ignored. Similarly, the list doesn't include non-prefix bindings\n\
-that come after prefix bindings.\n\
-\n\
-If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
-bindings; see the description of `lookup-key' for more details about this.")
- (key, accept_default)
+ doc: /* Find the visible minor mode bindings of KEY.
+Return an alist of pairs (MODENAME . BINDING), where MODENAME is the
+the symbol which names the minor mode binding KEY, and BINDING is
+KEY's definition in that mode. In particular, if KEY has no
+minor-mode bindings, return nil. If the first binding is a
+non-prefix, all subsequent bindings will be omitted, since they would
+be ignored. Similarly, the list doesn't include non-prefix bindings
+that come after prefix bindings.
+
+If optional argument ACCEPT-DEFAULT is non-nil, recognize default
+bindings; see the description of `lookup-key' for more details about this. */)
+ (key, accept_default)
Lisp_Object key, accept_default;
{
Lisp_Object *modes, *maps;
}
DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
- "Define COMMAND as a prefix command. COMMAND should be a symbol.\n\
-A new sparse keymap is stored as COMMAND's function definition and its value.\n\
-If a second optional argument MAPVAR is given, the map is stored as\n\
-its value instead of as COMMAND's value; but COMMAND is still defined\n\
-as a function.\n\
-The third optional argument NAME, if given, supplies a menu name\n\
-string for the map. This is required to use the keymap as a menu.")
- (command, mapvar, name)
+ doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
+A new sparse keymap is stored as COMMAND's function definition and its value.
+If a second optional argument MAPVAR is given, the map is stored as
+its value instead of as COMMAND's value; but COMMAND is still defined
+as a function.
+The third optional argument NAME, if given, supplies a menu name
+string for the map. This is required to use the keymap as a menu. */)
+ (command, mapvar, name)
Lisp_Object command, mapvar, name;
{
Lisp_Object map;
}
DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
- "Select KEYMAP as the global keymap.")
- (keymap)
+ doc: /* Select KEYMAP as the global keymap. */)
+ (keymap)
Lisp_Object keymap;
{
keymap = get_keymap (keymap, 1, 1);
}
DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
- "Select KEYMAP as the local keymap.\n\
-If KEYMAP is nil, that means no local keymap.")
- (keymap)
+ doc: /* Select KEYMAP as the local keymap.
+If KEYMAP is nil, that means no local keymap. */)
+ (keymap)
Lisp_Object keymap;
{
if (!NILP (keymap))
}
DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
- "Return current buffer's local keymap, or nil if it has none.")
- ()
+ doc: /* Return current buffer's local keymap, or nil if it has none. */)
+ ()
{
return current_buffer->keymap;
}
DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
- "Return the current global keymap.")
- ()
+ doc: /* Return the current global keymap. */)
+ ()
{
return current_global_map;
}
DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
- "Return a list of keymaps for the minor modes of the current buffer.")
- ()
+ doc: /* Return a list of keymaps for the minor modes of the current buffer. */)
+ ()
{
Lisp_Object *maps;
int nmaps = current_minor_maps (0, &maps);
{
Lisp_Object tem;
- cmd = get_keyelt (cmd, 0);
+ cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
if (NILP (cmd))
return;
- tem = get_keymap (cmd, 0, 0);
- if (CONSP (tem))
+ /* Look for and break cycles. */
+ while (!NILP (tem = Frassq (cmd, maps)))
{
- cmd = tem;
- /* Ignore keymaps that are already added to maps. */
- tem = Frassq (cmd, maps);
- if (NILP (tem))
- {
- /* If the last key in thisseq is meta-prefix-char,
- turn it into a meta-ized keystroke. We know
- that the event we're about to append is an
- ascii keystroke since we're processing a
- keymap table. */
- if (is_metized)
- {
- int meta_bit = meta_modifier;
- Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
- tem = Fcopy_sequence (thisseq);
-
- Faset (tem, last, make_number (XINT (key) | meta_bit));
-
- /* This new sequence is the same length as
- thisseq, so stick it in the list right
- after this one. */
- XCDR (tail)
- = Fcons (Fcons (tem, cmd), XCDR (tail));
- }
- else
- {
- tem = append_key (thisseq, key);
- nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
- }
+ Lisp_Object prefix = XCAR (tem);
+ int lim = XINT (Flength (XCAR (tem)));
+ if (lim <= XINT (Flength (thisseq)))
+ { /* This keymap was already seen with a smaller prefix. */
+ int i = 0;
+ while (i < lim && EQ (Faref (prefix, make_number (i)),
+ Faref (thisseq, make_number (i))))
+ i++;
+ if (i >= lim)
+ /* `prefix' is a prefix of `thisseq' => there's a cycle. */
+ return;
}
+ /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
+ but maybe `cmd' occurs again further down in `maps', so keep
+ looking. */
+ maps = XCDR (Fmemq (tem, maps));
+ }
+
+ /* If the last key in thisseq is meta-prefix-char,
+ turn it into a meta-ized keystroke. We know
+ that the event we're about to append is an
+ ascii keystroke since we're processing a
+ keymap table. */
+ if (is_metized)
+ {
+ int meta_bit = meta_modifier;
+ Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
+ tem = Fcopy_sequence (thisseq);
+
+ Faset (tem, last, make_number (XINT (key) | meta_bit));
+
+ /* This new sequence is the same length as
+ thisseq, so stick it in the list right
+ after this one. */
+ XSETCDR (tail,
+ Fcons (Fcons (tem, cmd), XCDR (tail)));
+ }
+ else
+ {
+ tem = append_key (thisseq, key);
+ nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
}
}
/* This function cannot GC. */
DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
- 1, 2, 0,
- "Find all keymaps accessible via prefix characters from KEYMAP.\n\
-Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
-KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\
-so that the KEYS increase in length. The first element is ([] . KEYMAP).\n\
-An optional argument PREFIX, if non-nil, should be a key sequence;\n\
-then the value includes only maps for prefixes that start with PREFIX.")
- (keymap, prefix)
+ 1, 2, 0,
+ doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
+Returns a list of elements of the form (KEYS . MAP), where the sequence
+KEYS starting from KEYMAP gets you to MAP. These elements are ordered
+so that the KEYS increase in length. The first element is ([] . KEYMAP).
+An optional argument PREFIX, if non-nil, should be a key sequence;
+then the value includes only maps for prefixes that start with PREFIX. */)
+ (keymap, prefix)
Lisp_Object keymap, prefix;
{
- Lisp_Object maps, good_maps, tail;
+ Lisp_Object maps, tail;
int prefixlen = 0;
/* no need for gcpro because we don't autoload any keymaps. */
int i, i_byte, c;
Lisp_Object copy;
- copy = Fmake_vector (make_number (XSTRING (prefix)->size), Qnil);
- for (i = 0, i_byte = 0; i < XSTRING (prefix)->size;)
+ copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
+ for (i = 0, i_byte = 0; i < SCHARS (prefix);)
{
int i_before = i;
if (CHAR_TABLE_P (elt))
{
- Lisp_Object indices[3];
-
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))
{
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)));
-
- }
- }
-
- if (NILP (prefix))
- return maps;
- /* Now find just the maps whose access prefixes start with PREFIX. */
-
- good_maps = Qnil;
- for (; CONSP (maps); maps = XCDR (maps))
- {
- Lisp_Object elt, thisseq;
- elt = XCAR (maps);
- thisseq = XCAR (elt);
- /* The access prefix must be at least as long as PREFIX,
- and the first elements must match those of PREFIX. */
- if (XINT (Flength (thisseq)) >= prefixlen)
- {
- int i;
- for (i = 0; i < prefixlen; i++)
- {
- Lisp_Object i1;
- XSETFASTINT (i1, i);
- if (!EQ (Faref (thisseq, i1), Faref (prefix, i1)))
- break;
- }
- if (i == prefixlen)
- good_maps = Fcons (elt, good_maps);
}
}
- return Fnreverse (good_maps);
+ return maps;
}
\f
Lisp_Object Qsingle_key_description, Qkey_description;
/* This function cannot GC. */
-DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
- "Return a pretty description of key-sequence KEYS.\n\
-Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
-spaces are put between sequence elements, etc.")
- (keys)
- Lisp_Object keys;
+DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
+ doc: /* Return a pretty description of key-sequence KEYS.
+Optional arg PREFIX is the sequence of keys leading up to KEYS.
+Control characters turn into "C-foo" sequences, meta into "M-foo",
+spaces are put between sequence elements, etc. */)
+ (keys, prefix)
+ Lisp_Object keys, prefix;
{
int len = 0;
int i, i_byte;
- Lisp_Object sep;
- Lisp_Object *args = NULL;
+ Lisp_Object *args;
+ int size = XINT (Flength (keys));
+ Lisp_Object list;
+ Lisp_Object sep = build_string (" ");
+ Lisp_Object key;
+ int add_meta = 0;
+
+ if (!NILP (prefix))
+ size += XINT (Flength (prefix));
+
+ /* This has one extra element at the end that we don't pass to Fconcat. */
+ args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
- if (STRINGP (keys))
+ /* In effect, this computes
+ (mapconcat 'single-key-description keys " ")
+ but we shouldn't use mapconcat because it can do GC. */
+
+ next_list:
+ if (!NILP (prefix))
+ list = prefix, prefix = Qnil;
+ else if (!NILP (keys))
+ list = keys, keys = Qnil;
+ else
{
- Lisp_Object vector;
- vector = Fmake_vector (Flength (keys), Qnil);
- for (i = 0, i_byte = 0; i < XSTRING (keys)->size; )
+ if (add_meta)
{
- int c;
- int i_before = i;
-
- FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte);
- if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
- c ^= 0200 | meta_modifier;
- XSETFASTINT (AREF (vector, i_before), c);
+ args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
+ len += 2;
}
- keys = vector;
+ else if (len == 0)
+ return empty_string;
+ return Fconcat (len - 1, args);
}
- if (VECTORP (keys))
- {
- /* In effect, this computes
- (mapconcat 'single-key-description keys " ")
- but we shouldn't use mapconcat because it can do GC. */
+ if (STRINGP (list))
+ size = SCHARS (list);
+ else if (VECTORP (list))
+ size = XVECTOR (list)->size;
+ else if (CONSP (list))
+ size = XINT (Flength (list));
+ else
+ wrong_type_argument (Qarrayp, list);
- len = XVECTOR (keys)->size;
- sep = build_string (" ");
- /* This has one extra element at the end that we don't pass to Fconcat. */
- args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
+ i = i_byte = 0;
- for (i = 0; i < len; i++)
+ while (i < size)
+ {
+ if (STRINGP (list))
+ {
+ int c;
+ FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
+ if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
+ c ^= 0200 | meta_modifier;
+ XSETFASTINT (key, c);
+ }
+ else if (VECTORP (list))
{
- args[i * 2] = Fsingle_key_description (AREF (keys, i), Qnil);
- args[i * 2 + 1] = sep;
+ key = AREF (list, i++);
+ }
+ else
+ {
+ key = XCAR (list);
+ list = XCDR (list);
+ i++;
}
- }
- else if (CONSP (keys))
- {
- /* In effect, this computes
- (mapconcat 'single-key-description keys " ")
- but we shouldn't use mapconcat because it can do GC. */
-
- len = XFASTINT (Flength (keys));
- sep = build_string (" ");
- /* This has one extra element at the end that we don't pass to Fconcat. */
- args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
- for (i = 0; i < len; i++)
+ if (add_meta)
{
- args[i * 2] = Fsingle_key_description (XCAR (keys), Qnil);
- args[i * 2 + 1] = sep;
- keys = XCDR (keys);
+ if (!INTEGERP (key)
+ || EQ (key, meta_prefix_char)
+ || (XINT (key) & meta_modifier))
+ {
+ args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
+ args[len++] = sep;
+ if (EQ (key, meta_prefix_char))
+ continue;
+ }
+ else
+ XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
+ add_meta = 0;
}
+ else if (EQ (key, meta_prefix_char))
+ {
+ add_meta = 1;
+ continue;
+ }
+ args[len++] = Fsingle_key_description (key, Qnil);
+ args[len++] = sep;
}
- else
- keys = wrong_type_argument (Qarrayp, keys);
-
- if (len == 0)
- return build_string ("");
- return Fconcat (len * 2 - 1, args);
+ goto next_list;
}
+
char *
push_key_description (c, p, force_multibyte)
register unsigned int c;
int force_multibyte;
{
unsigned c2;
-
+
/* Clear all the meaningless bits above the meta bit. */
c &= meta_modifier | ~ - meta_modifier;
c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
{
*p++ = c;
}
+ else if (CHARACTERP (make_number (c)))
+ {
+ if (NILP (current_buffer->enable_multibyte_characters)
+ && ! force_multibyte)
+ *p++ = multibyte_char_to_unibyte (c, Qnil);
+ else
+ p += CHAR_STRING (c, (unsigned char *) p);
+ }
else
{
- int valid_p = SINGLE_BYTE_CHAR_P (c) || char_valid_p (c, 0);
-
- if (force_multibyte && valid_p)
- {
- 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)
+ int bit_offset;
+ *p++ = '\\';
+ /* The biggest character code uses 22 bits. */
+ for (bit_offset = 21; bit_offset >= 0; bit_offset -= 3)
{
- 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';
- }
+ if (c >= (1 << bit_offset))
+ *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
}
- else
- p += CHAR_STRING (c, p);
}
- return p;
+ return p;
}
/* This function cannot GC. */
DEFUN ("single-key-description", Fsingle_key_description,
Ssingle_key_description, 1, 2, 0,
- "Return a pretty description of command character KEY.\n\
-Control characters turn into C-whatever, etc.\n\
-Optional argument NO-ANGLES non-nil means don't put angle brackets\n\
-around function keys and event symbols.")
- (key, no_angles)
+ doc: /* Return a pretty description of command character KEY.
+Control characters turn into C-whatever, etc.
+Optional argument NO-ANGLES non-nil means don't put angle brackets
+around function keys and event symbols. */)
+ (key, no_angles)
Lisp_Object key, no_angles;
{
if (CONSP (key) && lucid_event_type_list_p (key))
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, 0);
- 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 */
{
if (NILP (no_angles))
{
char *buffer
- = (char *) alloca (STRING_BYTES (XSYMBOL (key)->name) + 5);
- sprintf (buffer, "<%s>", XSYMBOL (key)->name->data);
+ = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
+ sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
return build_string (buffer);
}
else
}
else
*p++ = c;
- return p;
+ return p;
}
/* This function cannot GC. */
DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
- "Return a pretty description of file-character CHARACTER.\n\
-Control characters turn into \"^char\", etc.")
- (character)
+ doc: /* Return a pretty description of file-character CHARACTER.
+Control characters turn into "^char", etc. */)
+ (character)
Lisp_Object character;
{
/* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
unsigned char str[6];
int c;
- CHECK_NUMBER (character, 0);
+ CHECK_NUMBER (character);
c = XINT (character);
- if (!SINGLE_BYTE_CHAR_P (c))
+ if (!ASCII_CHAR_P (c))
{
int len = CHAR_STRING (c, str);
\f
/* 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 ();
return Qnil;
}
+static Lisp_Object Vmouse_events;
+
/* This function can GC if Flookup_key autoloads any keymaps. */
static Lisp_Object
-where_is_internal (definition, keymaps, firstonly, noindirect)
+where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
Lisp_Object definition, keymaps;
- Lisp_Object firstonly, noindirect;
+ Lisp_Object firstonly, noindirect, no_remap;
{
Lisp_Object maps = Qnil;
Lisp_Object found, sequences;
/* 1 means ignore all menu bindings entirely. */
int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
+ /* If this command is remapped, then it has no key bindings
+ of its own. */
+ if (NILP (no_remap) && SYMBOLP (definition))
+ {
+ Lisp_Object tem;
+ if (tem = Fcommand_remapping (definition), !NILP (tem))
+ return Qnil;
+ }
+
found = keymaps;
while (CONSP (found))
{
Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
found = XCDR (found);
}
-
+
GCPRO5 (definition, keymaps, maps, found, sequences);
found = Qnil;
sequences = Qnil;
for (; !NILP (maps); maps = Fcdr (maps))
{
/* Key sequence to reach map, and the map that it reaches */
- register Lisp_Object this, map;
+ register Lisp_Object this, map, tem;
/* In order to fold [META-PREFIX-CHAR CHAR] sequences into
[M-CHAR] sequences, check if last character of the sequence
/* if (nomenus && !ascii_sequence_p (this)) */
if (nomenus && XINT (last) >= 0
- && !INTEGERP (Faref (this, make_number (0))))
+ && SYMBOLP (tem = Faref (this, make_number (0)))
+ && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
/* If no menu entries should be returned, skip over the
keymaps bound to `menu-bar' and `tool-bar' and other
non-ascii prefixes like `C-down-mouse-2'. */
continue;
-
+
QUIT;
while (CONSP (map))
}
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, args,
- 0, indices);
+ map_char_table (where_is_internal_2, Qnil, elt, args);
sequences = XCDR (XCAR (args));
}
else if (CONSP (elt))
}
- for (; !NILP (sequences); sequences = XCDR (sequences))
+ while (!NILP (sequences))
{
- Lisp_Object 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.
if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
continue;
+ 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)))
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;
+ }
}
}
}
return the best we could find. */
if (!NILP (firstonly))
return Fcar (found);
-
+
return found;
}
-DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
- "Return list of keys that invoke DEFINITION.\n\
-If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
-If KEYMAP is nil, search all the currently active keymaps.\n\
-If KEYMAP is a list of keymaps, search only those keymaps.\n\
-\n\
-If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\
-rather than a list of all possible key sequences.\n\
-If FIRSTONLY is the symbol `non-ascii', return the first binding found,\n\
-no matter what it is.\n\
-If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,\n\
-and entirely reject menu bindings.\n\
-\n\
-If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
-to other keymaps or slots. This makes it possible to search for an\n\
-indirect definition itself.")
- (definition, keymap, firstonly, noindirect)
+DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
+ doc: /* Return list of keys that invoke DEFINITION.
+If KEYMAP is non-nil, search only KEYMAP and the global keymap.
+If KEYMAP is nil, search all the currently active keymaps.
+If KEYMAP is a list of keymaps, search only those keymaps.
+
+If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
+rather than a list of all possible key sequences.
+If FIRSTONLY is the symbol `non-ascii', return the first binding found,
+no matter what it is.
+If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,
+and entirely reject menu bindings.
+
+If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
+to other keymaps or slots. This makes it possible to search for an
+indirect definition itself.
+
+If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
+that invoke a command which is remapped to DEFINITION, but include the
+remapped command in the returned list. */)
+ (definition, keymap, firstonly, noindirect, no_remap)
Lisp_Object definition, keymap;
- Lisp_Object firstonly, noindirect;
+ Lisp_Object firstonly, noindirect, no_remap;
{
Lisp_Object sequences, keymaps;
/* 1 means ignore all menu bindings entirely. */
{
Lisp_Object *defns;
int i, j, n;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+
/* Check heuristic-consistency of the cache. */
if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
where_is_cache = Qnil;
Lisp_Object args[2];
where_is_cache = Fmake_hash_table (0, args);
where_is_cache_keymaps = Qt;
-
+
/* Fill in the cache. */
- GCPRO4 (definition, keymaps, firstonly, noindirect);
- where_is_internal (definition, keymaps, firstonly, noindirect);
+ GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
+ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
UNGCPRO;
where_is_cache_keymaps = keymaps;
defns = (Lisp_Object *) alloca (n * sizeof *defns);
for (i = 0; CONSP (sequences); sequences = XCDR (sequences))
defns[i++] = XCAR (sequences);
-
+
/* Verify that the key bindings are not shadowed. Note that
the following can GC. */
GCPRO2 (definition, keymaps);
/* Kill the cache so that where_is_internal_1 doesn't think
we're filling it up. */
where_is_cache = Qnil;
- result = where_is_internal (definition, keymaps, firstonly, noindirect);
+ result = where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
}
return result;
this, last, nomenus, last_is_meta);
if (!NILP (sequence))
- XCDR (XCAR (args)) = Fcons (sequence, result);
+ XSETCDR (XCAR (args), Fcons (sequence, result));
UNGCPRO;
}
\f
/* describe-bindings - summarizing all the bindings in a set of keymaps. */
-DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, Sdescribe_bindings_internal, 0, 2, "",
- "Show a list of all defined keys, and their definitions.\n\
-We put that list in a buffer, and display the buffer.\n\
-\n\
-The optional argument MENUS, if non-nil, says to mention menu bindings.\n\
-\(Ordinarily these are omitted from the output.)\n\
-The optional argument PREFIX, if non-nil, should be a key sequence;\n\
-then we display only bindings that start with that prefix.")
- (menus, prefix)
- Lisp_Object menus, prefix;
-{
- register Lisp_Object thisbuf;
- XSETBUFFER (thisbuf, current_buffer);
- internal_with_output_to_temp_buffer ("*Help*",
- describe_buffer_bindings,
- list3 (thisbuf, prefix, menus));
- return Qnil;
-}
-
DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
- "Insert the list of all defined keys and their definitions.\n\
-The list is inserted in the current buffer, while the bindings are\n\
-looked up in BUFFER.\n\
-The optional argument PREFIX, if non-nil, should be a key sequence;\n\
-then we display only bindings that start with that prefix.\n\
-The optional argument MENUS, if non-nil, says to mention menu bindings.\n\
-\(Ordinarily these are omitted from the output.)")
- (buffer, prefix, menus)
+ doc: /* Insert the list of all defined keys and their definitions.
+The list is inserted in the current buffer, while the bindings are
+looked up in BUFFER.
+The optional argument PREFIX, if non-nil, should be a key sequence;
+then we display only bindings that start with that prefix.
+The optional argument MENUS, if non-nil, says to mention menu bindings.
+\(Ordinarily these are omitted from the output.) */)
+ (buffer, prefix, menus)
Lisp_Object buffer, prefix, menus;
{
Lisp_Object outbuf, shadow;
shadow = Qnil;
GCPRO1 (shadow);
- outbuf = Fcurrent_buffer();
+ outbuf = Fcurrent_buffer ();
/* Report on alternates for keys. */
if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
{
int c;
- unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
- int translate_len = XSTRING (Vkeyboard_translate_table)->size;
+ const unsigned char *translate = SDATA (Vkeyboard_translate_table);
+ int translate_len = SCHARS (Vkeyboard_translate_table);
for (c = 0; c < translate_len; c++)
if (translate[c] != c)
describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
"Key translations", nomenu, 1, 0);
- {
- int i, nmaps;
- Lisp_Object *modes, *maps;
-
- /* Temporarily switch to `buffer', so that we can get that buffer's
- minor modes correctly. */
- Fset_buffer (buffer);
-
- if (!NILP (current_kboard->Voverriding_terminal_local_map)
- || !NILP (Voverriding_local_map))
- nmaps = 0;
- else
- nmaps = current_minor_maps (&modes, &maps);
- Fset_buffer (outbuf);
-
- /* Print the minor mode maps. */
- for (i = 0; i < nmaps; i++)
- {
- /* The title for a minor mode keymap
- is constructed at run time.
- We let describe_map_tree do the actual insertion
- because it takes care of other features when doing so. */
- char *title, *p;
-
- if (!SYMBOLP (modes[i]))
- abort();
-
- p = title = (char *) alloca (42 + XSYMBOL (modes[i])->name->size);
- *p++ = '\f';
- *p++ = '\n';
- *p++ = '`';
- bcopy (XSYMBOL (modes[i])->name->data, p,
- XSYMBOL (modes[i])->name->size);
- p += XSYMBOL (modes[i])->name->size;
- *p++ = '\'';
- bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
- p += sizeof (" Minor Mode Bindings") - 1;
- *p = 0;
-
- describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0);
- shadow = Fcons (maps[i], shadow);
- }
- }
/* Print the (major mode) local map. */
+ start1 = Qnil;
if (!NILP (current_kboard->Voverriding_terminal_local_map))
start1 = current_kboard->Voverriding_terminal_local_map;
else if (!NILP (Voverriding_local_map))
start1 = Voverriding_local_map;
- else
- start1 = XBUFFER (buffer)->keymap;
if (!NILP (start1))
{
describe_map_tree (start1, 1, shadow, prefix,
- "\f\nMajor Mode Bindings", nomenu, 0, 0);
+ "\f\nOverriding Bindings", nomenu, 0, 0);
shadow = Fcons (start1, shadow);
}
+ else
+ {
+ /* Print the minor mode and major mode keymaps. */
+ int i, nmaps;
+ Lisp_Object *modes, *maps;
+
+ /* Temporarily switch to `buffer', so that we can get that buffer's
+ minor modes correctly. */
+ Fset_buffer (buffer);
+
+ nmaps = current_minor_maps (&modes, &maps);
+ Fset_buffer (outbuf);
+
+ start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
+ XBUFFER (buffer), Qkeymap);
+ if (!NILP (start1))
+ {
+ describe_map_tree (start1, 1, shadow, prefix,
+ "\f\n`keymap' Property Bindings", nomenu, 0, 0);
+ shadow = Fcons (start1, shadow);
+ }
+
+ /* Print the minor mode maps. */
+ for (i = 0; i < nmaps; i++)
+ {
+ /* The title for a minor mode keymap
+ is constructed at run time.
+ We let describe_map_tree do the actual insertion
+ because it takes care of other features when doing so. */
+ char *title, *p;
+
+ if (!SYMBOLP (modes[i]))
+ abort();
+
+ p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
+ *p++ = '\f';
+ *p++ = '\n';
+ *p++ = '`';
+ bcopy (SDATA (SYMBOL_NAME (modes[i])), p,
+ SCHARS (SYMBOL_NAME (modes[i])));
+ p += SCHARS (SYMBOL_NAME (modes[i]));
+ *p++ = '\'';
+ bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
+ p += sizeof (" Minor Mode Bindings") - 1;
+ *p = 0;
+
+ describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0);
+ shadow = Fcons (maps[i], shadow);
+ }
+
+ start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
+ XBUFFER (buffer), Qlocal_map);
+ if (!NILP (start1))
+ {
+ if (EQ (start1, XBUFFER (buffer)->keymap))
+ describe_map_tree (start1, 1, shadow, prefix,
+ "\f\nMajor Mode Bindings", nomenu, 0, 0);
+ else
+ describe_map_tree (start1, 1, shadow, prefix,
+ "\f\n`local-map' Property Bindings",
+ nomenu, 0, 0);
+
+ shadow = Fcons (start1, shadow);
+ }
+ }
describe_map_tree (current_global_map, 1, shadow, prefix,
"\f\nGlobal Bindings", nomenu, 0, 1);
return Qnil;
}
-/* ARG is (BUFFER PREFIX MENU-FLAG). */
-
-static Lisp_Object
-describe_buffer_bindings (arg)
- Lisp_Object arg;
-{
- Fset_buffer (Vstandard_output);
- return Fdescribe_buffer_bindings (XCAR (arg), XCAR (XCDR (arg)),
- XCAR (XCDR (XCDR (arg))));
-}
-
-
/* Insert a description of the key bindings in STARTMAP,
followed by those of all maps reachable through STARTMAP.
If PARTIAL is nonzero, omit certain "uninteresting" commands
if (!NILP (prefix))
{
insert_string (" Starting With ");
- insert1 (Fkey_description (prefix));
+ insert1 (Fkey_description (prefix, Qnil));
}
insert_string (":\n");
}
/* If the sequence by which we reach this keymap is zero-length,
then the shadow map for this keymap is just SHADOW. */
- if ((STRINGP (prefix) && XSTRING (prefix)->size == 0)
+ if ((STRINGP (prefix) && SCHARS (prefix) == 0)
|| (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
;
/* If the sequence by which we reach this keymap actually has
static int previous_description_column;
static void
-describe_command (definition)
- Lisp_Object definition;
+describe_command (definition, args)
+ Lisp_Object definition, args;
{
register Lisp_Object tem1;
- int column = current_column ();
+ int column = (int) current_column (); /* iftc */
int description_column;
/* If column 16 is no good, go to col 32;
if (SYMBOLP (definition))
{
- XSETSTRING (tem1, XSYMBOL (definition)->name);
+ tem1 = SYMBOL_NAME (definition);
insert1 (tem1);
insert_string ("\n");
}
}
static void
-describe_translation (definition)
- Lisp_Object definition;
+describe_translation (definition, args)
+ Lisp_Object definition, args;
{
register Lisp_Object tem1;
if (SYMBOLP (definition))
{
- XSETSTRING (tem1, XSYMBOL (definition)->name);
+ tem1 = SYMBOL_NAME (definition);
insert1 (tem1);
insert_string ("\n");
}
else if (STRINGP (definition) || VECTORP (definition))
{
- insert1 (Fkey_description (definition));
+ insert1 (Fkey_description (definition, Qnil));
insert_string ("\n");
}
else if (KEYMAPP (definition))
}
/* Describe the contents of map MAP, assuming that this map itself is
- reached by the sequence of prefix keys KEYS (a string or vector).
+ reached by the sequence of prefix keys PREFIX (a string or vector).
PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
static void
-describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
+describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
register Lisp_Object map;
- Lisp_Object keys;
- void (*elt_describer) P_ ((Lisp_Object));
+ Lisp_Object prefix;
+ void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
int partial;
Lisp_Object shadow;
Lisp_Object *seen;
int nomenu;
{
- Lisp_Object elt_prefix;
Lisp_Object tail, definition, event;
Lisp_Object tem;
Lisp_Object suppress;
suppress = Qnil;
- if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
- {
- /* Call Fkey_description first, to avoid GC bug for the other string. */
- tem = Fkey_description (keys);
- elt_prefix = concat2 (tem, build_string (" "));
- }
- else
- elt_prefix = Qnil;
-
if (partial)
suppress = intern ("suppress-keymap");
kludge = Fmake_vector (make_number (1), Qnil);
definition = Qnil;
- GCPRO3 (elt_prefix, definition, kludge);
+ GCPRO3 (prefix, definition, kludge);
for (tail = map; CONSP (tail); tail = XCDR (tail))
{
if (VECTORP (XCAR (tail))
|| CHAR_TABLE_P (XCAR (tail)))
describe_vector (XCAR (tail),
- elt_prefix, elt_describer, partial, shadow, map,
- (int *)0, 0);
+ prefix, Qnil, elt_describer, partial, shadow, map,
+ (int *)0, 0, 1);
else if (CONSP (XCAR (tail)))
{
event = XCAR (XCAR (tail));
- /* Ignore bindings whose "keys" are not really valid events.
+ /* Ignore bindings whose "prefix" are not really valid events.
(We get these in the frames and buffers menu.) */
if (!(SYMBOLP (event) || INTEGERP (event)))
continue;
first = 0;
}
- if (!NILP (elt_prefix))
- insert1 (elt_prefix);
-
/* THIS gets the string to describe the character EVENT. */
- insert1 (Fsingle_key_description (event, Qnil));
+ insert1 (Fkey_description (kludge, prefix));
/* Print a description of the definition of this character.
elt_describer will take care of spacing out far enough
for alignment purposes. */
- (*elt_describer) (definition);
+ (*elt_describer) (definition, Qnil);
}
else if (EQ (XCAR (tail), Qkeymap))
{
using an inherited keymap. So skip anything we've already
encountered. */
tem = Fassq (tail, *seen);
- if (CONSP (tem) && !NILP (Fequal (XCAR (tem), keys)))
+ if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
break;
- *seen = Fcons (Fcons (tail, keys), *seen);
+ *seen = Fcons (Fcons (tail, prefix), *seen);
}
}
}
static void
-describe_vector_princ (elt)
- Lisp_Object elt;
+describe_vector_princ (elt, fun)
+ Lisp_Object elt, fun;
{
Findent_to (make_number (16), make_number (1));
- Fprinc (elt, Qnil);
+ call1 (fun, elt);
Fterpri (Qnil);
}
-DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0,
- "Insert a description of contents of VECTOR.\n\
-This is text showing the elements of vector matched against indices.")
- (vector)
- Lisp_Object vector;
+DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
+ doc: /* Insert a description of contents of VECTOR.
+This is text showing the elements of vector matched against indices.
+DESCRIBER is the output function used; nil means use `princ'. */)
+ (vector, describer)
+ Lisp_Object vector, describer;
{
- int count = specpdl_ptr - specpdl;
-
+ int count = SPECPDL_INDEX ();
+ if (NILP (describer))
+ describer = intern ("princ");
specbind (Qstandard_output, Fcurrent_buffer ());
- CHECK_VECTOR_OR_CHAR_TABLE (vector, 0);
- describe_vector (vector, Qnil, describe_vector_princ, 0,
- Qnil, Qnil, (int *)0, 0);
+ CHECK_VECTOR_OR_CHAR_TABLE (vector);
+ describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
+ Qnil, Qnil, (int *)0, 0, 0);
return unbind_to (count, Qnil);
}
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.
-void
-describe_vector (vector, elt_prefix, 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-.
+
+ ARGS is simply passed as the second argument to ELT_DESCRIBER. */
+
+static void
+describe_vector (vector, prefix, args, elt_describer,
partial, shadow, entire_map,
- indices, char_table_depth)
+ indices, char_table_depth, keymap_p)
register Lisp_Object vector;
- Lisp_Object elt_prefix;
- void (*elt_describer) P_ ((Lisp_Object));
+ Lisp_Object prefix, args;
+ void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
int partial;
Lisp_Object shadow;
Lisp_Object entire_map;
int *indices;
int char_table_depth;
+ int keymap_p;
{
Lisp_Object definition;
Lisp_Object tem2;
- register int i;
+ Lisp_Object elt_prefix = Qnil;
+ int i;
Lisp_Object suppress;
Lisp_Object kludge;
int first = 1;
- struct gcpro gcpro1, gcpro2, gcpro3;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
/* Range of elements to be handled. */
int from, to;
- /* A flag to tell if a leaf in this level of char-table is not a
- 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)
+ {
+ /* Call Fkey_description first, to avoid GC bug for the other string. */
+ if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
+ {
+ Lisp_Object tem;
+ tem = Fkey_description (prefix, Qnil);
+ elt_prefix = concat2 (tem, build_string (" "));
+ }
+ prefix = Qnil;
+ }
+
/* This vector gets used to present single keys to Flookup_key. Since
that is done once per vector element, we don't want to cons up a
fresh vector every time. */
kludge = Fmake_vector (make_number (1), Qnil);
- GCPRO3 (elt_prefix, definition, kludge);
+ GCPRO4 (elt_prefix, prefix, definition, kludge);
if (partial)
suppress = intern ("suppress-keymap");
- 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++)
{
- 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 (definition)) continue;
/* Don't mention suppressed commands. */
if (SYMBOLP (definition) && partial)
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;
+ 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;
-
- ASET (kludge, 0, make_number (character));
+
tem = shadow_lookup (shadow, kludge, Qt);
if (!NILP (tem)) continue;
/* 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;
- ASET (kludge, 0, make_number (character));
tem = Flookup_key (entire_map, kludge, Qt);
if (!EQ (tem, definition))
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 (Fsingle_key_description (make_number (character), Qnil));
- 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, XSTRING (tem2)->size,
- STRING_BYTES (XSTRING (tem2)), 0);
- else
- insert ("?", 1);
- insert (">", 1);
- }
- }
- else
- {
- insert1 (Fsingle_key_description (make_number (character), Qnil));
- }
-
- /* 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, elt_prefix, elt_describer,
- partial, shadow, entire_map,
- indices, char_table_depth + 1);
- 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 (tem2))
&& !NILP (Fequal (tem2, definition)))
i++;
-
/* If we have a range of more than one character,
print where the range reaches to. */
{
insert (" .. ", 4);
+ ASET (kludge, 0, make_number (i));
+
if (!NILP (elt_prefix))
insert1 (elt_prefix);
- if (CHAR_TABLE_P (vector))
- {
- if (char_table_depth == 0)
- {
- insert1 (Fsingle_key_description (make_number (i), Qnil));
- }
- 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 (Fsingle_key_description (make_number (i), Qnil));
- }
+ insert1 (Fkey_description (kludge, prefix));
}
/* Print a description of the definition of this character.
elt_describer will take care of spacing out far enough
for alignment purposes. */
- (*elt_describer) (definition);
+ (*elt_describer) (definition, args);
}
- /* 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>>");
- (*elt_describer) (XCHAR_TABLE (vector)->defalt);
+ if (!NILP (elt_prefix))
+ insert1 (elt_prefix);
+ insert ("default", 7);
+ (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
}
UNGCPRO;
}
\f
/* Apropos - finding all symbols whose names match a regexp. */
-Lisp_Object apropos_predicate;
-Lisp_Object apropos_accumulate;
+static Lisp_Object apropos_predicate;
+static Lisp_Object apropos_accumulate;
static void
apropos_accum (symbol, string)
apropos_accumulate = Fcons (symbol, apropos_accumulate);
}
-DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
- "Show all symbols whose names contain match for REGEXP.\n\
-If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\
-for each symbol and a symbol is mentioned only if that returns non-nil.\n\
-Return list of symbols found.")
- (regexp, predicate)
+DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
+ doc: /* Show all symbols whose names contain match for REGEXP.
+If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
+for each symbol and a symbol is mentioned only if that returns non-nil.
+Return list of symbols found. */)
+ (regexp, predicate)
Lisp_Object regexp, predicate;
{
- struct gcpro gcpro1, gcpro2;
- CHECK_STRING (regexp, 0);
+ Lisp_Object tem;
+ CHECK_STRING (regexp);
apropos_predicate = predicate;
- GCPRO2 (apropos_predicate, apropos_accumulate);
apropos_accumulate = Qnil;
map_obarray (Vobarray, apropos_accum, regexp);
- apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
- UNGCPRO;
- return apropos_accumulate;
+ tem = Fsort (apropos_accumulate, Qstring_lessp);
+ apropos_accumulate = Qnil;
+ apropos_predicate = Qnil;
+ return tem;
}
\f
void
{
Qkeymap = intern ("keymap");
staticpro (&Qkeymap);
+ staticpro (&apropos_predicate);
+ staticpro (&apropos_accumulate);
+ apropos_predicate = Qnil;
+ apropos_accumulate = Qnil;
/* Now we are ready to set up this property, so we can
create char tables. */
Fset (intern ("ctl-x-map"), control_x_map);
Ffset (intern ("Control-X-prefix"), control_x_map);
+ exclude_keys
+ = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
+ Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
+ Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
+ Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
+ Fcons (Fcons (build_string ("SPC"), build_string (" ")),
+ Qnil)))));
+ staticpro (&exclude_keys);
+
DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
- "List of commands given new key bindings recently.\n\
-This is used for internal purposes during Emacs startup;\n\
-don't alter it yourself.");
+ doc: /* List of commands given new key bindings recently.
+This is used for internal purposes during Emacs startup;
+don't alter it yourself. */);
Vdefine_key_rebound_commands = Qt;
DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
- "Default keymap to use when reading from the minibuffer.");
+ doc: /* Default keymap to use when reading from the minibuffer. */);
Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
- "Local keymap for the minibuffer when spaces are not allowed.");
+ doc: /* Local keymap for the minibuffer when spaces are not allowed. */);
Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
+ Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
- "Local keymap for minibuffer input with completion.");
+ doc: /* Local keymap for minibuffer input with completion. */);
Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
+ Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
- "Local keymap for minibuffer input with completion, for exact match.");
+ doc: /* Local keymap for minibuffer input with completion, for exact match. */);
Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
+ Fset_keymap_parent (Vminibuffer_local_must_match_map,
+ Vminibuffer_local_completion_map);
DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
- "Alist of keymaps to use for minor modes.\n\
-Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
-key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
-If two active keymaps bind the same key, the keymap appearing earlier\n\
-in the list takes precedence.");
+ doc: /* Alist of keymaps to use for minor modes.
+Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
+key sequences and look up bindings iff VARIABLE's value is non-nil.
+If two active keymaps bind the same key, the keymap appearing earlier
+in the list takes precedence. */);
Vminor_mode_map_alist = Qnil;
DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
- "Alist of keymaps to use for minor modes, in current major mode.\n\
-This variable is a alist just like `minor-mode-map-alist', and it is\n\
-used the same way (and before `minor-mode-map-alist'); however,\n\
-it is provided for major modes to bind locally.");
+ doc: /* Alist of keymaps to use for minor modes, in current major mode.
+This variable is an alist just like `minor-mode-map-alist', and it is
+used the same way (and before `minor-mode-map-alist'); however,
+it is provided for major modes to bind locally. */);
Vminor_mode_overriding_map_alist = Qnil;
+ DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists,
+ doc: /* List of keymap alists to use for emulations modes.
+It is intended for modes or packages using multiple minor-mode keymaps.
+Each element is a keymap alist just like `minor-mode-map-alist', or a
+symbol with a variable binding which is a keymap alist, and it is used
+the same way. The "active" keymaps in each alist are used before
+`minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
+ Vemulation_mode_map_alists = Qnil;
+
+
DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
- "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
-This allows Emacs to recognize function keys sent from ASCII\n\
-terminals at any point in a key sequence.\n\
-\n\
-The `read-key-sequence' function replaces any subsequence bound by\n\
-`function-key-map' with its binding. More precisely, when the active\n\
-keymaps have no binding for the current key sequence but\n\
-`function-key-map' binds a suffix of the sequence to a vector or string,\n\
-`read-key-sequence' replaces the matching suffix with its binding, and\n\
-continues with the new sequence.\n\
-\n\
-The events that come from bindings in `function-key-map' are not\n\
-themselves looked up in `function-key-map'.\n\
-\n\
-For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\
-Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\
-`C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\
-key, typing `ESC O P x' would return [f1 x].");
+ doc: /* Keymap mapping ASCII function key sequences onto their preferred forms.
+This allows Emacs to recognize function keys sent from ASCII
+terminals at any point in a key sequence.
+
+The `read-key-sequence' function replaces any subsequence bound by
+`function-key-map' with its binding. More precisely, when the active
+keymaps have no binding for the current key sequence but
+`function-key-map' binds a suffix of the sequence to a vector or string,
+`read-key-sequence' replaces the matching suffix with its binding, and
+continues with the new sequence.
+
+The events that come from bindings in `function-key-map' are not
+themselves looked up in `function-key-map'.
+
+For example, suppose `function-key-map' binds `ESC O P' to [f1].
+Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
+`C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
+key, typing `ESC O P x' would return [f1 x]. */);
Vfunction_key_map = Fmake_sparse_keymap (Qnil);
DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
- "Keymap of key translations that can override keymaps.\n\
-This keymap works like `function-key-map', but comes after that,\n\
-and applies even for keys that have ordinary bindings.");
+ doc: /* Keymap of key translations that can override keymaps.
+This keymap works like `function-key-map', but comes after that,
+and applies even for keys that have ordinary bindings. */);
Vkey_translation_map = Qnil;
+ staticpro (&Vmouse_events);
+ Vmouse_events = Fcons (intern ("menu-bar"),
+ Fcons (intern ("tool-bar"),
+ Fcons (intern ("header-line"),
+ Fcons (intern ("mode-line"),
+ Fcons (intern ("mouse-1"),
+ Fcons (intern ("mouse-2"),
+ Fcons (intern ("mouse-3"),
+ Fcons (intern ("mouse-4"),
+ Fcons (intern ("mouse-5"),
+ Qnil)))))))));
+
+
Qsingle_key_description = intern ("single-key-description");
staticpro (&Qsingle_key_description);
Qmenu_item = intern ("menu-item");
staticpro (&Qmenu_item);
+ Qremap = intern ("remap");
+ staticpro (&Qremap);
+
+ command_remapping_vector = Fmake_vector (make_number (2), Qremap);
+ staticpro (&command_remapping_vector);
+
where_is_cache_keymaps = Qt;
where_is_cache = Qnil;
staticpro (&where_is_cache);
defsubr (&Sset_keymap_parent);
defsubr (&Smake_keymap);
defsubr (&Smake_sparse_keymap);
+ defsubr (&Smap_keymap);
defsubr (&Scopy_keymap);
+ defsubr (&Scommand_remapping);
defsubr (&Skey_binding);
defsubr (&Slocal_key_binding);
defsubr (&Sglobal_key_binding);
defsubr (&Ssingle_key_description);
defsubr (&Stext_char_description);
defsubr (&Swhere_is_internal);
- defsubr (&Sdescribe_bindings_internal);
defsubr (&Sdescribe_buffer_bindings);
defsubr (&Sapropos_internal);
}
initial_define_key (global_map, 033, "ESC-prefix");
initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
}
+
+/* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
+ (do not change this comment) */
HCoop / bpt / emacs.git / blobdiff