/* Manipulation of keymaps
- Copyright (C) 1985, 86, 87, 88, 93, 94 Free Software Foundation, Inc.
+ Copyright (C) 1985, 86,87,88,93,94,95,98 Free Software Foundation, Inc.
This file is part of GNU Emacs.
You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
#include <config.h>
#include <stdio.h>
+#ifdef STDC_HEADERS
+#include <stdlib.h>
+#endif
#undef NULL
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
+#include "charset.h"
#include "keyboard.h"
#include "termhooks.h"
#include "blockinput.h"
+#include "puresize.h"
#define min(a, b) ((a) < (b) ? (a) : (b))
/* Alist of minor mode variables and keymaps. */
Lisp_Object Vminor_mode_map_alist;
+/* Alist of major-mode-specific overrides for
+ minor mode variables and keymaps. */
+Lisp_Object Vminor_mode_overriding_map_alist;
+
/* Keymap mapping ASCII function key sequences onto their preferred forms.
Initialized by the terminal-specific lisp files. See DEFVAR for more
documentation. */
Lisp_Object Vfunction_key_map;
-Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii;
+/* Keymap mapping ASCII function key sequences onto their preferred forms. */
+Lisp_Object Vkey_translation_map;
+
+/* A list of all commands given new bindings since a certain time
+ when nil was stored here.
+ This is used to speed up recomputation of menu key equivalents
+ 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;
/* 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
extern Lisp_Object Voverriding_local_map;
-void describe_map_tree ();
static Lisp_Object define_as_prefix ();
static Lisp_Object describe_buffer_bindings ();
-static void describe_command ();
+static void describe_command (), describe_translation ();
static void describe_map ();
\f
/* Keymap object support - constructors and predicates. */
else
tail = Qnil;
return Fcons (Qkeymap,
- Fcons (Fmake_vector (make_number (DENSE_TABLE_SIZE), Qnil),
- tail));
+ Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
}
DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
{
Lisp_Object v, c;
XSETVECTOR (v, tomap);
- XFASTINT (c) = tochar;
+ XSETFASTINT (c, tochar);
frommap->contents[fromchar] = Fcons (v, c);
}
#endif /* 0 */
DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
- "Return t if ARG is a keymap.\n\
+ "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\
{
return get_keymap_1 (object, 1, 0);
}
+\f
+/* Return the parent map of the keymap MAP, or nil if it has none.
+ We assume that MAP is a valid keymap. */
+
+DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
+ "Return the parent keymap of KEYMAP.")
+ (keymap)
+ Lisp_Object keymap;
+{
+ Lisp_Object list;
+
+ keymap = get_keymap_1 (keymap, 1, 1);
+
+ /* Skip past the initial element `keymap'. */
+ list = XCONS (keymap)->cdr;
+ for (; CONSP (list); list = XCONS (list)->cdr)
+ {
+ /* See if there is another `keymap'. */
+ if (EQ (Qkeymap, XCONS (list)->car))
+ return list;
+ }
+
+ return Qnil;
+}
+
+/* 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)
+ Lisp_Object keymap, parent;
+{
+ Lisp_Object list, prev;
+ int i;
+
+ keymap = get_keymap_1 (keymap, 1, 1);
+ if (!NILP (parent))
+ parent = get_keymap_1 (parent, 1, 1);
+
+ /* Skip past the initial element `keymap'. */
+ prev = keymap;
+ while (1)
+ {
+ list = XCONS (prev)->cdr;
+ /* If there is a parent keymap here, replace it.
+ If we came to the end, add the parent in PREV. */
+ if (! CONSP (list) || EQ (Qkeymap, XCONS (list)->car))
+ {
+ /* If we already have the right parent, return now
+ so that we avoid the loops below. */
+ if (EQ (XCONS (prev)->cdr, parent))
+ return parent;
+
+ XCONS (prev)->cdr = parent;
+ break;
+ }
+ prev = list;
+ }
+
+ /* Scan through for submaps, and set their parents too. */
+
+ for (list = XCONS (keymap)->cdr; CONSP (list); list = XCONS (list)->cdr)
+ {
+ /* Stop the scan when we come to the parent. */
+ if (EQ (XCONS (list)->car, Qkeymap))
+ break;
+
+ /* If this element holds a prefix map, deal with it. */
+ if (CONSP (XCONS (list)->car)
+ && CONSP (XCONS (XCONS (list)->car)->cdr))
+ fix_submap_inheritance (keymap, XCONS (XCONS (list)->car)->car,
+ XCONS (XCONS (list)->car)->cdr);
+
+ if (VECTORP (XCONS (list)->car))
+ for (i = 0; i < XVECTOR (XCONS (list)->car)->size; i++)
+ if (CONSP (XVECTOR (XCONS (list)->car)->contents[i]))
+ fix_submap_inheritance (keymap, make_number (i),
+ XVECTOR (XCONS (list)->car)->contents[i]);
+
+ if (CHAR_TABLE_P (XCONS (list)->car))
+ {
+ Lisp_Object indices[3];
+
+ map_char_table (fix_submap_inheritance, Qnil, XCONS (list)->car,
+ keymap, 0, indices);
+ }
+ }
+
+ return parent;
+}
+
+/* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
+ if EVENT is also a prefix in MAP's parent,
+ make sure that SUBMAP inherits that definition as its own parent. */
+
+void
+fix_submap_inheritance (map, event, submap)
+ Lisp_Object map, event, submap;
+{
+ Lisp_Object map_parent, parent_entry;
+
+ /* SUBMAP is a cons that we found as a key binding.
+ Discard the other things found in a menu key binding. */
+
+ if (CONSP (submap))
+ {
+ /* May be an old format menu item */
+ if (STRINGP (XCONS (submap)->car))
+ {
+ submap = XCONS (submap)->cdr;
+ /* Also remove a menu help string, if any,
+ following the menu item name. */
+ if (CONSP (submap) && STRINGP (XCONS (submap)->car))
+ submap = XCONS (submap)->cdr;
+ /* Also remove the sublist that caches key equivalences, if any. */
+ if (CONSP (submap)
+ && CONSP (XCONS (submap)->car))
+ {
+ Lisp_Object carcar;
+ carcar = XCONS (XCONS (submap)->car)->car;
+ if (NILP (carcar) || VECTORP (carcar))
+ submap = XCONS (submap)->cdr;
+ }
+ }
+ /* Or a new format menu item */
+ else if (EQ (XCONS (submap)->car, Qmenu_item)
+ && CONSP (XCONS (submap)->cdr))
+ {
+ submap = XCONS (XCONS (submap)->cdr)->cdr;
+ if (CONSP (submap))
+ submap = XCONS (submap)->car;
+ }
+ }
+
+ /* If it isn't a keymap now, there's no work to do. */
+ if (! CONSP (submap)
+ || ! EQ (XCONS (submap)->car, Qkeymap))
+ return;
+ map_parent = Fkeymap_parent (map);
+ if (! NILP (map_parent))
+ parent_entry = access_keymap (map_parent, event, 0, 0);
+ else
+ parent_entry = Qnil;
+
+ /* If MAP's parent has something other than a keymap,
+ our own submap shadows it completely, so use nil as SUBMAP's parent. */
+ if (! (CONSP (parent_entry) && EQ (XCONS (parent_entry)->car, Qkeymap)))
+ parent_entry = Qnil;
+
+ if (! EQ (parent_entry, submap))
+ Fset_keymap_parent (submap, parent_entry);
+}
+\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.
else if (INTEGERP (idx))
/* Clobber the high bits that can be present on a machine
with more than 24 bits of integer. */
- XFASTINT (idx) = XINT (idx) & (CHAR_META | (CHAR_META - 1));
+ XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
{
Lisp_Object tail;
Lisp_Object binding;
binding = XCONS (tail)->car;
- switch (XTYPE (binding))
+ if (SYMBOLP (binding))
{
- case Lisp_Symbol:
/* If NOINHERIT, stop finding prefix definitions
after we pass a second occurrence of the `keymap' symbol. */
if (noinherit && EQ (binding, Qkeymap) && ! EQ (tail, map))
noprefix = 1;
- break;
-
- case Lisp_Cons:
+ }
+ else if (CONSP (binding))
+ {
if (EQ (XCONS (binding)->car, idx))
{
val = XCONS (binding)->cdr;
if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap))
return Qnil;
+ if (CONSP (val))
+ fix_submap_inheritance (map, idx, val);
return val;
}
if (t_ok && EQ (XCONS (binding)->car, Qt))
t_binding = XCONS (binding)->cdr;
- break;
-
- case Lisp_Vector:
- if (INTEGERP (idx)
- && XINT (idx) >= 0
- && XINT (idx) < XVECTOR (binding)->size)
+ }
+ else if (VECTORP (binding))
+ {
+ if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (binding)->size)
{
- val = XVECTOR (binding)->contents[XINT (idx)];
+ val = XVECTOR (binding)->contents[XFASTINT (idx)];
if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap))
return Qnil;
+ if (CONSP (val))
+ fix_submap_inheritance (map, idx, val);
+ return val;
+ }
+ }
+ 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_ALT | CHAR_SUPER | CHAR_HYPER
+ | CHAR_SHIFT | CHAR_CTL | CHAR_META)))
+ {
+ val = Faref (binding, idx);
+ if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap))
+ return Qnil;
+ if (CONSP (val))
+ fix_submap_inheritance (map, idx, val);
return val;
}
- break;
}
QUIT;
map = get_keymap_1 (Fcar_safe (object), 0, autoload);
tem = Fkeymapp (map);
if (!NILP (tem))
- object = access_keymap (map, Fcdr (object), 0, 0);
-
+ {
+ Lisp_Object key;
+ key = Fcdr (object);
+ if (INTEGERP (key) && (XINT (key) & meta_modifier))
+ {
+ object = access_keymap (map, meta_prefix_char, 0, 0);
+ map = get_keymap_1 (object, 0, autoload);
+ object = access_keymap (map,
+ make_number (XINT (key) & ~meta_modifier),
+ 0, 0);
+ }
+ else
+ object = access_keymap (map, key, 0, 0);
+ }
+
+ else if (!(CONSP (object)))
+ /* This is really the value. */
+ return object;
+
/* If the keymap contents looks like (STRING . DEFN),
use DEFN.
Keymap alist elements like (CHAR MENUSTRING . DEFN)
will be used by HierarKey menus. */
- else if (CONSP (object)
- && STRINGP (XCONS (object)->car))
+ else if (STRINGP (XCONS (object)->car))
{
object = XCONS (object)->cdr;
/* Also remove a menu help string, if any,
}
}
+ /* If the keymap contents looks like (menu-item name . DEFN)
+ or (menu-item name DEFN ...) then use DEFN.
+ This is a new format menu item.
+ */
+ else if (EQ (XCONS (object)->car, Qmenu_item)
+ && CONSP (XCONS (object)->cdr))
+ {
+ object = XCONS (XCONS (object)->cdr)->cdr;
+ if (CONSP (object))
+ object = XCONS (object)->car;
+ }
+
else
/* Anything else is really the value. */
return object;
register Lisp_Object idx;
register Lisp_Object def;
{
+ /* If we are preparing to dump, and DEF is a menu element
+ with a menu item indicator, copy it to ensure it is not pure. */
+ if (CONSP (def) && PURE_P (def)
+ && (EQ (XCONS (def)->car, Qmenu_item) || STRINGP (XCONS (def)->car)))
+ def = Fcons (XCONS (def)->car, XCONS (def)->cdr);
+
if (!CONSP (keymap) || ! EQ (XCONS (keymap)->car, Qkeymap))
error ("attempt to define a key in a non-keymap");
else if (INTEGERP (idx))
/* Clobber the high bits that can be present on a machine
with more than 24 bits of integer. */
- XFASTINT (idx) = XINT (idx) & (CHAR_META | (CHAR_META - 1));
+ XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
/* Scan the keymap for a binding of idx. */
{
Lisp_Object elt;
elt = XCONS (tail)->car;
- switch (XTYPE (elt))
+ if (VECTORP (elt))
{
- case Lisp_Vector:
- if (INTEGERP (idx)
- && XINT (idx) >= 0 && XINT (idx) < XVECTOR (elt)->size)
+ if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (elt)->size)
{
XVECTOR (elt)->contents[XFASTINT (idx)] = def;
return def;
}
insertion_point = tail;
- break;
-
- case Lisp_Cons:
+ }
+ 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)))
+ {
+ Faset (elt, idx, def);
+ return def;
+ }
+ insertion_point = tail;
+ }
+ else if (CONSP (elt))
+ {
if (EQ (idx, XCONS (elt)->car))
{
XCONS (elt)->cdr = def;
return def;
}
- break;
-
- case Lisp_Symbol:
+ }
+ else if (SYMBOLP (elt))
+ {
/* If we find a 'keymap' symbol in the spine of KEYMAP,
then we must have found the start of a second keymap
being used as the tail of KEYMAP, and a binding for IDX
should be inserted before it. */
if (EQ (elt, Qkeymap))
goto keymap_end;
- break;
}
QUIT;
keymap_end:
/* We have scanned the entire keymap, and not found a binding for
IDX. Let's add one. */
- XCONS (insertion_point)->cdr =
- Fcons (Fcons (idx, def), XCONS (insertion_point)->cdr);
+ XCONS (insertion_point)->cdr
+ = Fcons (Fcons (idx, def), XCONS (insertion_point)->cdr);
}
return def;
}
+void
+copy_keymap_1 (chartable, idx, elt)
+ Lisp_Object chartable, idx, elt;
+{
+ if (!SYMBOLP (elt) && ! NILP (Fkeymapp (elt)))
+ Faset (chartable, idx, Fcopy_keymap (elt));
+}
DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
"Return a copy of the keymap KEYMAP.\n\
Lisp_Object elt;
elt = XCONS (tail)->car;
- if (VECTORP (elt))
+ if (CHAR_TABLE_P (elt))
+ {
+ Lisp_Object indices[3];
+
+ elt = Fcopy_sequence (elt);
+ XCONS (tail)->car = elt;
+
+ map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices);
+ }
+ else if (VECTORP (elt))
{
int i;
for (i = 0; i < XVECTOR (elt)->size; i++)
if (!SYMBOLP (XVECTOR (elt)->contents[i])
&& ! NILP (Fkeymapp (XVECTOR (elt)->contents[i])))
- XVECTOR (elt)->contents[i] =
- Fcopy_keymap (XVECTOR (elt)->contents[i]);
+ XVECTOR (elt)->contents[i]
+ = Fcopy_keymap (XVECTOR (elt)->contents[i]);
}
- else if (CONSP (elt))
+ else if (CONSP (elt) && CONSP (XCONS (elt)->cdr))
{
- /* Skip the optional menu string. */
- if (CONSP (XCONS (elt)->cdr)
- && STRINGP (XCONS (XCONS (elt)->cdr)->car))
- {
- Lisp_Object tem;
+ Lisp_Object tem;
+ tem = XCONS (elt)->cdr;
- /* Copy the cell, since copy-alist didn't go this deep. */
- XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car,
- XCONS (XCONS (elt)->cdr)->cdr);
+ /* Is this a new format menu item. */
+ if (EQ (XCONS (tem)->car,Qmenu_item))
+ {
+ /* Copy cell with menu-item marker. */
+ XCONS (elt)->cdr
+ = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
elt = XCONS (elt)->cdr;
-
- /* Also skip the optional menu help string. */
- if (CONSP (XCONS (elt)->cdr)
- && STRINGP (XCONS (XCONS (elt)->cdr)->car))
+ tem = XCONS (elt)->cdr;
+ if (CONSP (tem))
+ {
+ /* Copy cell with menu-item name. */
+ XCONS (elt)->cdr
+ = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
+ elt = XCONS (elt)->cdr;
+ tem = XCONS (elt)->cdr;
+ };
+ if (CONSP (tem))
{
- XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car,
- XCONS (XCONS (elt)->cdr)->cdr);
+ /* Copy cell with binding and if the binding is a keymap,
+ copy that. */
+ XCONS (elt)->cdr
+ = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
elt = XCONS (elt)->cdr;
+ tem = XCONS (elt)->car;
+ if (!(SYMBOLP (tem) || NILP (Fkeymapp (tem))))
+ XCONS (elt)->car = Fcopy_keymap (tem);
+ tem = XCONS (elt)->cdr;
+ if (CONSP (tem) && CONSP (XCONS (tem)->car))
+ /* Delete cache for key equivalences. */
+ XCONS (elt)->cdr = XCONS (tem)->cdr;
}
- /* There may also be a list that caches key equivalences.
- Just delete it for the new keymap. */
- if (CONSP (XCONS (elt)->cdr)
- && CONSP (XCONS (XCONS (elt)->cdr)->car)
- && (NILP (tem = XCONS (XCONS (XCONS (elt)->cdr)->car)->car)
- || VECTORP (tem)))
- XCONS (elt)->cdr = XCONS (XCONS (elt)->cdr)->cdr;
}
- if (CONSP (elt)
- && ! SYMBOLP (XCONS (elt)->cdr)
- && ! NILP (Fkeymapp (XCONS (elt)->cdr)))
- XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr);
+ else
+ {
+ /* It may be an old fomat menu item.
+ Skip the optional menu string.
+ */
+ if (STRINGP (XCONS (tem)->car))
+ {
+ /* Copy the cell, since copy-alist didn't go this deep. */
+ XCONS (elt)->cdr
+ = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
+ elt = XCONS (elt)->cdr;
+ tem = XCONS (elt)->cdr;
+ /* Also skip the optional menu help string. */
+ if (CONSP (tem) && STRINGP (XCONS (tem)->car))
+ {
+ XCONS (elt)->cdr
+ = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
+ elt = XCONS (elt)->cdr;
+ tem = XCONS (elt)->cdr;
+ }
+ /* There may also be a list that caches key equivalences.
+ Just delete it for the new keymap. */
+ if (CONSP (tem)
+ && CONSP (XCONS (tem)->car)
+ && (NILP (XCONS (XCONS (tem)->car)->car)
+ || VECTORP (XCONS (XCONS (tem)->car)->car)))
+ XCONS (elt)->cdr = XCONS (tem)->cdr;
+ }
+ if (CONSP (elt)
+ && ! SYMBOLP (XCONS (elt)->cdr)
+ && ! NILP (Fkeymapp (XCONS (elt)->cdr)))
+ XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr);
+ }
+
}
}
-
+
return copy;
}
\f
if (length == 0)
return 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))
{
c = Faref (key, make_number (idx));
+ if (CONSP (c) && lucid_event_type_list_p (c))
+ c = Fevent_convert_list (c);
+
if (INTEGERP (c)
&& (XINT (c) & meta_bit)
&& !metized)
\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\
-useable as a general function for probing keymaps. However, if the\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)
{
c = Faref (key, make_number (idx));
+ if (CONSP (c) && lucid_event_type_list_p (c))
+ c = Fevent_convert_list (c);
+
if (INTEGERP (c)
&& (XINT (c) & meta_bit)
&& !metized)
make it a prefix in this map, and make its definition
inherit the other prefix definition. */
inherit = access_keymap (keymap, c, 0, 0);
+#if 0
+ /* This code is needed to do the right thing in the following case:
+ keymap A inherits from B,
+ you define KEY as a prefix in A,
+ then later you define KEY as a prefix in B.
+ We want the old prefix definition in A to inherit from that in B.
+ It is hard to do that retroactively, so this code
+ creates the prefix in B right away.
+
+ But it turns out that this code causes problems immediately
+ when the prefix in A is defined: it causes B to define KEY
+ as a prefix with no subcommands.
+
+ So I took out this code. */
if (NILP (inherit))
{
/* If there's an inherited keymap
if (!NILP (tail))
inherit = define_as_prefix (tail, c);
}
+#endif
cmd = nconc2 (cmd, inherit);
store_in_keymap (keymap, c, cmd);
static Lisp_Object *cmm_modes, *cmm_maps;
static int cmm_size;
+/* Error handler used in current_minor_maps. */
+static Lisp_Object
+current_minor_maps_error ()
+{
+ return Qnil;
+}
+
/* Store a pointer to an array of the keymaps of the currently active
minor modes in *buf, and return the number of maps it contains.
Lisp_Object **modeptr, **mapptr;
{
int i = 0;
+ int list_number = 0;
Lisp_Object alist, assoc, var, val;
+ Lisp_Object lists[2];
+
+ 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 = XCONS (alist)->cdr)
+ if ((assoc = XCONS (alist)->car, CONSP (assoc))
+ && (var = XCONS (assoc)->car, SYMBOLP (var))
+ && (val = find_symbol_value (var), ! EQ (val, Qunbound))
+ && ! NILP (val))
+ {
+ Lisp_Object temp;
- for (alist = Vminor_mode_map_alist;
- CONSP (alist);
- alist = XCONS (alist)->cdr)
- if (CONSP (assoc = XCONS (alist)->car)
- && SYMBOLP (var = XCONS (assoc)->car)
- && ! EQ ((val = find_symbol_value (var)), Qunbound)
- && ! NILP (val))
- {
- 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))
+ break;
+ }
- if (cmm_maps)
- {
- BLOCK_INPUT;
- cmm_size *= 2;
- newmodes
- = (Lisp_Object *) realloc (cmm_modes,
- cmm_size * sizeof (Lisp_Object));
- newmaps
- = (Lisp_Object *) realloc (cmm_maps,
- cmm_size * sizeof (Lisp_Object));
- UNBLOCK_INPUT;
- }
- else
- {
- BLOCK_INPUT;
- cmm_size = 30;
- newmodes
- = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
- newmaps
- = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
- UNBLOCK_INPUT;
- }
+ if (i >= cmm_size)
+ {
+ Lisp_Object *newmodes, *newmaps;
- if (newmaps && newmodes)
- {
- cmm_modes = newmodes;
- cmm_maps = newmaps;
- }
- else
- break;
- }
- cmm_modes[i] = var;
- cmm_maps [i] = Findirect_function (XCONS (assoc)->cdr);
- i++;
- }
+ if (cmm_maps)
+ {
+ BLOCK_INPUT;
+ cmm_size *= 2;
+ newmodes
+ = (Lisp_Object *) realloc (cmm_modes,
+ cmm_size * sizeof (Lisp_Object));
+ newmaps
+ = (Lisp_Object *) realloc (cmm_maps,
+ cmm_size * sizeof (Lisp_Object));
+ UNBLOCK_INPUT;
+ }
+ else
+ {
+ BLOCK_INPUT;
+ cmm_size = 30;
+ newmodes
+ = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
+ newmaps
+ = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
+ UNBLOCK_INPUT;
+ }
+
+ if (newmaps && newmodes)
+ {
+ cmm_modes = newmodes;
+ cmm_maps = newmaps;
+ }
+ else
+ break;
+ }
+
+ /* Get the keymap definition--or nil if it is not defined. */
+ temp = internal_condition_case_1 (Findirect_function,
+ XCONS (assoc)->cdr,
+ 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;
GCPRO1 (key);
- if (!NILP (Voverriding_local_map))
+ if (!NILP (current_kboard->Voverriding_terminal_local_map))
+ {
+ value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
+ key, accept_default);
+ if (! NILP (value) && !INTEGERP (value))
+ RETURN_UNGCPRO (value);
+ }
+ else if (!NILP (Voverriding_local_map))
{
value = Flookup_key (Voverriding_local_map, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
}
else
{
+ Lisp_Object local;
+
nmaps = current_minor_maps (0, &maps);
/* Note that all these maps are GCPRO'd
in the places where we found them. */
RETURN_UNGCPRO (value);
}
- if (! NILP (current_buffer->keymap))
+ local = get_local_map (PT, current_buffer);
+
+ if (! NILP (local))
{
- value = Flookup_key (current_buffer->keymap, key, accept_default);
+ value = Flookup_key (local, key, accept_default);
if (! NILP (value) && !INTEGERP (value))
RETURN_UNGCPRO (value);
}
return Flist (j, maps);
}
-DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2,
- "kSet key globally: \nCSet key %s to command: ",
- "Give KEY a global binding as COMMAND.\n\
-COMMAND is a symbol naming an interactively-callable function.\n\
-KEY is a key sequence (a string or vector of characters or event types).\n\
-Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
-can be included if you use a vector.\n\
-Note that if KEY has a local binding in the current buffer\n\
-that local binding will continue to shadow any global binding.")
- (keys, function)
- Lisp_Object keys, function;
-{
- if (!VECTORP (keys) && !STRINGP (keys))
- keys = wrong_type_argument (Qarrayp, keys);
-
- Fdefine_key (current_global_map, keys, function);
- return Qnil;
-}
-
-DEFUN ("local-set-key", Flocal_set_key, Slocal_set_key, 2, 2,
- "kSet key locally: \nCSet key %s locally to command: ",
- "Give KEY a local binding as COMMAND.\n\
-COMMAND is a symbol naming an interactively-callable function.\n\
-KEY is a key sequence (a string or vector of characters or event types).\n\
-Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
-can be included if you use a vector.\n\
-The binding goes in the current buffer's local map,\n\
-which in most cases is shared with all other buffers in the same major mode.")
- (keys, function)
- Lisp_Object keys, function;
-{
- register Lisp_Object map;
- map = current_buffer->keymap;
- if (NILP (map))
- {
- map = Fmake_sparse_keymap (Qnil);
- current_buffer->keymap = map;
- }
-
- if (!VECTORP (keys) && !STRINGP (keys))
- keys = wrong_type_argument (Qarrayp, keys);
-
- Fdefine_key (map, keys, function);
- return Qnil;
-}
-
-DEFUN ("global-unset-key", Fglobal_unset_key, Sglobal_unset_key,
- 1, 1, "kUnset key globally: ",
- "Remove global binding of KEY.\n\
-KEY is a string representing a sequence of keystrokes.")
- (keys)
- Lisp_Object keys;
-{
- return Fglobal_set_key (keys, Qnil);
-}
-
-DEFUN ("local-unset-key", Flocal_unset_key, Slocal_unset_key, 1, 1,
- "kUnset key locally: ",
- "Remove local binding of KEY.\n\
-KEY is a string representing a sequence of keystrokes.")
- (keys)
- Lisp_Object keys;
-{
- if (!NILP (current_buffer->keymap))
- Flocal_set_key (keys, Qnil);
- return Qnil;
-}
-
DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 2, 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.")
- (name, mapvar)
- Lisp_Object name, mapvar;
+ (command, mapvar)
+ Lisp_Object command, mapvar;
{
Lisp_Object map;
map = Fmake_sparse_keymap (Qnil);
- Ffset (name, map);
+ Ffset (command, map);
if (!NILP (mapvar))
Fset (mapvar, map);
else
- Fset (name, map);
- return name;
+ Fset (command, map);
+ return command;
}
DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
{
keymap = get_keymap (keymap);
current_global_map = keymap;
- record_asynch_buffer_change ();
return Qnil;
}
keymap = get_keymap (keymap);
current_buffer->keymap = keymap;
- record_asynch_buffer_change ();
return Qnil;
}
\f
/* Help functions for describing and documenting keymaps. */
+static void accessible_keymaps_char_table ();
+
/* This function cannot GC. */
DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
"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\
+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.")
- (startmap, prefix)
- Lisp_Object startmap, prefix;
+ (keymap, prefix)
+ Lisp_Object keymap, prefix;
{
Lisp_Object maps, good_maps, tail;
int prefixlen = 0;
/* If a prefix was specified, start with the keymap (if any) for
that prefix, so we don't waste time considering other prefixes. */
Lisp_Object tem;
- tem = Flookup_key (startmap, prefix, Qt);
+ tem = Flookup_key (keymap, prefix, Qt);
/* Flookup_key may give us nil, or a number,
if the prefix is not defined in this particular map.
It might even give us a list that isn't a keymap. */
tem = get_keymap_1 (tem, 0, 0);
if (!NILP (tem))
- maps = Fcons (Fcons (prefix, tem), Qnil);
+ {
+ /* Convert PREFIX to a vector now, so that later on
+ we don't have to deal with the possibility of a string. */
+ if (STRINGP (prefix))
+ {
+ int i, i_byte, c;
+ Lisp_Object copy;
+
+ copy = Fmake_vector (make_number (XSTRING (prefix)->size), Qnil);
+ for (i = 0, i_byte; i < XSTRING (prefix)->size;)
+ {
+ int i_before = i;
+ if (STRING_MULTIBYTE (prefix))
+ FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
+ else
+ c = XSTRING (prefix)->data[i++];
+ if (c & 0200)
+ c ^= 0200 | meta_modifier;
+ XVECTOR (copy)->contents[i_before] = make_number (c);
+ }
+ prefix = copy;
+ }
+ maps = Fcons (Fcons (prefix, tem), Qnil);
+ }
else
return Qnil;
}
else
maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
- get_keymap (startmap)),
+ get_keymap (keymap)),
Qnil);
/* For each map in the list maps,
thismap = Fcdr (Fcar (tail));
last = make_number (XINT (Flength (thisseq)) - 1);
is_metized = (XINT (last) >= 0
+ /* Don't metize the last char of PREFIX. */
+ && XINT (last) >= prefixlen
&& EQ (Faref (thisseq, last), meta_prefix_char));
for (; CONSP (thismap); thismap = XCONS (thismap)->cdr)
QUIT;
- if (VECTORP (elt))
+ if (CHAR_TABLE_P (elt))
+ {
+ Lisp_Object indices[3];
+
+ map_char_table (accessible_keymaps_char_table, Qnil,
+ elt, Fcons (maps, Fcons (tail, thisseq)),
+ 0, indices);
+ }
+ else if (VECTORP (elt))
{
register int i;
}
}
}
- }
+ }
else if (CONSP (elt))
{
register Lisp_Object cmd, tem, filter;
turn it into a meta-ized keystroke. */
if (is_metized && INTEGERP (elt))
{
- tem = Fcopy_sequence (thisseq);
- Faset (tem, last,
- make_number (XINT (elt) | meta_modifier));
+ Lisp_Object element;
+
+ element = thisseq;
+ tem = Fvconcat (1, &element);
+ XSETFASTINT (XVECTOR (tem)->contents[XINT (last)],
+ XINT (elt) | meta_modifier);
/* This new sequence is the same length as
thisseq, so stick it in the list right
for (i = 0; i < prefixlen; i++)
{
Lisp_Object i1;
- XFASTINT (i1) = i;
+ XSETFASTINT (i1, i);
if (!EQ (Faref (thisseq, i1), Faref (prefix, i1)))
break;
}
return Fnreverse (good_maps);
}
+static void
+accessible_keymaps_char_table (args, index, cmd)
+ Lisp_Object args, index, cmd;
+{
+ Lisp_Object tem;
+ Lisp_Object maps, tail, thisseq;
+
+ if (NILP (cmd))
+ return;
+
+ maps = XCONS (args)->car;
+ tail = XCONS (XCONS (args)->cdr)->car;
+ thisseq = XCONS (XCONS (args)->cdr)->cdr;
+
+ tem = Fkeymapp (cmd);
+ if (!NILP (tem))
+ {
+ cmd = get_keymap (cmd);
+ /* Ignore keymaps that are already added to maps. */
+ tem = Frassq (cmd, maps);
+ if (NILP (tem))
+ {
+ tem = append_key (thisseq, index);
+ nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
+ }
+ }
+}
+\f
Lisp_Object Qsingle_key_description, Qkey_description;
/* This function cannot GC. */
Lisp_Object keys;
{
int len;
- int i;
+ int i, i_byte;
Lisp_Object sep;
Lisp_Object *args;
{
Lisp_Object vector;
vector = Fmake_vector (Flength (keys), Qnil);
- for (i = 0; i < XSTRING (keys)->size; i++)
+ for (i = 0; i < XSTRING (keys)->size; )
{
- if (XSTRING (keys)->data[i] & 0x80)
- XFASTINT (XVECTOR (vector)->contents[i])
- = meta_modifier | (XSTRING (keys)->data[i] & ~0x80);
+ int c;
+ int i_before = i;
+
+ if (STRING_MULTIBYTE (keys))
+ FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte);
else
- XFASTINT (XVECTOR (vector)->contents[i])
- = XSTRING (keys)->data[i];
+ c = XSTRING (keys)->data[i++];
+
+ if (c & 0x80)
+ XSETFASTINT (XVECTOR (vector)->contents[i_before],
+ meta_modifier | (c & ~0x80));
+ else
+ XSETFASTINT (XVECTOR (vector)->contents[i_before], c);
}
keys = vector;
}
*p++ = 'A';
*p++ = 'B';
}
- else if (c == Ctl('J'))
- {
- *p++ = 'L';
- *p++ = 'F';
- *p++ = 'D';
- }
- else if (c == Ctl('M'))
+ else if (c == Ctl ('M'))
{
*p++ = 'R';
*p++ = 'E';
*p++ = 'P';
*p++ = 'C';
}
- else if (c < 256)
+ else if (c < 128)
*p++ = c;
+ else if (c < 512)
+ {
+ *p++ = '\\';
+ *p++ = (7 & (c >> 6)) + '0';
+ *p++ = (7 & (c >> 3)) + '0';
+ *p++ = (7 & (c >> 0)) + '0';
+ }
else
{
*p++ = '\\';
key = EVENT_HEAD (key);
- switch (XTYPE (key))
+ if (INTEGERP (key)) /* Normal character */
{
- case Lisp_Int: /* Normal character */
*push_key_description (XUINT (key), tem) = 0;
return build_string (tem);
-
- case Lisp_Symbol: /* Function key or event-symbol */
- return Fsymbol_name (key);
-
- /* Buffer names in the menubar can trigger this. */
- case Lisp_String:
- return Fcopy_sequence (key);
-
- default:
- error ("KEY must be an integer, cons, symbol, or string");
}
+ else if (SYMBOLP (key)) /* Function key or event-symbol */
+ return Fsymbol_name (key);
+ else if (STRINGP (key)) /* Buffer names in the menubar. */
+ return Fcopy_sequence (key);
+ else
+ error ("KEY must be an integer, cons, symbol, or string");
}
char *
/* This function cannot GC. */
DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
- "Return a pretty description of file-character CHAR.\n\
+ "Return a pretty description of file-character CHARACTER.\n\
Control characters turn into \"^char\", etc.")
- (chr)
- Lisp_Object chr;
+ (character)
+ Lisp_Object character;
{
char tem[6];
- CHECK_NUMBER (chr, 0);
+ CHECK_NUMBER (character, 0);
+
+ if (!SINGLE_BYTE_CHAR_P (XFASTINT (character)))
+ {
+ unsigned char *str;
+ int len = non_ascii_char_to_string (XFASTINT (character), tem, &str);
+
+ return make_multibyte_string (str, 1, len);
+ }
- *push_text_char_description (XINT (chr) & 0377, tem) = 0;
+ *push_text_char_description (XINT (character) & 0377, tem) = 0;
return build_string (tem);
}
ascii_sequence_p (seq)
Lisp_Object seq;
{
- Lisp_Object i;
+ int i;
int len = XINT (Flength (seq));
- for (XFASTINT (i) = 0; XFASTINT (i) < len; XFASTINT (i)++)
+ for (i = 0; i < len; i++)
{
- Lisp_Object elt;
+ Lisp_Object ii, elt;
- elt = Faref (seq, i);
+ XSETFASTINT (ii, i);
+ elt = Faref (seq, ii);
if (!INTEGERP (elt)
|| (XUINT (elt) & ~CHAR_META) >= 0x80)
\f
/* where-is - finding a command in a set of keymaps. */
+static Lisp_Object where_is_internal_1 ();
+static void where_is_internal_2 ();
+
/* This function can GC if Flookup_key autoloads any keymaps. */
DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
\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 t, avoid key sequences which use non-ASCII\n\
-keys and therefore may not be usable on ASCII terminals. If FIRSTONLY\n\
-is the symbol `non-ascii', return the first binding found, no matter\n\
-what its components.\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\
Lisp_Object firstonly, noindirect;
{
Lisp_Object maps;
- Lisp_Object found, sequence;
+ Lisp_Object found, sequences;
+ Lisp_Object keymap1;
int keymap_specified = !NILP (keymap);
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-
+ /* 1 means ignore all menu bindings entirely. */
+ int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
+
+ /* Find keymaps accessible from `keymap' or the current
+ context. But don't muck with the value of `keymap',
+ because `where_is_internal_1' uses it to check for
+ shadowed bindings. */
+ keymap1 = keymap;
if (! keymap_specified)
{
#ifdef USE_TEXT_PROPERTIES
- keymap = get_local_map (PT, current_buffer);
+ keymap1 = get_local_map (PT, current_buffer);
#else
- keymap = current_buffer->keymap;
+ keymap1 = current_buffer->keymap;
#endif
}
-
- if (!NILP (keymap))
- maps = nconc2 (Faccessible_keymaps (get_keymap (keymap), Qnil),
+
+ if (!NILP (keymap1))
+ maps = nconc2 (Faccessible_keymaps (get_keymap (keymap1), Qnil),
Faccessible_keymaps (get_keymap (current_global_map),
Qnil));
else
}
}
- GCPRO5 (definition, keymap, maps, found, sequence);
+ GCPRO5 (definition, keymap, maps, found, sequences);
found = Qnil;
- sequence = 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;
- /* If Fcar (map) is a VECTOR, the current element within that vector. */
- int i = 0;
-
/* In order to fold [META-PREFIX-CHAR CHAR] sequences into
[M-CHAR] sequences, check if last character of the sequence
is the meta-prefix char. */
For this reason, if Fcar (map) is a vector, we don't
advance map to the next element until i indicates that we
have finished off the vector. */
-
Lisp_Object elt, key, binding;
elt = XCONS (map)->car;
+ map = XCONS (map)->cdr;
+
+ sequences = Qnil;
QUIT;
advance map and i to the next binding. */
if (VECTORP (elt))
{
+ Lisp_Object sequence;
+ int i;
/* In a vector, look at each element. */
- binding = XVECTOR (elt)->contents[i];
- XFASTINT (key) = i;
- i++;
-
- /* If we've just finished scanning a vector, advance map
- to the next element, and reset i in anticipation of the
- next vector we may find. */
- if (i >= XVECTOR (elt)->size)
+ for (i = 0; i < XVECTOR (elt)->size; i++)
{
- map = XCONS (map)->cdr;
- i = 0;
+ binding = XVECTOR (elt)->contents[i];
+ XSETFASTINT (key, i);
+ sequence = where_is_internal_1 (binding, key, definition,
+ noindirect, keymap, this,
+ last, nomenus, last_is_meta);
+ if (!NILP (sequence))
+ sequences = Fcons (sequence, sequences);
}
}
- else if (CONSP (elt))
+ else if (CHAR_TABLE_P (elt))
{
- key = Fcar (Fcar (map));
- binding = Fcdr (Fcar (map));
-
- map = XCONS (map)->cdr;
+ Lisp_Object indices[3];
+ Lisp_Object args;
+
+ args = Fcons (Fcons (Fcons (definition, noindirect),
+ Fcons (keymap, Qnil)),
+ 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);
+ sequences = XCONS (XCONS (XCONS (args)->car)->cdr)->cdr;
}
- else
- /* We want to ignore keymap elements that are neither
- vectors nor conses. */
+ else if (CONSP (elt))
{
- map = XCONS (map)->cdr;
- continue;
- }
-
- /* Search through indirections unless that's not wanted. */
- if (NILP (noindirect))
- binding = get_keyelt (binding, 0);
-
- /* End this iteration if this element does not match
- the target. */
+ Lisp_Object sequence;
- if (CONSP (definition))
- {
- Lisp_Object tem;
- tem = Fequal (binding, definition);
- if (NILP (tem))
- continue;
- }
- else
- if (!EQ (binding, definition))
- continue;
+ key = XCONS (elt)->car;
+ binding = XCONS (elt)->cdr;
- /* We have found a match.
- Construct the key sequence where we found it. */
- if (INTEGERP (key) && last_is_meta)
- {
- sequence = Fcopy_sequence (this);
- Faset (sequence, last, make_number (XINT (key) | meta_modifier));
+ sequence = where_is_internal_1 (binding, key, definition,
+ noindirect, keymap, this,
+ last, nomenus, last_is_meta);
+ if (!NILP (sequence))
+ sequences = Fcons (sequence, sequences);
}
- else
- sequence = append_key (this, key);
-
- /* Verify that this key binding is not shadowed by another
- binding for the same key, before we say it exists.
- Mechanism: look for local definition of this key and if
- it is defined and does not match what we found then
- ignore this key.
- Either nil or number as value from Flookup_key
- means undefined. */
- if (keymap_specified)
- {
- binding = Flookup_key (keymap, sequence, Qnil);
- if (!NILP (binding) && !INTEGERP (binding))
- {
- if (CONSP (definition))
- {
- Lisp_Object tem;
- tem = Fequal (binding, definition);
- if (NILP (tem))
- continue;
- }
- else
- if (!EQ (binding, definition))
- continue;
- }
- }
- else
+ for (; ! NILP (sequences); sequences = XCONS (sequences)->cdr)
{
- binding = Fkey_binding (sequence, Qnil);
- if (!EQ (binding, definition))
- continue;
+ Lisp_Object sequence;
+
+ sequence = XCONS (sequences)->car;
+
+ /* It is a true unshadowed match. Record it, unless it's already
+ been seen (as could happen when inheriting keymaps). */
+ if (NILP (Fmember (sequence, found)))
+ found = Fcons (sequence, found);
+
+ /* If firstonly is Qnon_ascii, then we can return the first
+ binding we find. If firstonly is not Qnon_ascii but not
+ nil, then we should return the first ascii-only binding
+ we find. */
+ if (EQ (firstonly, Qnon_ascii))
+ RETURN_UNGCPRO (sequence);
+ else if (! NILP (firstonly) && ascii_sequence_p (sequence))
+ RETURN_UNGCPRO (sequence);
}
-
- /* It is a true unshadowed match. Record it, unless it's already
- been seen (as could happen when inheriting keymaps). */
- if (NILP (Fmember (sequence, found)))
- found = Fcons (sequence, found);
-
- /* If firstonly is Qnon_ascii, then we can return the first
- binding we find. If firstonly is not Qnon_ascii but not
- nil, then we should return the first ascii-only binding
- we find. */
- if (EQ (firstonly, Qnon_ascii))
- RETURN_UNGCPRO (sequence);
- else if (! NILP (firstonly) && ascii_sequence_p (sequence))
- RETURN_UNGCPRO (sequence);
}
}
return found;
}
+
+/* This is the function that Fwhere_is_internal calls using map_char_table.
+ ARGS has the form
+ (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
+ .
+ ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
+ Since map_char_table doesn't really use the return value from this function,
+ we the result append to RESULT, the slot in ARGS. */
+
+static void
+where_is_internal_2 (args, key, binding)
+ Lisp_Object args, key, binding;
+{
+ Lisp_Object definition, noindirect, keymap, this, last;
+ Lisp_Object result, sequence;
+ int nomenus, last_is_meta;
+
+ result = XCONS (XCONS (XCONS (args)->car)->cdr)->cdr;
+ definition = XCONS (XCONS (XCONS (args)->car)->car)->car;
+ noindirect = XCONS (XCONS (XCONS (args)->car)->car)->cdr;
+ keymap = XCONS (XCONS (XCONS (args)->car)->cdr)->car;
+ this = XCONS (XCONS (XCONS (args)->cdr)->car)->car;
+ last = XCONS (XCONS (XCONS (args)->cdr)->car)->cdr;
+ nomenus = XFASTINT (XCONS (XCONS (XCONS (args)->cdr)->cdr)->car);
+ last_is_meta = XFASTINT (XCONS (XCONS (XCONS (args)->cdr)->cdr)->cdr);
+
+ sequence = where_is_internal_1 (binding, key, definition, noindirect, keymap,
+ this, last, nomenus, last_is_meta);
+
+ if (!NILP (sequence))
+ XCONS (XCONS (XCONS (args)->car)->cdr)->cdr
+ = Fcons (sequence, result);
+}
+
+static Lisp_Object
+where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last,
+ nomenus, last_is_meta)
+ Lisp_Object binding, key, definition, noindirect, keymap, this, last;
+ int nomenus, last_is_meta;
+{
+ Lisp_Object sequence;
+ int keymap_specified = !NILP (keymap);
+
+ /* Search through indirections unless that's not wanted. */
+ if (NILP (noindirect))
+ {
+ if (nomenus)
+ {
+ while (1)
+ {
+ Lisp_Object map, tem;
+ /* If the contents are (KEYMAP . ELEMENT), go indirect. */
+ map = get_keymap_1 (Fcar_safe (definition), 0, 0);
+ tem = Fkeymapp (map);
+ if (!NILP (tem))
+ definition = access_keymap (map, Fcdr (definition), 0, 0);
+ else
+ break;
+ }
+ /* If the contents are (menu-item ...) or (STRING ...), reject. */
+ if (CONSP (definition)
+ && (EQ (XCONS (definition)->car,Qmenu_item)
+ || STRINGP (XCONS (definition)->car)))
+ return Qnil;
+ }
+ else
+ binding = get_keyelt (binding, 0);
+ }
+
+ /* End this iteration if this element does not match
+ the target. */
+
+ if (CONSP (definition))
+ {
+ Lisp_Object tem;
+ tem = Fequal (binding, definition);
+ if (NILP (tem))
+ return Qnil;
+ }
+ else
+ if (!EQ (binding, definition))
+ return Qnil;
+
+ /* We have found a match.
+ Construct the key sequence where we found it. */
+ if (INTEGERP (key) && last_is_meta)
+ {
+ sequence = Fcopy_sequence (this);
+ Faset (sequence, last, make_number (XINT (key) | meta_modifier));
+ }
+ else
+ sequence = append_key (this, key);
+
+ /* Verify that this key binding is not shadowed by another
+ binding for the same key, before we say it exists.
+
+ Mechanism: look for local definition of this key and if
+ it is defined and does not match what we found then
+ ignore this key.
+
+ Either nil or number as value from Flookup_key
+ means undefined. */
+ if (keymap_specified)
+ {
+ binding = Flookup_key (keymap, sequence, Qnil);
+ if (!NILP (binding) && !INTEGERP (binding))
+ {
+ if (CONSP (definition))
+ {
+ Lisp_Object tem;
+ tem = Fequal (binding, definition);
+ if (NILP (tem))
+ return Qnil;
+ }
+ else
+ if (!EQ (binding, definition))
+ return Qnil;
+ }
+ }
+ else
+ {
+ binding = Fkey_binding (sequence, Qnil);
+ if (!EQ (binding, definition))
+ return Qnil;
+ }
+
+ return sequence;
+}
\f
/* describe-bindings - summarizing all the bindings in a set of keymaps. */
-DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 1, "",
+DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, Sdescribe_bindings_internal, 0, 2, "",
"Show a list of all defined keys, and their definitions.\n\
-The list is put in a buffer, which is displayed.\n\
-An optional argument PREFIX, if non-nil, should be a key sequence;\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.")
- (prefix)
- Lisp_Object 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,
- Fcons (thisbuf, prefix));
+ list3 (thisbuf, prefix, menus));
return Qnil;
}
-/* ARG is (BUFFER . PREFIX). */
+/* ARG is (BUFFER PREFIX MENU-FLAG). */
static Lisp_Object
describe_buffer_bindings (arg)
Lisp_Object arg;
{
Lisp_Object descbuf, prefix, shadow;
+ int nomenu;
register Lisp_Object start1;
struct gcpro gcpro1;
char *alternate_heading
= "\
-Alternate Characters (use anywhere the nominal character is listed):\n\
-nominal alternate\n\
-------- ---------\n";
+Keyboard translations:\n\n\
+You type Translation\n\
+-------- -----------\n";
descbuf = XCONS (arg)->car;
- prefix = XCONS (arg)->cdr;
+ arg = XCONS (arg)->cdr;
+ prefix = XCONS (arg)->car;
+ arg = XCONS (arg)->cdr;
+ nomenu = NILP (XCONS (arg)->car);
+
shadow = Qnil;
GCPRO1 (shadow);
Fset_buffer (Vstandard_output);
/* Report on alternates for keys. */
- if (STRINGP (Vkeyboard_translate_table))
+ if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
{
int c;
unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
insert ("\n", 1);
}
+ if (!NILP (Vkey_translation_map))
+ describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
+ "Key translations", nomenu, 1, 0);
+
{
int i, nmaps;
Lisp_Object *modes, *maps;
/* Temporarily switch to descbuf, so that we can get that buffer's
minor modes correctly. */
Fset_buffer (descbuf);
- if (!NILP (Voverriding_local_map))
+
+ if (!NILP (current_kboard->Voverriding_terminal_local_map)
+ || !NILP (Voverriding_local_map))
nmaps = 0;
else
nmaps = current_minor_maps (&modes, &maps);
p += sizeof (" Minor Mode Bindings") - 1;
*p = 0;
- describe_map_tree (maps[i], 0, shadow, prefix, title, 0);
+ describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0);
shadow = Fcons (maps[i], shadow);
}
}
/* Print the (major mode) local map. */
- if (!NILP (Voverriding_local_map))
+ 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 (descbuf)->keymap;
if (!NILP (start1))
{
- describe_map_tree (start1, 0, shadow, prefix,
- "Major Mode Bindings", 0);
+ describe_map_tree (start1, 1, shadow, prefix,
+ "Major Mode Bindings", nomenu, 0, 0);
shadow = Fcons (start1, shadow);
}
- describe_map_tree (current_global_map, 0, shadow, prefix,
- "Global Bindings", 0);
+ describe_map_tree (current_global_map, 1, shadow, prefix,
+ "Global Bindings", nomenu, 0, 1);
+
+ /* Print the function-key-map translations under this prefix. */
+ if (!NILP (Vfunction_key_map))
+ describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
+ "Function key map translations", nomenu, 1, 0);
+ call0 (intern ("help-mode"));
Fset_buffer (descbuf);
UNGCPRO;
return Qnil;
}
-/* Insert a desription of the key bindings in STARTMAP,
+/* 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
(such as `undefined').
PREFIX, if non-nil, says mention only keys that start with PREFIX.
TITLE, if not 0, is a string to insert at the beginning.
TITLE should not end with a colon or a newline; we supply that.
- If NOMENU is not 0, then omit menu-bar commands. */
+ If NOMENU is not 0, then omit menu-bar commands.
+
+ If TRANSL is nonzero, the definitions are actually key translations
+ so print strings and vectors differently.
+
+ If ALWAYS_TITLE is nonzero, print the title even if there are no maps
+ to look through. */
void
-describe_map_tree (startmap, partial, shadow, prefix, title, nomenu)
+describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
+ always_title)
Lisp_Object startmap, shadow, prefix;
int partial;
char *title;
int nomenu;
+ int transl;
+ int always_title;
{
- Lisp_Object maps, seen, sub_shadows;
+ Lisp_Object maps, orig_maps, seen, sub_shadows;
struct gcpro gcpro1, gcpro2, gcpro3;
int something = 0;
char *key_heading
key binding\n\
--- -------\n";
- maps = Faccessible_keymaps (startmap, prefix);
+ orig_maps = maps = Faccessible_keymaps (startmap, prefix);
seen = Qnil;
sub_shadows = Qnil;
GCPRO3 (maps, seen, sub_shadows);
}
}
- if (!NILP (maps))
+ if (!NILP (maps) || always_title)
{
if (title)
{
sub_shadows = Fcons (shmap, sub_shadows);
}
- describe_map (Fcdr (elt), Fcar (elt), describe_command,
- partial, sub_shadows, &seen);
+ /* Maps we have already listed in this loop shadow this map. */
+ for (tail = orig_maps; ! EQ (tail, maps); tail = XCDR (tail))
+ {
+ Lisp_Object tem;
+ tem = Fequal (Fcar (XCAR (tail)), prefix);
+ if (! NILP (tem))
+ sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
+ }
+
+ describe_map (Fcdr (elt), prefix,
+ transl ? describe_translation : describe_command,
+ partial, sub_shadows, &seen, nomenu);
skip: ;
}
UNGCPRO;
}
+static int previous_description_column;
+
static void
describe_command (definition)
Lisp_Object definition;
{
register Lisp_Object tem1;
+ int column = current_column ();
+ int description_column;
+
+ /* If column 16 is no good, go to col 32;
+ but don't push beyond that--go to next line instead. */
+ if (column > 30)
+ {
+ insert_char ('\n');
+ description_column = 32;
+ }
+ else if (column > 14 || (column > 10 && previous_description_column == 32))
+ description_column = 32;
+ else
+ description_column = 16;
+
+ Findent_to (make_number (description_column), make_number (1));
+ previous_description_column = description_column;
+
+ if (SYMBOLP (definition))
+ {
+ XSETSTRING (tem1, XSYMBOL (definition)->name);
+ insert_string ("`");
+ insert1 (tem1);
+ insert_string ("'\n");
+ }
+ else if (STRINGP (definition) || VECTORP (definition))
+ insert_string ("Keyboard Macro\n");
+ else
+ {
+ tem1 = Fkeymapp (definition);
+ if (!NILP (tem1))
+ insert_string ("Prefix Command\n");
+ else
+ insert_string ("??\n");
+ }
+}
+
+static void
+describe_translation (definition)
+ Lisp_Object definition;
+{
+ register Lisp_Object tem1;
Findent_to (make_number (16), make_number (1));
insert1 (tem1);
insert_string ("\n");
}
- else if (STRINGP (definition))
- insert_string ("Keyboard Macro\n");
+ else if (STRINGP (definition) || VECTORP (definition))
+ {
+ insert1 (Fkey_description (definition));
+ insert_string ("\n");
+ }
else
{
tem1 = Fkeymapp (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).
- PARTIAL, SHADOW are as in `describe_map_tree' above. */
+ PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
static void
-describe_map (map, keys, elt_describer, partial, shadow, seen)
+describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
register Lisp_Object map;
Lisp_Object keys;
- int (*elt_describer) ();
+ void (*elt_describer) P_ ((Lisp_Object));
int partial;
Lisp_Object shadow;
Lisp_Object *seen;
+ int nomenu;
{
Lisp_Object elt_prefix;
Lisp_Object tail, definition, event;
{
QUIT;
- if (VECTORP (XCONS (tail)->car))
+ if (VECTORP (XCONS (tail)->car)
+ || CHAR_TABLE_P (XCONS (tail)->car))
describe_vector (XCONS (tail)->car,
- elt_prefix, elt_describer, partial, shadow);
+ elt_prefix, elt_describer, partial, shadow, map,
+ (int *)0, 0);
else if (CONSP (XCONS (tail)->car))
{
event = XCONS (XCONS (tail)->car)->car;
if (! (SYMBOLP (event) || INTEGERP (event)))
continue;
+ if (nomenu && EQ (event, Qmenu_bar))
+ continue;
+
definition = get_keyelt (XCONS (XCONS (tail)->car)->cdr, 0);
/* Don't show undefined commands or suppressed commands. */
if (first)
{
+ previous_description_column = 0;
insert ("\n", 1);
first = 0;
}
UNGCPRO;
}
-static int
+static void
describe_vector_princ (elt)
Lisp_Object elt;
{
int count = specpdl_ptr - specpdl;
specbind (Qstandard_output, Fcurrent_buffer ());
- CHECK_VECTOR (vector, 0);
- describe_vector (vector, Qnil, describe_vector_princ, 0, Qnil);
+ CHECK_VECTOR_OR_CHAR_TABLE (vector, 0);
+ describe_vector (vector, Qnil, describe_vector_princ, 0,
+ Qnil, Qnil, (int *)0, 0);
return unbind_to (count, Qnil);
}
-describe_vector (vector, elt_prefix, elt_describer, partial, shadow)
+/* Insert in the current buffer a description of the contents of VECTOR.
+ We call ELT_DESCRIBER to insert the description of one value found
+ in VECTOR.
+
+ ELT_PREFIX describes what "comes before" the keys or indices defined
+ by this vector. This is a human-readable string whose size
+ is not necessarily related to the situation.
+
+ If the vector is in a keymap, ELT_PREFIX is a prefix key which
+ leads to this keymap.
+
+ If the vector is a chartable, ELT_PREFIX is the vector
+ of bytes that lead to the character set or portion of a character
+ set described by this chartable.
+
+ If PARTIAL is nonzero, it means do not mention suppressed commands
+ (that assumes the vector is in a keymap).
+
+ SHADOW is a list of keymaps that shadow this map.
+ If it is non-nil, then we look up the key in those maps
+ and we don't mention it now if it is defined by any of them.
+
+ ENTIRE_MAP is the keymap in which this vector appears.
+ 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. */
+
+void
+describe_vector (vector, elt_prefix, elt_describer,
+ partial, shadow, entire_map,
+ indices, char_table_depth)
register Lisp_Object vector;
Lisp_Object elt_prefix;
- int (*elt_describer) ();
+ void (*elt_describer) P_ ((Lisp_Object));
int partial;
Lisp_Object shadow;
+ Lisp_Object entire_map;
+ int *indices;
+ int char_table_depth;
{
- Lisp_Object this;
- Lisp_Object dummy;
- Lisp_Object tem1, tem2;
+ Lisp_Object definition;
+ Lisp_Object tem2;
register 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;
+ int starting_i;
+
+ if (indices == 0)
+ indices = (int *) alloca (3 * sizeof (int));
- tem1 = Qnil;
+ definition = 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, tem1, kludge);
+ GCPRO3 (elt_prefix, definition, kludge);
if (partial)
suppress = intern ("suppress-keymap");
- for (i = 0; i < XVECTOR (vector)->size; i++)
+ 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;
+ }
+
+ for (i = from; i < to; i++)
{
QUIT;
- tem1 = get_keyelt (XVECTOR (vector)->contents[i], 0);
- if (NILP (tem1)) continue;
+ if (CHAR_TABLE_P (vector))
+ {
+ if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
+ complete_char = 0;
+
+ if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
+ && !CHARSET_DEFINED_P (i - 128))
+ continue;
+
+ definition
+ = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
+ }
+ else
+ definition = get_keyelt (XVECTOR (vector)->contents[i], 0);
+
+ if (NILP (definition)) continue;
/* Don't mention suppressed commands. */
- if (SYMBOLP (tem1) && partial)
+ if (SYMBOLP (definition) && partial)
{
- this = Fget (tem1, suppress);
- if (!NILP (this))
- continue;
+ Lisp_Object tem;
+
+ tem = Fget (definition, suppress);
+
+ if (!NILP (tem)) continue;
}
- /* If this command in this map is shadowed by some other map,
- ignore it. */
- if (!NILP (shadow))
+ /* 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_NON_ASCII_CHAR (indices[0], indices[1], indices[2]);
+ }
+ else
+ character = 0;
+ }
+ else
+ character = i;
+
+ /* If this binding is shadowed by some other map, ignore it. */
+ if (!NILP (shadow) && complete_char)
{
Lisp_Object tem;
- XVECTOR (kludge)->contents[0] = make_number (i);
+ XVECTOR (kludge)->contents[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)
+ {
+ Lisp_Object tem;
+
+ XVECTOR (kludge)->contents[0] = make_number (character);
+ tem = Flookup_key (entire_map, kludge, Qt);
+
+ if (! EQ (tem, definition))
+ continue;
+ }
+
if (first)
{
- insert ("\n", 1);
+ if (char_table_depth == 0)
+ 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);
- /* Get the string to describe the character I, and print it. */
- XFASTINT (dummy) = i;
+ /* 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)));
+ 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)));
+ }
+
+ /* 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;
+ }
- /* THIS gets the string to describe the character DUMMY. */
- this = Fsingle_key_description (dummy);
- insert1 (this);
+ starting_i = i;
- /* Find all consecutive characters that have the same definition. */
- while (i + 1 < XVECTOR (vector)->size
- && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1], 0),
- EQ (tem2, tem1)))
- i++;
+ /* 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++;
+ }
+ else
+ while (i + 1 < to
+ && (tem2 = get_keyelt (XVECTOR (vector)->contents[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. */
- if (i != XINT (dummy))
+ if (i != starting_i)
{
insert (" .. ", 4);
+
if (!NILP (elt_prefix))
insert1 (elt_prefix);
- XFASTINT (dummy) = i;
- insert1 (Fsingle_key_description (dummy));
+ if (CHAR_TABLE_P (vector))
+ {
+ if (char_table_depth == 0)
+ {
+ insert1 (Fsingle_key_description (make_number (i)));
+ }
+ else if (complete_char)
+ {
+ indices[char_table_depth] = i;
+ character
+ = MAKE_NON_ASCII_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)));
+ }
}
/* Print a description of the definition of this character.
elt_describer will take care of spacing out far enough
for alignment purposes. */
- (*elt_describer) (tem1);
+ (*elt_describer) (definition);
+ }
+
+ /* For (sub) char-table, print `defalt' slot at last. */
+ if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
+ {
+ insert (" ", char_table_depth * 2);
+ insert_string ("<<default>>");
+ (*elt_describer) (XCHAR_TABLE (vector)->defalt);
}
UNGCPRO;
DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
"Show all symbols whose names contain match for REGEXP.\n\
-If optional 2nd arg PRED is non-nil, (funcall PRED SYM) is done\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.")
- (string, pred)
- Lisp_Object string, pred;
+ (regexp, predicate)
+ Lisp_Object regexp, predicate;
{
struct gcpro gcpro1, gcpro2;
- CHECK_STRING (string, 0);
- apropos_predicate = pred;
+ CHECK_STRING (regexp, 0);
+ apropos_predicate = predicate;
GCPRO2 (apropos_predicate, apropos_accumulate);
apropos_accumulate = Qnil;
- map_obarray (Vobarray, apropos_accum, string);
+ map_obarray (Vobarray, apropos_accum, regexp);
apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
UNGCPRO;
return apropos_accumulate;
}
\f
+void
syms_of_keymap ()
{
Lisp_Object tem;
Qkeymap = intern ("keymap");
staticpro (&Qkeymap);
-/* Initialize the keymaps standardly used.
- Each one is the value of a Lisp variable, and is also
- pointed to by a C variable */
+ /* Now we are ready to set up this property, so we can
+ create char tables. */
+ Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
+
+ /* Initialize the keymaps standardly used.
+ Each one is the value of a Lisp variable, and is also
+ pointed to by a C variable */
- global_map = Fcons (Qkeymap,
- Fcons (Fmake_vector (make_number (0400), Qnil), Qnil));
+ global_map = Fmake_keymap (Qnil);
Fset (intern ("global-map"), global_map);
+ current_global_map = global_map;
+ staticpro (&global_map);
+ staticpro (¤t_global_map);
+
meta_map = Fmake_keymap (Qnil);
Fset (intern ("esc-map"), meta_map);
Ffset (intern ("ESC-prefix"), meta_map);
Fset (intern ("ctl-x-map"), control_x_map);
Ffset (intern ("Control-X-prefix"), control_x_map);
+ 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.");
+ Vdefine_key_rebound_commands = Qt;
+
DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
"Default keymap to use when reading from the minibuffer.");
Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
"Local keymap for minibuffer input with completion, for exact match.");
Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
- current_global_map = global_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\
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.");
+ Vminor_mode_overriding_map_alist = 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\
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.");
+ Vkey_translation_map = Qnil;
+
Qsingle_key_description = intern ("single-key-description");
staticpro (&Qsingle_key_description);
Qnon_ascii = intern ("non-ascii");
staticpro (&Qnon_ascii);
+ Qmenu_item = intern ("menu-item");
+ staticpro (&Qmenu_item);
+
defsubr (&Skeymapp);
+ defsubr (&Skeymap_parent);
+ defsubr (&Sset_keymap_parent);
defsubr (&Smake_keymap);
defsubr (&Smake_sparse_keymap);
defsubr (&Scopy_keymap);
defsubr (&Slocal_key_binding);
defsubr (&Sglobal_key_binding);
defsubr (&Sminor_mode_key_binding);
- defsubr (&Sglobal_set_key);
- defsubr (&Slocal_set_key);
defsubr (&Sdefine_key);
defsubr (&Slookup_key);
- defsubr (&Sglobal_unset_key);
- defsubr (&Slocal_unset_key);
defsubr (&Sdefine_prefix_command);
defsubr (&Suse_global_map);
defsubr (&Suse_local_map);
defsubr (&Ssingle_key_description);
defsubr (&Stext_char_description);
defsubr (&Swhere_is_internal);
- defsubr (&Sdescribe_bindings);
+ defsubr (&Sdescribe_bindings_internal);
defsubr (&Sapropos_internal);
}
+void
keys_of_keymap ()
{
Lisp_Object tem;
HCoop / bpt / emacs.git / blobdiff