/* Manipulation of keymaps
- Copyright (C) 1985, 86,87,88,93,94,95,98 Free Software Foundation, Inc.
+ Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 2001
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#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 "termhooks.h"
#include "blockinput.h"
#include "puresize.h"
-
-#define min(a, b) ((a) < (b) ? (a) : (b))
+#include "intervals.h"
+#include "keymap.h"
/* The number of elements in keymap vectors. */
#define DENSE_TABLE_SIZE (0200)
extern Lisp_Object Voverriding_local_map;
-static Lisp_Object define_as_prefix ();
-static Lisp_Object describe_buffer_bindings ();
-static void describe_command (), describe_translation ();
-static void describe_map ();
+/* Hash table used to cache a reverse-map to speed up calls to where-is. */
+static Lisp_Object where_is_cache;
+/* Which keymaps are reverse-stored in the cache. */
+static Lisp_Object where_is_cache_keymaps;
+
+static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
+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_map P_ ((Lisp_Object, Lisp_Object,
+ void (*) P_ ((Lisp_Object)),
+ int, Lisp_Object, Lisp_Object*, int));
\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 VECTOR . ALIST).\n\
-VECTOR is a vector which holds the bindings for the ASCII\n\
+ "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\
}
DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
- "Construct and return a new sparse-keymap list.\n\
+ "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\
store_in_keymap (keymap, intern (keyname), intern (defname));
}
-/* Define character fromchar in map frommap as an alias for character
- tochar in map tomap. Subsequent redefinitions of the latter WILL
- affect the former. */
-
-#if 0
-void
-synkey (frommap, fromchar, tomap, tochar)
- struct Lisp_Vector *frommap, *tomap;
- int fromchar, tochar;
-{
- Lisp_Object v, c;
- XSETVECTOR (v, tomap);
- XSETFASTINT (c, tochar);
- frommap->contents[fromchar] = Fcons (v, c);
-}
-#endif /* 0 */
-
DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
"Return t if OBJECT is a keymap.\n\
\n\
(object)
Lisp_Object object;
{
- return (NILP (get_keymap_1 (object, 0, 0)) ? Qnil : Qt);
+ 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)
+ Lisp_Object map;
+{
+ while (CONSP (map))
+ {
+ register Lisp_Object tem;
+ tem = Fcar (map);
+ if (STRINGP (tem))
+ return tem;
+ map = Fcdr (map);
+ }
+ return Qnil;
}
/* Check that OBJECT is a keymap (after dereferencing through any
is an autoload form, do the autoload and try again.
If AUTOLOAD is nonzero, callers must assume GC is possible.
+ If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
+ is zero as well), return Qt.
+
ERROR controls how we respond if OBJECT isn't a keymap.
If ERROR is non-zero, signal an error; otherwise, just return Qnil.
Functions like Faccessible_keymaps which scan entire keymap trees
shouldn't load every autoloaded keymap. I'm not sure about this,
but it seems to me that only read_key_sequence, Flookup_key, and
- Fdefine_key should cause keymaps to be autoloaded. */
+ Fdefine_key should cause keymaps to be autoloaded.
+
+ This function can GC when AUTOLOAD is non-zero, because it calls
+ do_autoload which can GC. */
Lisp_Object
-get_keymap_1 (object, error, autoload)
+get_keymap (object, error, autoload)
Lisp_Object object;
int error, autoload;
{
Lisp_Object tem;
autoload_retry:
+ if (NILP (object))
+ goto end;
+ if (CONSP (object) && EQ (XCAR (object), Qkeymap))
+ return object;
+
tem = indirect_function (object);
- if (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap))
- return tem;
-
- /* Should we do an autoload? Autoload forms for keymaps have
- Qkeymap as their fifth element. */
- if (autoload
- && SYMBOLP (object)
- && CONSP (tem)
- && EQ (XCONS (tem)->car, Qautoload))
+ if (CONSP (tem))
{
- Lisp_Object tail;
+ if (EQ (XCAR (tem), Qkeymap))
+ return tem;
- tail = Fnth (make_number (4), tem);
- if (EQ (tail, Qkeymap))
+ /* Should we do an autoload? Autoload forms for keymaps have
+ Qkeymap as their fifth element. */
+ if ((autoload || !error) && EQ (XCAR (tem), Qautoload))
{
- struct gcpro gcpro1, gcpro2;
-
- GCPRO2 (tem, object);
- do_autoload (tem, object);
- UNGCPRO;
+ Lisp_Object tail;
- goto autoload_retry;
+ tail = Fnth (make_number (4), tem);
+ if (EQ (tail, Qkeymap))
+ {
+ if (autoload)
+ {
+ struct gcpro gcpro1, gcpro2;
+
+ GCPRO2 (tem, object);
+ do_autoload (tem, object);
+ UNGCPRO;
+
+ goto autoload_retry;
+ }
+ else
+ return Qt;
+ }
}
}
+ end:
if (error)
wrong_type_argument (Qkeymapp, object);
- else
- return Qnil;
-}
-
-
-/* Follow any symbol chaining, and return the keymap denoted by OBJECT.
- If OBJECT doesn't denote a keymap at all, signal an error. */
-Lisp_Object
-get_keymap (object)
- Lisp_Object object;
-{
- return get_keymap_1 (object, 1, 0);
+ return Qnil;
}
\f
/* Return the parent map of the keymap MAP, or nil if it has none.
{
Lisp_Object list;
- keymap = get_keymap_1 (keymap, 1, 1);
+ keymap = get_keymap (keymap, 1, 1);
/* Skip past the initial element `keymap'. */
- list = XCONS (keymap)->cdr;
- for (; CONSP (list); list = XCONS (list)->cdr)
+ list = XCDR (keymap);
+ for (; CONSP (list); list = XCDR (list))
{
/* See if there is another `keymap'. */
- if (EQ (Qkeymap, XCONS (list)->car))
+ if (KEYMAPP (list))
return list;
}
- return Qnil;
+ return get_keymap (list, 0, 1);
+}
+
+
+/* Check whether MAP is one of MAPS parents. */
+int
+keymap_memberp (map, maps)
+ Lisp_Object map, maps;
+{
+ if (NILP (map)) return 0;
+ while (KEYMAPP (maps) && !EQ (map, maps))
+ maps = Fkeymap_parent (maps);
+ return (EQ (map, maps));
}
/* Set the parent keymap of MAP to PARENT. */
Lisp_Object keymap, parent;
{
Lisp_Object list, prev;
+ struct gcpro gcpro1;
int i;
- keymap = get_keymap_1 (keymap, 1, 1);
+ /* Force a keymap flush for the next call to where-is.
+ Since this can be called from within where-is, we don't set where_is_cache
+ directly but only where_is_cache_keymaps, since where_is_cache shouldn't
+ be changed during where-is, while where_is_cache_keymaps is only used at
+ the very beginning of where-is and can thus be changed here without any
+ adverse effect.
+ This is a very minor correctness (rather than safety) issue. */
+ where_is_cache_keymaps = Qt;
+
+ keymap = get_keymap (keymap, 1, 1);
+ GCPRO1 (keymap);
+
if (!NILP (parent))
- parent = get_keymap_1 (parent, 1, 1);
+ {
+ parent = get_keymap (parent, 1, 1);
+
+ /* Check for cycles. */
+ if (keymap_memberp (keymap, parent))
+ error ("Cyclic keymap inheritance");
+ }
/* Skip past the initial element `keymap'. */
prev = keymap;
while (1)
{
- list = XCONS (prev)->cdr;
+ list = XCDR (prev);
/* 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 (!CONSP (list) || KEYMAPP (list))
{
/* If we already have the right parent, return now
so that we avoid the loops below. */
- if (EQ (XCONS (prev)->cdr, parent))
- return parent;
+ if (EQ (XCDR (prev), parent))
+ RETURN_UNGCPRO (parent);
- XCONS (prev)->cdr = parent;
+ XCDR (prev) = parent;
break;
}
prev = list;
/* Scan through for submaps, and set their parents too. */
- for (list = XCONS (keymap)->cdr; CONSP (list); list = XCONS (list)->cdr)
+ for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
{
/* Stop the scan when we come to the parent. */
- if (EQ (XCONS (list)->car, Qkeymap))
+ if (EQ (XCAR (list), 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]))
+ if (CONSP (XCAR (list))
+ && CONSP (XCDR (XCAR (list))))
+ fix_submap_inheritance (keymap, XCAR (XCAR (list)),
+ XCDR (XCAR (list)));
+
+ if (VECTORP (XCAR (list)))
+ for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
+ if (CONSP (XVECTOR (XCAR (list))->contents[i]))
fix_submap_inheritance (keymap, make_number (i),
- XVECTOR (XCONS (list)->car)->contents[i]);
+ XVECTOR (XCAR (list))->contents[i]);
- if (CHAR_TABLE_P (XCONS (list)->car))
+ if (CHAR_TABLE_P (XCAR (list)))
{
Lisp_Object indices[3];
- map_char_table (fix_submap_inheritance, Qnil, XCONS (list)->car,
+ map_char_table (fix_submap_inheritance, Qnil, XCAR (list),
keymap, 0, indices);
}
}
- return parent;
+ RETURN_UNGCPRO (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
+static void
fix_submap_inheritance (map, event, submap)
Lisp_Object map, event, submap;
{
/* 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;
- }
- }
+ submap = get_keymap (get_keyelt (submap, 0), 0, 0);
/* If it isn't a keymap now, there's no work to do. */
- if (! CONSP (submap)
- || ! EQ (XCONS (submap)->car, Qkeymap))
+ if (!CONSP (submap))
return;
map_parent = Fkeymap_parent (map);
- if (! NILP (map_parent))
- parent_entry = access_keymap (map_parent, event, 0, 0);
+ if (!NILP (map_parent))
+ parent_entry =
+ get_keymap (access_keymap (map_parent, event, 0, 0, 0), 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;
+ our own submap shadows it completely. */
+ if (!CONSP (parent_entry))
+ return;
if (! EQ (parent_entry, submap))
- Fset_keymap_parent (submap, parent_entry);
+ {
+ Lisp_Object submap_parent;
+ submap_parent = submap;
+ while (1)
+ {
+ Lisp_Object tem;
+
+ tem = Fkeymap_parent (submap_parent);
+
+ if (KEYMAPP (tem))
+ {
+ if (keymap_memberp (tem, parent_entry))
+ /* Fset_keymap_parent could create a cycle. */
+ return;
+ submap_parent = tem;
+ }
+ else
+ break;
+ }
+ Fset_keymap_parent (submap_parent, parent_entry);
+ }
}
\f
/* Look up IDX in MAP. IDX may be any sort of event.
If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
Lisp_Object
-access_keymap (map, idx, t_ok, noinherit)
+access_keymap (map, idx, t_ok, noinherit, autoload)
Lisp_Object map;
Lisp_Object idx;
int t_ok;
int noinherit;
+ int autoload;
{
int noprefix = 0;
Lisp_Object val;
with more than 24 bits of integer. */
XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
+ /* Handle the special meta -> esc mapping. */
+ if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
+ {
+ /* 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);
+ if (CONSP (meta_map))
+ {
+ map = meta_map;
+ idx = make_number (XUINT (idx) & ~meta_modifier);
+ }
+ else if (t_ok)
+ /* Set IDX to t, so that we only find a default binding. */
+ idx = Qt;
+ else
+ /* We know there is no binding. */
+ return Qnil;
+ }
+
{
Lisp_Object tail;
Lisp_Object t_binding;
+ Lisp_Object generic_binding;
t_binding = Qnil;
- for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr)
+ generic_binding = Qnil;
+
+ for (tail = XCDR (map);
+ (CONSP (tail)
+ || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
+ tail = XCDR (tail))
{
Lisp_Object binding;
- binding = XCONS (tail)->car;
+ binding = XCAR (tail);
if (SYMBOLP (binding))
{
/* If NOINHERIT, stop finding prefix definitions
after we pass a second occurrence of the `keymap' symbol. */
- if (noinherit && EQ (binding, Qkeymap) && ! EQ (tail, map))
+ if (noinherit && EQ (binding, Qkeymap))
noprefix = 1;
}
else if (CONSP (binding))
{
- if (EQ (XCONS (binding)->car, idx))
+ Lisp_Object key = XCAR (binding);
+ int c1, c2, charset;
+
+ if (EQ (key, idx))
{
- val = XCONS (binding)->cdr;
- if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap))
+ val = XCDR (binding);
+ if (noprefix && KEYMAPP (val))
return Qnil;
if (CONSP (val))
fix_submap_inheritance (map, idx, val);
- return val;
+ return get_keyelt (val, autoload);
}
- if (t_ok && EQ (XCONS (binding)->car, Qt))
- t_binding = XCONS (binding)->cdr;
+ 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);
+ }
+ 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 && CONSP (val) && EQ (XCONS (val)->car, Qkeymap))
+ if (noprefix && KEYMAPP (val))
return Qnil;
if (CONSP (val))
fix_submap_inheritance (map, idx, val);
- return val;
+ return get_keyelt (val, autoload);
}
}
else if (CHAR_TABLE_P (binding))
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)))
+ && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
{
val = Faref (binding, idx);
- if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap))
+ if (noprefix && KEYMAPP (val))
return Qnil;
if (CONSP (val))
fix_submap_inheritance (map, idx, val);
- return val;
+ return get_keyelt (val, autoload);
}
}
QUIT;
}
- return t_binding;
+ if (!NILP (generic_binding))
+ return get_keyelt (generic_binding, autoload);
+
+ return get_keyelt (t_binding, autoload);
}
}
{
while (1)
{
- register Lisp_Object map, tem;
+ if (!(CONSP (object)))
+ /* This is really the value. */
+ return object;
- /* If the contents are (KEYMAP . ELEMENT), go indirect. */
- map = get_keymap_1 (Fcar_safe (object), 0, autoload);
- tem = Fkeymapp (map);
- if (!NILP (tem))
+ /* If the keymap contents looks like (keymap ...) or (lambda ...)
+ then use itself. */
+ else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
+ return object;
+
+ /* 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 (XCAR (object), Qmenu_item))
{
- Lisp_Object key;
- key = Fcdr (object);
- if (INTEGERP (key) && (XINT (key) & meta_modifier))
+ if (CONSP (XCDR (object)))
{
- 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);
+ Lisp_Object tem;
+
+ object = XCDR (XCDR (object));
+ tem = object;
+ if (CONSP (object))
+ object = XCAR (object);
+
+ /* If there's a `:filter FILTER', apply FILTER to the
+ menu-item's definition to get the real definition to
+ use. */
+ for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
+ if (EQ (XCAR (tem), QCfilter) && autoload)
+ {
+ Lisp_Object filter;
+ filter = XCAR (XCDR (tem));
+ filter = list2 (filter, list2 (Qquote, object));
+ object = menu_item_eval_property (filter);
+ break;
+ }
}
else
- object = access_keymap (map, key, 0, 0);
+ /* Invalid keymap */
+ return object;
}
- else if (!(CONSP (object)))
- /* This is really the value. */
- return object;
-
- /* If the keymap contents looks like (STRING . DEFN),
- use DEFN.
+ /* 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 (STRINGP (XCONS (object)->car))
+ else if (STRINGP (XCAR (object)))
{
- object = XCONS (object)->cdr;
+ object = XCDR (object);
/* Also remove a menu help string, if any,
following the menu item name. */
- if (CONSP (object) && STRINGP (XCONS (object)->car))
- object = XCONS (object)->cdr;
+ if (CONSP (object) && STRINGP (XCAR (object)))
+ object = XCDR (object);
/* Also remove the sublist that caches key equivalences, if any. */
- if (CONSP (object)
- && CONSP (XCONS (object)->car))
+ if (CONSP (object) && CONSP (XCAR (object)))
{
Lisp_Object carcar;
- carcar = XCONS (XCONS (object)->car)->car;
+ carcar = XCAR (XCAR (object));
if (NILP (carcar) || VECTORP (carcar))
- object = XCONS (object)->cdr;
+ object = XCDR (object);
}
}
- /* 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))
+ /* If the contents are (KEYMAP . ELEMENT), go indirect. */
+ else
{
- object = XCONS (XCONS (object)->cdr)->cdr;
- if (CONSP (object))
- object = XCONS (object)->car;
+ Lisp_Object map;
+ map = get_keymap (Fcar_safe (object), 0, autoload);
+ return (!CONSP (map) ? object /* Invalid keymap */
+ : access_keymap (map, Fcdr (object), 0, 0, autoload));
}
-
- else
- /* Anything else is really the value. */
- return object;
}
}
-Lisp_Object
+static Lisp_Object
store_in_keymap (keymap, idx, def)
Lisp_Object keymap;
register Lisp_Object idx;
register Lisp_Object def;
{
+ /* Flush any reverse-map cache. */
+ where_is_cache = Qnil;
+ where_is_cache_keymaps = Qt;
+
/* 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);
+ && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
+ def = Fcons (XCAR (def), XCDR (def));
- if (!CONSP (keymap) || ! EQ (XCONS (keymap)->car, Qkeymap))
+ 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?),
Lisp_Object insertion_point;
insertion_point = keymap;
- for (tail = XCONS (keymap)->cdr; CONSP (tail); tail = XCONS (tail)->cdr)
+ for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
{
Lisp_Object elt;
- elt = XCONS (tail)->car;
+ elt = XCAR (tail);
if (VECTORP (elt))
{
- if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (elt)->size)
+ if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
{
- XVECTOR (elt)->contents[XFASTINT (idx)] = def;
+ ASET (elt, XFASTINT (idx), def);
return def;
}
insertion_point = tail;
}
else if (CONSP (elt))
{
- if (EQ (idx, XCONS (elt)->car))
+ if (EQ (idx, XCAR (elt)))
{
- XCONS (elt)->cdr = def;
+ XCDR (elt) = def;
return def;
}
}
- 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;
- }
+ else if (EQ (elt, Qkeymap))
+ /* 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. */
+ goto keymap_end;
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);
+ XCDR (insertion_point)
+ = Fcons (Fcons (idx, def), XCDR (insertion_point));
}
-
+
return def;
}
copy_keymap_1 (chartable, idx, elt)
Lisp_Object chartable, idx, elt;
{
- if (!SYMBOLP (elt) && ! NILP (Fkeymapp (elt)))
+ if (CONSP (elt) && EQ (XCAR (elt), Qkeymap))
Faset (chartable, idx, Fcopy_keymap (elt));
}
(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;
- copy = Fcopy_alist (get_keymap (keymap));
+ copy = Fcopy_alist (get_keymap (keymap, 1, 0));
- for (tail = copy; CONSP (tail); tail = XCONS (tail)->cdr)
+ for (tail = copy; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object elt;
- elt = XCONS (tail)->car;
+ elt = XCAR (tail);
if (CHAR_TABLE_P (elt))
{
Lisp_Object indices[3];
elt = Fcopy_sequence (elt);
- XCONS (tail)->car = elt;
+ XCAR (tail) = elt;
map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices);
}
int i;
elt = Fcopy_sequence (elt);
- XCONS (tail)->car = elt;
+ XCAR (tail) = elt;
- 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]);
+ 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 (XCONS (elt)->cdr))
+ else if (CONSP (elt) && CONSP (XCDR (elt)))
{
Lisp_Object tem;
- tem = XCONS (elt)->cdr;
+ tem = XCDR (elt);
/* Is this a new format menu item. */
- if (EQ (XCONS (tem)->car,Qmenu_item))
+ if (EQ (XCAR (tem),Qmenu_item))
{
/* Copy cell with menu-item marker. */
- XCONS (elt)->cdr
- = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
- elt = XCONS (elt)->cdr;
- tem = XCONS (elt)->cdr;
+ XCDR (elt)
+ = Fcons (XCAR (tem), XCDR (tem));
+ elt = XCDR (elt);
+ tem = XCDR (elt);
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;
+ 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. */
- 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))
+ 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. */
- XCONS (elt)->cdr = XCONS (tem)->cdr;
+ XCDR (elt) = XCDR (tem);
}
}
else
/* It may be an old fomat menu item.
Skip the optional menu string.
*/
- if (STRINGP (XCONS (tem)->car))
+ if (STRINGP (XCAR (tem)))
{
/* 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;
+ XCDR (elt)
+ = Fcons (XCAR (tem), XCDR (tem));
+ elt = XCDR (elt);
+ tem = XCDR (elt);
/* Also skip the optional menu help string. */
- if (CONSP (tem) && STRINGP (XCONS (tem)->car))
+ if (CONSP (tem) && STRINGP (XCAR (tem)))
{
- XCONS (elt)->cdr
- = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
- elt = XCONS (elt)->cdr;
- tem = XCONS (elt)->cdr;
+ 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 (XCONS (tem)->car)
- && (NILP (XCONS (XCONS (tem)->car)->car)
- || VECTORP (XCONS (XCONS (tem)->car)->car)))
- XCONS (elt)->cdr = XCONS (tem)->cdr;
+ && CONSP (XCAR (tem))
+ && (NILP (XCAR (XCAR (tem)))
+ || VECTORP (XCAR (XCAR (tem)))))
+ XCDR (elt) = XCDR (tem);
}
if (CONSP (elt)
- && ! SYMBOLP (XCONS (elt)->cdr)
- && ! NILP (Fkeymapp (XCONS (elt)->cdr)))
- XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr);
+ && CONSP (XCDR (elt))
+ && EQ (XCAR (XCDR (elt)), Qkeymap))
+ XCDR (elt) = Fcopy_keymap (XCDR (elt));
}
}
{
register int idx;
register Lisp_Object c;
- register Lisp_Object tem;
register Lisp_Object cmd;
int metized = 0;
int meta_bit;
int length;
struct gcpro gcpro1, gcpro2, gcpro3;
- keymap = get_keymap_1 (keymap, 1, 1);
+ keymap = get_keymap (keymap, 1, 1);
if (!VECTORP (key) && !STRINGP (key))
key = wrong_type_argument (Qarrayp, key);
idx++;
}
- if (! INTEGERP (c) && ! SYMBOLP (c) && ! CONSP (c))
+ if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c))
error ("Key sequence contains invalid events");
if (idx == length)
RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
- cmd = get_keyelt (access_keymap (keymap, c, 0, 1), 1);
+ cmd = access_keymap (keymap, c, 0, 1, 1);
/* If this key is undefined, make it a prefix. */
if (NILP (cmd))
cmd = define_as_prefix (keymap, c);
- keymap = get_keymap_1 (cmd, 0, 1);
- if (NILP (keymap))
+ keymap = get_keymap (cmd, 0, 1);
+ if (!CONSP (keymap))
/* We must use Fkey_description rather than just passing key to
error; key might be a vector, not a string. */
error ("Key sequence %s uses invalid prefix characters",
Lisp_Object accept_default;
{
register int idx;
- register Lisp_Object tem;
register Lisp_Object cmd;
register Lisp_Object c;
- int metized = 0;
int length;
- int t_ok = ! NILP (accept_default);
- int meta_bit;
+ int t_ok = !NILP (accept_default);
struct gcpro gcpro1;
- keymap = get_keymap_1 (keymap, 1, 1);
+ keymap = get_keymap (keymap, 1, 1);
if (!VECTORP (key) && !STRINGP (key))
key = wrong_type_argument (Qarrayp, key);
if (length == 0)
return keymap;
- if (VECTORP (key))
- meta_bit = meta_modifier;
- else
- meta_bit = 0x80;
-
GCPRO1 (key);
idx = 0;
while (1)
{
- c = Faref (key, make_number (idx));
+ 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)
- {
- c = meta_prefix_char;
- metized = 1;
- }
- else
- {
- if (INTEGERP (c))
- XSETINT (c, XINT (c) & ~meta_bit);
-
- metized = 0;
- idx++;
- }
+ /* Turn the 8th bit of string chars into a meta modifier. */
+ if (XINT (c) & 0x80 && STRINGP (key))
+ XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
- cmd = get_keyelt (access_keymap (keymap, c, t_ok, 0), 1);
+ cmd = access_keymap (keymap, c, t_ok, 0, 1);
if (idx == length)
RETURN_UNGCPRO (cmd);
- keymap = get_keymap_1 (cmd, 0, 1);
- if (NILP (keymap))
+ keymap = get_keymap (cmd, 0, 1);
+ if (!CONSP (keymap))
RETURN_UNGCPRO (make_number (idx));
QUIT;
define_as_prefix (keymap, c)
Lisp_Object keymap, c;
{
- Lisp_Object inherit, cmd;
+ Lisp_Object cmd;
cmd = Fmake_sparse_keymap (Qnil);
/* If this key is defined as a prefix in an inherited keymap,
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
- and it doesn't define this key,
- make it define this key. */
- Lisp_Object tail;
-
- for (tail = Fcdr (keymap); CONSP (tail); tail = XCONS (tail)->cdr)
- if (EQ (XCONS (tail)->car, Qkeymap))
- break;
-
- if (!NILP (tail))
- inherit = define_as_prefix (tail, c);
- }
-#endif
-
- cmd = nconc2 (cmd, inherit);
+ cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
store_in_keymap (keymap, c, cmd);
return cmd;
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))
+ 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;
{
Lisp_Object *newmodes, *newmaps;
+ /* 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 (Lisp_Object));
+ cmm_size * sizeof *newmodes);
newmaps
= (Lisp_Object *) realloc (cmm_maps,
- cmm_size * sizeof (Lisp_Object));
+ cmm_size * sizeof *newmaps);
UNBLOCK_INPUT;
}
else
BLOCK_INPUT;
cmm_size = 30;
newmodes
- = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
+ = (Lisp_Object *) malloc (cmm_size * sizeof *newmodes);
newmaps
- = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
+ = (Lisp_Object *) malloc (cmm_size * sizeof *newmaps);
UNBLOCK_INPUT;
}
- if (newmaps && newmodes)
- {
- cmm_modes = newmodes;
- cmm_maps = newmaps;
- }
- else
+ if (newmodes)
+ cmm_modes = newmodes;
+ if (newmaps)
+ cmm_maps = newmaps;
+
+ if (newmodes == NULL || newmaps == NULL)
break;
}
/* Get the keymap definition--or nil if it is not defined. */
temp = internal_condition_case_1 (Findirect_function,
- XCONS (assoc)->cdr,
+ XCDR (assoc),
Qerror, current_minor_maps_error);
if (!NILP (temp))
{
return i;
}
+DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
+ 0, 1, 0,
+ "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;
+{
+ Lisp_Object keymaps = Fcons (current_global_map, Qnil);
+
+ if (!NILP (olp))
+ {
+ if (!NILP (Voverriding_local_map))
+ keymaps = Fcons (Voverriding_local_map, keymaps);
+ if (!NILP (current_kboard->Voverriding_terminal_local_map))
+ keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
+ }
+ if (NILP (XCDR (keymaps)))
+ {
+ Lisp_Object local;
+ Lisp_Object *maps;
+ int nmaps, i;
+
+ local = get_local_map (PT, current_buffer, Qlocal_map);
+ 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);
+ }
+
+ return keymaps;
+}
+
/* GC is possible in this function if it autoloads a keymap. */
DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
RETURN_UNGCPRO (value);
}
- local = get_local_map (PT, current_buffer);
+ 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))
{
GCPRO2 (key, binding);
for (i = j = 0; i < nmaps; i++)
- if (! NILP (maps[i])
- && ! NILP (binding = Flookup_key (maps[i], key, accept_default))
+ if (!NILP (maps[i])
+ && !NILP (binding = Flookup_key (maps[i], key, accept_default))
&& !INTEGERP (binding))
{
- if (! NILP (get_keymap (binding)))
+ if (KEYMAPP (binding))
maps[j++] = Fcons (modes[i], binding);
else if (j == 0)
RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
return Flist (j, maps);
}
-DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 2, 0,
+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.")
- (command, mapvar)
- Lisp_Object command, mapvar;
+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)
+ Lisp_Object command, mapvar, name;
{
Lisp_Object map;
- map = Fmake_sparse_keymap (Qnil);
+ map = Fmake_sparse_keymap (name);
Ffset (command, map);
if (!NILP (mapvar))
Fset (mapvar, map);
(keymap)
Lisp_Object keymap;
{
- keymap = get_keymap (keymap);
+ keymap = get_keymap (keymap, 1, 1);
current_global_map = keymap;
return Qnil;
Lisp_Object keymap;
{
if (!NILP (keymap))
- keymap = get_keymap (keymap);
+ keymap = get_keymap (keymap, 1, 1);
current_buffer->keymap = keymap;
\f
/* Help functions for describing and documenting keymaps. */
-static void accessible_keymaps_char_table ();
+
+static void
+accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized)
+ Lisp_Object maps, tail, thisseq, key, cmd;
+ int is_metized; /* If 1, `key' is assumed to be INTEGERP. */
+{
+ Lisp_Object tem;
+
+ cmd = get_keyelt (cmd, 0);
+ if (NILP (cmd))
+ return;
+
+ tem = get_keymap (cmd, 0, 0);
+ if (CONSP (tem))
+ {
+ 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));
+ }
+ }
+ }
+}
+
+static void
+accessible_keymaps_char_table (args, index, cmd)
+ Lisp_Object args, index, cmd;
+{
+ accessible_keymaps_1 (index, cmd,
+ XCAR (XCAR (args)),
+ XCAR (XCDR (args)),
+ XCDR (XCDR (args)),
+ XINT (XCDR (XCAR (args))));
+}
/* This function cannot GC. */
/* 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))
+ tem = get_keymap (tem, 0, 0);
+ if (CONSP (tem))
{
/* Convert PREFIX to a vector now, so that later on
we don't have to deal with the possibility of a string. */
Lisp_Object copy;
copy = Fmake_vector (make_number (XSTRING (prefix)->size), Qnil);
- for (i = 0, i_byte; i < XSTRING (prefix)->size;)
+ for (i = 0, i_byte = 0; 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)
+
+ FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
+ if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
c ^= 0200 | meta_modifier;
- XVECTOR (copy)->contents[i_before] = make_number (c);
+ ASET (copy, i_before, make_number (c));
}
prefix = copy;
}
}
else
maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
- get_keymap (keymap)),
+ get_keymap (keymap, 1, 0)),
Qnil);
/* For each map in the list maps,
This is a breadth-first traversal, where tail is the queue of
nodes, and maps accumulates a list of all nodes visited. */
- for (tail = maps; CONSP (tail); tail = XCONS (tail)->cdr)
+ for (tail = maps; CONSP (tail); tail = XCDR (tail))
{
register Lisp_Object thisseq, thismap;
Lisp_Object last;
&& XINT (last) >= prefixlen
&& EQ (Faref (thisseq, last), meta_prefix_char));
- for (; CONSP (thismap); thismap = XCONS (thismap)->cdr)
+ for (; CONSP (thismap); thismap = XCDR (thismap))
{
Lisp_Object elt;
- elt = XCONS (thismap)->car;
+ elt = XCAR (thismap);
QUIT;
Lisp_Object indices[3];
map_char_table (accessible_keymaps_char_table, Qnil,
- elt, Fcons (maps, Fcons (tail, thisseq)),
+ elt, Fcons (Fcons (maps, make_number (is_metized)),
+ Fcons (tail, thisseq)),
0, indices);
}
else if (VECTORP (elt))
register int i;
/* Vector keymap. Scan all the elements. */
- for (i = 0; i < XVECTOR (elt)->size; i++)
- {
- register Lisp_Object tem;
- register Lisp_Object cmd;
-
- cmd = get_keyelt (XVECTOR (elt)->contents[i], 0);
- if (NILP (cmd)) continue;
- 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))
- {
- /* 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;
- tem = Fcopy_sequence (thisseq);
-
- Faset (tem, last, make_number (i | meta_bit));
-
- /* This new sequence is the same length as
- thisseq, so stick it in the list right
- after this one. */
- XCONS (tail)->cdr
- = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
- }
- else
- {
- tem = append_key (thisseq, make_number (i));
- nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
- }
- }
- }
- }
+ 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))
- {
- register Lisp_Object cmd, tem, filter;
-
- cmd = get_keyelt (XCONS (elt)->cdr, 0);
- /* Ignore definitions that aren't keymaps themselves. */
- tem = Fkeymapp (cmd);
- if (!NILP (tem))
- {
- /* Ignore keymaps that have been seen already. */
- cmd = get_keymap (cmd);
- tem = Frassq (cmd, maps);
- if (NILP (tem))
- {
- /* Let elt be the event defined by this map entry. */
- elt = XCONS (elt)->car;
-
- /* If the last key in thisseq is meta-prefix-char, and
- this entry is a binding for an ascii keystroke,
- turn it into a meta-ized keystroke. */
- if (is_metized && INTEGERP (elt))
- {
- 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
- after this one. */
- XCONS (tail)->cdr
- = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
- }
- else
- nconc2 (tail,
- Fcons (Fcons (append_key (thisseq, elt), cmd),
- Qnil));
- }
- }
- }
+ accessible_keymaps_1 (XCAR (elt), XCDR (elt),
+ maps, tail, thisseq,
+ is_metized && INTEGERP (XCAR (elt)));
+
}
}
/* Now find just the maps whose access prefixes start with PREFIX. */
good_maps = Qnil;
- for (; CONSP (maps); maps = XCONS (maps)->cdr)
+ for (; CONSP (maps); maps = XCDR (maps))
{
Lisp_Object elt, thisseq;
- elt = XCONS (maps)->car;
- thisseq = XCONS (elt)->car;
+ 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)
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;
(keys)
Lisp_Object keys;
{
- int len;
+ int len = 0;
int i, i_byte;
Lisp_Object sep;
- Lisp_Object *args;
+ Lisp_Object *args = NULL;
if (STRINGP (keys))
{
Lisp_Object vector;
vector = Fmake_vector (Flength (keys), Qnil);
- for (i = 0; i < XSTRING (keys)->size; )
+ for (i = 0, i_byte = 0; i < XSTRING (keys)->size; )
{
int c;
int i_before = i;
- if (STRING_MULTIBYTE (keys))
- FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte);
- else
- 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);
+ 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);
}
keys = vector;
}
- else if (!VECTORP (keys))
- keys = wrong_type_argument (Qarrayp, keys);
- /* In effect, this computes
- (mapconcat 'single-key-description keys " ")
- but we shouldn't use mapconcat because it can do GC. */
+ if (VECTORP (keys))
+ {
+ /* In effect, this computes
+ (mapconcat 'single-key-description keys " ")
+ but we shouldn't use mapconcat because it can do GC. */
- 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));
+ 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));
- for (i = 0; i < len; i++)
+ for (i = 0; i < len; i++)
+ {
+ args[i * 2] = Fsingle_key_description (AREF (keys, i), Qnil);
+ args[i * 2 + 1] = sep;
+ }
+ }
+ else if (CONSP (keys))
{
- args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i]);
- args[i * 2 + 1] = sep;
+ /* 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++)
+ {
+ args[i * 2] = Fsingle_key_description (XCAR (keys), Qnil);
+ args[i * 2 + 1] = sep;
+ keys = XCDR (keys);
+ }
}
+ else
+ keys = wrong_type_argument (Qarrayp, keys);
+ if (len == 0)
+ return build_string ("");
return Fconcat (len * 2 - 1, args);
}
char *
-push_key_description (c, p)
+push_key_description (c, p, force_multibyte)
register unsigned int c;
register char *p;
+ 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
+ | meta_modifier | shift_modifier | super_modifier);
if (c & alt_modifier)
{
*p++ = '-';
c -= alt_modifier;
}
- if (c & ctrl_modifier)
+ if ((c & ctrl_modifier) != 0
+ || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
{
*p++ = 'C';
*p++ = '-';
- c -= ctrl_modifier;
+ c &= ~ctrl_modifier;
}
if (c & hyper_modifier)
{
}
else
{
- *p++ = 'C';
- *p++ = '-';
+ /* `C-' already added above. */
if (c > 0 && c <= Ctl ('Z'))
*p++ = c + 0140;
else
*p++ = 'L';
}
else if (c == ' ')
- {
+ {
*p++ = 'S';
*p++ = 'P';
*p++ = 'C';
}
- else if (c < 128)
- *p++ = c;
- else if (c < 512)
+ else if (c < 128
+ || (NILP (current_buffer->enable_multibyte_characters)
+ && SINGLE_BYTE_CHAR_P (c)
+ && !force_multibyte))
{
- *p++ = '\\';
- *p++ = (7 & (c >> 6)) + '0';
- *p++ = (7 & (c >> 3)) + '0';
- *p++ = (7 & (c >> 0)) + '0';
+ *p++ = c;
}
else
{
- unsigned char work[4], *str;
- int i = CHAR_STRING (c, work, str);
- bcopy (str, p, i);
- p += i;
+ 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 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';
+ }
+ }
+ else
+ p += CHAR_STRING (c, p);
}
return p;
/* This function cannot GC. */
-DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0,
+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.")
- (key)
- Lisp_Object key;
+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)
+ Lisp_Object key, no_angles;
{
+ if (CONSP (key) && lucid_event_type_list_p (key))
+ key = Fevent_convert_list (key);
+
key = EVENT_HEAD (key);
if (INTEGERP (key)) /* Normal character */
{
unsigned int charset, c1, c2;
+ int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
- if (SINGLE_BYTE_CHAR_P (XINT (key)))
+ if (SINGLE_BYTE_CHAR_P (without_bits))
charset = 0;
else
- SPLIT_NON_ASCII_CHAR (XINT (key), charset, c1, c2);
+ SPLIT_CHAR (without_bits, charset, c1, c2);
if (charset
+ && CHARSET_DEFINED_P (charset)
&& ((c1 >= 0 && c1 < 32)
|| (c2 >= 0 && c2 < 32)))
{
}
else
{
- char tem[20];
-
- *push_key_description (XUINT (key), tem) = 0;
- return build_string (tem);
+ 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;
}
}
else if (SYMBOLP (key)) /* Function key or event-symbol */
- return Fsymbol_name (key);
+ {
+ if (NILP (no_angles))
+ {
+ char *buffer
+ = (char *) alloca (STRING_BYTES (XSYMBOL (key)->name) + 5);
+ sprintf (buffer, "<%s>", XSYMBOL (key)->name->data);
+ return build_string (buffer);
+ }
+ else
+ 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");
+ return Qnil;
}
char *
(character)
Lisp_Object character;
{
- char tem[6];
+ /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
+ unsigned char str[6];
+ int c;
CHECK_NUMBER (character, 0);
- if (!SINGLE_BYTE_CHAR_P (XFASTINT (character)))
+ c = XINT (character);
+ if (!SINGLE_BYTE_CHAR_P (c))
{
- unsigned char *str;
- int len = non_ascii_char_to_string (XFASTINT (character), tem, &str);
+ int len = CHAR_STRING (c, str);
return make_multibyte_string (str, 1, len);
}
- *push_text_char_description (XINT (character) & 0377, tem) = 0;
+ *push_text_char_description (c & 0377, str) = 0;
- return build_string (tem);
+ return build_string (str);
}
/* Return non-zero if SEQ contains only ASCII characters, perhaps with
static Lisp_Object where_is_internal_1 ();
static void where_is_internal_2 ();
+/* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
+ Returns the first non-nil binding found in any of those maps. */
+
+static Lisp_Object
+shadow_lookup (shadow, key, flag)
+ Lisp_Object shadow, key, flag;
+{
+ Lisp_Object tail, value;
+
+ for (tail = shadow; CONSP (tail); tail = XCDR (tail))
+ {
+ value = Flookup_key (XCAR (tail), key, flag);
+ if (!NILP (value) && !NATNUMP (value))
+ return value;
+ }
+ return Qnil;
+}
+
/* This function can GC if Flookup_key autoloads any keymaps. */
-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\
-\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)
- Lisp_Object definition, keymap;
+static Lisp_Object
+where_is_internal (definition, keymaps, firstonly, noindirect)
+ Lisp_Object definition, keymaps;
Lisp_Object firstonly, noindirect;
{
- Lisp_Object maps;
+ Lisp_Object maps = Qnil;
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
- keymap1 = get_local_map (PT, current_buffer);
-#else
- keymap1 = current_buffer->keymap;
-#endif
- }
-
- if (!NILP (keymap1))
- maps = nconc2 (Faccessible_keymaps (get_keymap (keymap1), Qnil),
- Faccessible_keymaps (get_keymap (current_global_map),
- Qnil));
- else
- maps = Faccessible_keymaps (get_keymap (current_global_map), Qnil);
-
- /* Put the minor mode keymaps on the front. */
- if (! keymap_specified)
+ found = keymaps;
+ while (CONSP (found))
{
- Lisp_Object minors;
- minors = Fnreverse (Fcurrent_minor_mode_maps ());
- while (!NILP (minors))
- {
- maps = nconc2 (Faccessible_keymaps (get_keymap (XCONS (minors)->car),
- Qnil),
- maps);
- minors = XCONS (minors)->cdr;
- }
+ maps =
+ nconc2 (maps,
+ Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
+ found = XCDR (found);
}
-
- GCPRO5 (definition, keymap, maps, found, sequences);
+
+ GCPRO5 (definition, keymaps, maps, found, sequences);
found = Qnil;
sequences = Qnil;
last_is_meta = (XINT (last) >= 0
&& EQ (Faref (this, last), meta_prefix_char));
+ /* if (nomenus && !ascii_sequence_p (this)) */
+ if (nomenus && XINT (last) >= 0
+ && !INTEGERP (Faref (this, make_number (0))))
+ /* 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))
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;
+ elt = XCAR (map);
+ map = XCDR (map);
sequences = Qnil;
/* In a vector, look at each element. */
for (i = 0; i < XVECTOR (elt)->size; i++)
{
- binding = XVECTOR (elt)->contents[i];
+ binding = AREF (elt, i);
XSETFASTINT (key, i);
sequence = where_is_internal_1 (binding, key, definition,
- noindirect, keymap, this,
+ noindirect, this,
last, nomenus, last_is_meta);
if (!NILP (sequence))
sequences = Fcons (sequence, sequences);
Lisp_Object args;
args = Fcons (Fcons (Fcons (definition, noindirect),
- Fcons (keymap, Qnil)),
+ Qnil), /* Result accumulator. */
Fcons (Fcons (this, last),
Fcons (make_number (nomenus),
make_number (last_is_meta))));
-
map_char_table (where_is_internal_2, Qnil, elt, args,
0, indices);
- sequences = XCONS (XCONS (XCONS (args)->car)->cdr)->cdr;
+ sequences = XCDR (XCAR (args));
}
else if (CONSP (elt))
{
Lisp_Object sequence;
- key = XCONS (elt)->car;
- binding = XCONS (elt)->cdr;
+ key = XCAR (elt);
+ binding = XCDR (elt);
sequence = where_is_internal_1 (binding, key, definition,
- noindirect, keymap, this,
+ noindirect, this,
last, nomenus, last_is_meta);
if (!NILP (sequence))
sequences = Fcons (sequence, sequences);
}
- for (; ! NILP (sequences); sequences = XCONS (sequences)->cdr)
+ for (; !NILP (sequences); sequences = XCDR (sequences))
{
Lisp_Object sequence;
- sequence = XCONS (sequences)->car;
+ sequence = XCAR (sequences);
+
+ /* Verify that this key binding is not shadowed by another
+ binding for the same key, before we say it exists.
+
+ Mechanism: look for local definition of this key and if
+ it is defined and does not match what we found then
+ ignore this key.
+
+ Either nil or number as value from Flookup_key
+ means undefined. */
+ if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
+ continue;
/* It is a true unshadowed match. Record it, unless it's already
been seen (as could happen when inheriting keymaps). */
we find. */
if (EQ (firstonly, Qnon_ascii))
RETURN_UNGCPRO (sequence);
- else if (! NILP (firstonly) && ascii_sequence_p (sequence))
+ else if (!NILP (firstonly) && ascii_sequence_p (sequence))
RETURN_UNGCPRO (sequence);
}
}
/* firstonly may have been t, but we may have gone all the way through
the keymaps without finding an all-ASCII key sequence. So just
return the best we could find. */
- if (! NILP (firstonly))
+ 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)
+ Lisp_Object definition, keymap;
+ Lisp_Object firstonly, noindirect;
+{
+ Lisp_Object sequences, keymaps;
+ /* 1 means ignore all menu bindings entirely. */
+ int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
+ Lisp_Object result;
+
+ /* Find the relevant keymaps. */
+ if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
+ keymaps = keymap;
+ else if (!NILP (keymap))
+ keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
+ else
+ keymaps = Fcurrent_active_maps (Qnil);
+
+ /* Only use caching for the menubar (i.e. called with (def nil t nil).
+ We don't really need to check `keymap'. */
+ if (nomenus && NILP (noindirect) && NILP (keymap))
+ {
+ Lisp_Object *defns;
+ int i, j, n;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+ /* Check heuristic-consistency of the cache. */
+ if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
+ where_is_cache = Qnil;
+
+ if (NILP (where_is_cache))
+ {
+ /* We need to create the cache. */
+ 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);
+ UNGCPRO;
+
+ where_is_cache_keymaps = keymaps;
+ }
+
+ /* We want to process definitions from the last to the first.
+ Instead of consing, copy definitions to a vector and step
+ over that vector. */
+ sequences = Fgethash (definition, where_is_cache, Qnil);
+ n = XINT (Flength (sequences));
+ 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);
+ result = Qnil;
+ j = -1;
+ for (i = n - 1; i >= 0; --i)
+ if (EQ (shadow_lookup (keymaps, defns[i], Qnil), definition))
+ {
+ if (ascii_sequence_p (defns[i]))
+ break;
+ else if (j < 0)
+ j = i;
+ }
+
+ result = i >= 0 ? defns[i] : (j >= 0 ? defns[j] : Qnil);
+ UNGCPRO;
+ }
+ else
+ {
+ /* 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);
+ }
+
+ return result;
+}
+
/* This is the function that Fwhere_is_internal calls using map_char_table.
ARGS has the form
(((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
.
((THIS . LAST) . (NOMENUS . LAST_IS_META)))
Since map_char_table doesn't really use the return value from this function,
- we the result append to RESULT, the slot in ARGS. */
+ we the result append to RESULT, the slot in ARGS.
+
+ This function can GC because it calls where_is_internal_1 which can
+ GC. */
static void
where_is_internal_2 (args, key, binding)
Lisp_Object args, key, binding;
{
- Lisp_Object definition, noindirect, keymap, this, last;
+ Lisp_Object definition, noindirect, this, last;
Lisp_Object result, sequence;
int nomenus, last_is_meta;
+ struct gcpro gcpro1, gcpro2, gcpro3;
- 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);
+ GCPRO3 (args, key, binding);
+ result = XCDR (XCAR (args));
+ definition = XCAR (XCAR (XCAR (args)));
+ noindirect = XCDR (XCAR (XCAR (args)));
+ this = XCAR (XCAR (XCDR (args)));
+ last = XCDR (XCAR (XCDR (args)));
+ nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
+ last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));
- sequence = where_is_internal_1 (binding, key, definition, noindirect, keymap,
+ sequence = where_is_internal_1 (binding, key, definition, noindirect,
this, last, nomenus, last_is_meta);
if (!NILP (sequence))
- XCONS (XCONS (XCONS (args)->car)->cdr)->cdr
- = Fcons (sequence, result);
+ XCDR (XCAR (args)) = Fcons (sequence, result);
+
+ UNGCPRO;
}
+
+/* This function cannot GC. */
+
static Lisp_Object
-where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last,
+where_is_internal_1 (binding, key, definition, noindirect, this, last,
nomenus, last_is_meta)
- Lisp_Object binding, key, definition, noindirect, keymap, this, last;
+ Lisp_Object binding, key, definition, noindirect, 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);
- }
+ 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;
+ if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */
+ || EQ (binding, definition)
+ || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
+ /* Doesn't match. */
+ return Qnil;
- /* We have found a match.
- Construct the key sequence where we found it. */
+ /* We have found a match. Construct the key sequence where we found it. */
if (INTEGERP (key) && last_is_meta)
{
sequence = Fcopy_sequence (this);
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)
+ if (!NILP (where_is_cache))
{
- 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;
- }
+ Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
+ Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
+ return Qnil;
}
else
- {
- binding = Fkey_binding (sequence, Qnil);
- if (!EQ (binding, definition))
- return Qnil;
- }
-
- return sequence;
+ return sequence;
}
\f
/* describe-bindings - summarizing all the bindings in a set of keymaps. */
return Qnil;
}
-/* ARG is (BUFFER PREFIX MENU-FLAG). */
-
-static Lisp_Object
-describe_buffer_bindings (arg)
- Lisp_Object arg;
+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)
+ Lisp_Object buffer, prefix, menus;
{
- Lisp_Object descbuf, prefix, shadow;
- int nomenu;
+ Lisp_Object outbuf, shadow;
+ int nomenu = NILP (menus);
register Lisp_Object start1;
struct gcpro gcpro1;
You type Translation\n\
-------- -----------\n";
- descbuf = XCONS (arg)->car;
- 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);
+ outbuf = Fcurrent_buffer();
/* Report on alternates for keys. */
if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
for (c = 0; c < translate_len; c++)
if (translate[c] != c)
{
- char buf[20];
+ char buf[KEY_DESCRIPTION_SIZE];
char *bufend;
if (alternate_heading)
alternate_heading = 0;
}
- bufend = push_key_description (translate[c], buf);
+ bufend = push_key_description (translate[c], buf, 1);
insert (buf, bufend - buf);
Findent_to (make_number (16), make_number (1));
- bufend = push_key_description (c, buf);
+ bufend = push_key_description (c, buf, 1);
insert (buf, bufend - buf);
insert ("\n", 1);
int i, nmaps;
Lisp_Object *modes, *maps;
- /* Temporarily switch to descbuf, so that we can get that buffer's
+ /* Temporarily switch to `buffer', so that we can get that buffer's
minor modes correctly. */
- Fset_buffer (descbuf);
+ 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 (Vstandard_output);
+ Fset_buffer (outbuf);
/* Print the minor mode maps. */
for (i = 0; i < nmaps; i++)
if (!SYMBOLP (modes[i]))
abort();
- p = title = (char *) alloca (40 + XSYMBOL (modes[i])->name->size);
+ 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);
else if (!NILP (Voverriding_local_map))
start1 = Voverriding_local_map;
else
- start1 = XBUFFER (descbuf)->keymap;
+ start1 = XBUFFER (buffer)->keymap;
if (!NILP (start1))
{
describe_map_tree (start1, 1, shadow, prefix,
- "Major Mode Bindings", nomenu, 0, 0);
+ "\f\nMajor Mode Bindings", nomenu, 0, 0);
shadow = Fcons (start1, shadow);
}
describe_map_tree (current_global_map, 1, shadow, prefix,
- "Global Bindings", nomenu, 0, 1);
+ "\f\nGlobal 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);
+ "\f\nFunction key map translations", nomenu, 1, 0);
- call0 (intern ("help-mode"));
- Fset_buffer (descbuf);
UNGCPRO;
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
Lisp_Object list;
/* Delete from MAPS each element that is for the menu bar. */
- for (list = maps; !NILP (list); list = XCONS (list)->cdr)
+ for (list = maps; !NILP (list); list = XCDR (list))
{
Lisp_Object elt, prefix, tem;
sub_shadows = Qnil;
- for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
+ for (tail = shadow; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object shmap;
- shmap = XCONS (tail)->car;
+ shmap = XCAR (tail);
/* If the sequence by which we reach this keymap is zero-length,
then the shadow map for this keymap is just SHADOW. */
/* If shmap is not nil and not a keymap,
it completely shadows this map, so don't
describe this map at all. */
- if (!NILP (shmap) && NILP (Fkeymapp (shmap)))
+ if (!NILP (shmap) && !KEYMAPP (shmap))
goto skip;
if (!NILP (shmap))
}
/* Maps we have already listed in this loop shadow this map. */
- for (tail = orig_maps; ! EQ (tail, maps); tail = XCDR (tail))
+ for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
{
Lisp_Object tem;
tem = Fequal (Fcar (XCAR (tail)), prefix);
- if (! NILP (tem))
+ if (!NILP (tem))
sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
}
}
else if (STRINGP (definition) || VECTORP (definition))
insert_string ("Keyboard Macro\n");
+ else if (KEYMAPP (definition))
+ insert_string ("Prefix Command\n");
else
- {
- tem1 = Fkeymapp (definition);
- if (!NILP (tem1))
- insert_string ("Prefix Command\n");
- else
- insert_string ("??\n");
- }
+ insert_string ("??\n");
}
static void
insert1 (Fkey_description (definition));
insert_string ("\n");
}
+ else if (KEYMAPP (definition))
+ insert_string ("Prefix Command\n");
else
- {
- tem1 = Fkeymapp (definition);
- if (!NILP (tem1))
- insert_string ("Prefix Command\n");
- else
- insert_string ("??\n");
- }
-}
-
-/* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
- Returns the first non-nil binding found in any of those maps. */
-
-static Lisp_Object
-shadow_lookup (shadow, key, flag)
- Lisp_Object shadow, key, flag;
-{
- Lisp_Object tail, value;
-
- for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
- {
- value = Flookup_key (XCONS (tail)->car, key, flag);
- if (!NILP (value))
- return value;
- }
- return Qnil;
+ insert_string ("??\n");
}
/* Describe the contents of map MAP, assuming that this map itself is
int first = 1;
struct gcpro gcpro1, gcpro2, gcpro3;
+ suppress = Qnil;
+
if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
{
/* Call Fkey_description first, to avoid GC bug for the other string. */
GCPRO3 (elt_prefix, definition, kludge);
- for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr)
+ for (tail = map; CONSP (tail); tail = XCDR (tail))
{
QUIT;
- if (VECTORP (XCONS (tail)->car)
- || CHAR_TABLE_P (XCONS (tail)->car))
- describe_vector (XCONS (tail)->car,
+ if (VECTORP (XCAR (tail))
+ || CHAR_TABLE_P (XCAR (tail)))
+ describe_vector (XCAR (tail),
elt_prefix, elt_describer, partial, shadow, map,
(int *)0, 0);
- else if (CONSP (XCONS (tail)->car))
+ else if (CONSP (XCAR (tail)))
{
- event = XCONS (XCONS (tail)->car)->car;
+ event = XCAR (XCAR (tail));
/* Ignore bindings whose "keys" are not really valid events.
(We get these in the frames and buffers menu.) */
- if (! (SYMBOLP (event) || INTEGERP (event)))
+ if (!(SYMBOLP (event) || INTEGERP (event)))
continue;
if (nomenu && EQ (event, Qmenu_bar))
continue;
- definition = get_keyelt (XCONS (XCONS (tail)->car)->cdr, 0);
+ definition = get_keyelt (XCDR (XCAR (tail)), 0);
/* Don't show undefined commands or suppressed commands. */
if (NILP (definition)) continue;
/* Don't show a command that isn't really visible
because a local definition of the same key shadows it. */
- XVECTOR (kludge)->contents[0] = event;
+ ASET (kludge, 0, event);
if (!NILP (shadow))
{
tem = shadow_lookup (shadow, kludge, Qt);
}
tem = Flookup_key (map, kludge, Qt);
- if (! EQ (tem, definition)) continue;
+ if (!EQ (tem, definition)) continue;
if (first)
{
insert1 (elt_prefix);
/* THIS gets the string to describe the character EVENT. */
- insert1 (Fsingle_key_description (event));
+ insert1 (Fsingle_key_description (event, Qnil));
/* 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);
}
- else if (EQ (XCONS (tail)->car, Qkeymap))
+ else if (EQ (XCAR (tail), Qkeymap))
{
/* The same keymap might be in the structure twice, if we're
using an inherited keymap. So skip anything we've already
encountered. */
tem = Fassq (tail, *seen);
- if (CONSP (tem) && !NILP (Fequal (XCONS (tem)->car, keys)))
+ if (CONSP (tem) && !NILP (Fequal (XCAR (tem), keys)))
break;
*seen = Fcons (Fcons (tail, keys), *seen);
}
Lisp_Object suppress;
Lisp_Object kludge;
int first = 1;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ struct gcpro gcpro1, gcpro2, gcpro3;
/* 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
int character;
int starting_i;
+ suppress = Qnil;
+
if (indices == 0)
indices = (int *) alloca (3 * sizeof (int));
= get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
}
else
- definition = get_keyelt (XVECTOR (vector)->contents[i], 0);
+ definition = get_keyelt (AREF (vector, i), 0);
if (NILP (definition)) continue;
}
else if (complete_char)
{
- character
- = MAKE_NON_ASCII_CHAR (indices[0], indices[1], indices[2]);
+ character = MAKE_CHAR (indices[0], indices[1], indices[2]);
}
else
character = 0;
{
Lisp_Object tem;
- XVECTOR (kludge)->contents[0] = make_number (character);
+ ASET (kludge, 0, make_number (character));
tem = shadow_lookup (shadow, kludge, Qt);
if (!NILP (tem)) continue;
{
Lisp_Object tem;
- XVECTOR (kludge)->contents[0] = make_number (character);
+ ASET (kludge, 0, make_number (character));
tem = Flookup_key (entire_map, kludge, Qt);
- if (! EQ (tem, definition))
+ if (!EQ (tem, definition))
continue;
}
else if (CHAR_TABLE_P (vector))
{
if (complete_char)
- insert1 (Fsingle_key_description (make_number (character)));
+ insert1 (Fsingle_key_description (make_number (character), Qnil));
else
{
/* Print the information for this character set. */
}
else
{
- insert1 (Fsingle_key_description (make_number (character)));
+ insert1 (Fsingle_key_description (make_number (character), Qnil));
}
/* If we find a sub char-table within a char-table,
}
else
while (i + 1 < to
- && (tem2 = get_keyelt (XVECTOR (vector)->contents[i + 1], 0),
+ && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
!NILP (tem2))
&& !NILP (Fequal (tem2, definition)))
i++;
{
if (char_table_depth == 0)
{
- insert1 (Fsingle_key_description (make_number (i)));
+ insert1 (Fsingle_key_description (make_number (i), Qnil));
}
else if (complete_char)
{
indices[char_table_depth] = i;
- character
- = MAKE_NON_ASCII_CHAR (indices[0], indices[1], indices[2]);
+ character = MAKE_CHAR (indices[0], indices[1], indices[2]);
insert_char (character);
}
else
}
else
{
- insert1 (Fsingle_key_description (make_number (i)));
+ insert1 (Fsingle_key_description (make_number (i), Qnil));
}
}
void
syms_of_keymap ()
{
- Lisp_Object tem;
-
Qkeymap = intern ("keymap");
staticpro (&Qkeymap);
Qmenu_item = intern ("menu-item");
staticpro (&Qmenu_item);
+ where_is_cache_keymaps = Qt;
+ where_is_cache = Qnil;
+ staticpro (&where_is_cache);
+ staticpro (&where_is_cache_keymaps);
+
defsubr (&Skeymapp);
defsubr (&Skeymap_parent);
+ defsubr (&Skeymap_prompt);
defsubr (&Sset_keymap_parent);
defsubr (&Smake_keymap);
defsubr (&Smake_sparse_keymap);
defsubr (&Scurrent_local_map);
defsubr (&Scurrent_global_map);
defsubr (&Scurrent_minor_mode_maps);
+ defsubr (&Scurrent_active_maps);
defsubr (&Saccessible_keymaps);
defsubr (&Skey_description);
defsubr (&Sdescribe_vector);
defsubr (&Stext_char_description);
defsubr (&Swhere_is_internal);
defsubr (&Sdescribe_bindings_internal);
+ defsubr (&Sdescribe_buffer_bindings);
defsubr (&Sapropos_internal);
}
void
keys_of_keymap ()
{
- Lisp_Object tem;
-
initial_define_key (global_map, 033, "ESC-prefix");
initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
}
HCoop / bpt / emacs.git / blobdiff