X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/20218e2f8a29a2dc1479e2c933b9e72ded9937eb..c7b6dfa6df76885853be8cadf06d8905e1310940:/src/keymap.c diff --git a/src/keymap.c b/src/keymap.c index 22846bb7ef..e5890f59a2 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1,5 +1,5 @@ /* Manipulation of keymaps - Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc. + Copyright (C) 1985, 86, 87, 88, 93, 94 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -18,13 +18,15 @@ along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ -#include "config.h" +#include #include #undef NULL #include "lisp.h" #include "commands.h" #include "buffer.h" #include "keyboard.h" +#include "termhooks.h" +#include "blockinput.h" #define min(a, b) ((a) < (b) ? (a) : (b)) @@ -71,24 +73,26 @@ Lisp_Object Vminor_mode_map_alist; documentation. */ Lisp_Object Vfunction_key_map; -Lisp_Object Qkeymapp, Qkeymap; - -/* A char over 0200 in a key sequence - is equivalent to prefixing with this character. */ +Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii; +/* 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 + character. */ extern Lisp_Object meta_prefix_char; +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_map (); -static void describe_map_2 (); /* 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 128-element vector which holds the bindings for the ASCII\n\ +VECTOR is a vector which 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\ @@ -128,13 +132,7 @@ in case you use it as a menu with `x-popup-menu'.") For example: - initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); - - I haven't extended these to allow the initializing code to bind - function keys and mouse events; since they are called by many files, - I'd have to fix lots of callers, and nobody right now would be using - the new functionality, so it seems like a waste of time. But there's - no technical reason not to. -JimB */ + initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */ void initial_define_key (keymap, key, defname) @@ -145,6 +143,15 @@ initial_define_key (keymap, key, defname) store_in_keymap (keymap, make_number (key), intern (defname)); } +void +initial_define_lispy_key (keymap, keyname, defname) + Lisp_Object keymap; + char *keyname; + char *defname; +{ + 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. */ @@ -156,8 +163,8 @@ synkey (frommap, fromchar, tomap, tochar) int fromchar, tochar; { Lisp_Object v, c; - XSET (v, Lisp_Vector, tomap); - XFASTINT (c) = tochar; + XSETVECTOR (v, tomap); + XSETFASTINT (c, tochar); frommap->contents[fromchar] = Fcons (v, c); } #endif /* 0 */ @@ -165,94 +172,165 @@ synkey (frommap, fromchar, tomap, tochar) DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0, "Return t if ARG is a keymap.\n\ \n\ -A keymap is list (keymap . ALIST), a list (keymap VECTOR . ALIST),\n\ -or a symbol whose function definition is a keymap is itself a keymap.\n\ +A keymap is a list (keymap . ALIST),\n\ +or a symbol whose function definition is itself a keymap.\n\ ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\ -VECTOR is a 128-element vector of bindings for ASCII characters.") +a vector of densely packed bindings for small character codes\n\ +is also allowed as an element.") (object) Lisp_Object object; { - return (NILP (get_keymap_1 (object, 0)) ? Qnil : Qt); + return (NILP (get_keymap_1 (object, 0, 0)) ? Qnil : Qt); } /* Check that OBJECT is a keymap (after dereferencing through any - symbols). If it is, return it; otherwise, return nil, or signal an - error if ERROR != 0. */ + symbols). If it is, return it. + + If AUTOLOAD is non-zero and OBJECT is a symbol whose function value + is an autoload form, do the autoload and try again. + If AUTOLOAD is nonzero, callers must assume GC is possible. + + ERROR controls how we respond if OBJECT isn't a keymap. + If ERROR is non-zero, signal an error; otherwise, just return Qnil. + + Note that most of the time, we don't want to pursue autoloads. + 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. */ + Lisp_Object -get_keymap_1 (object, error) +get_keymap_1 (object, error, autoload) Lisp_Object object; - int error; + int error, autoload; { - register Lisp_Object tem; + Lisp_Object tem; + autoload_retry: 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)) + { + Lisp_Object tail; + + tail = Fnth (make_number (4), tem); + if (EQ (tail, Qkeymap)) + { + struct gcpro gcpro1, gcpro2; + + GCPRO2 (tem, object); + do_autoload (tem, object); + UNGCPRO; + + goto autoload_retry; + } + } + 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); + return get_keymap_1 (object, 1, 0); } /* Look up IDX in MAP. IDX may be any sort of event. Note that this does only one level of lookup; IDX must be a single - event, not a sequence. */ + event, not a sequence. + + If T_OK is non-zero, bindings for Qt are treated as default + bindings; any key left unmentioned by other tables and bindings is + given the binding of Qt. + + If T_OK is zero, bindings for Qt are not treated specially. + + If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */ Lisp_Object -access_keymap (map, idx) +access_keymap (map, idx, t_ok, noinherit) Lisp_Object map; Lisp_Object idx; + int t_ok; + int noinherit; { + int noprefix = 0; + Lisp_Object val; + /* If idx is a list (some sort of mouse click, perhaps?), the index we want to use is the car of the list, which ought to be a symbol. */ - if (EVENT_HAS_PARAMETERS (idx)) - idx = EVENT_HEAD (idx); - - if (XTYPE (idx) == Lisp_Int - && (XINT (idx) < 0 || XINT (idx) >= DENSE_TABLE_SIZE)) - error ("only ASCII characters may used as keymap indices"); + idx = EVENT_HEAD (idx); /* If idx is a symbol, it might have modifiers, which need to be put in the canonical order. */ - else if (XTYPE (idx) == Lisp_Symbol) + if (SYMBOLP (idx)) idx = reorder_modifiers (idx); + else if (INTEGERP (idx)) + /* Clobber the high bits that can be present on a machine + with more than 24 bits of integer. */ + XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1))); { Lisp_Object tail; + Lisp_Object t_binding; + t_binding = Qnil; for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr) { - Lisp_Object binding = XCONS (tail)->car; + Lisp_Object binding; - switch (XTYPE (binding)) + binding = XCONS (tail)->car; + 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)) + noprefix = 1; + } + else if (CONSP (binding)) { - case Lisp_Cons: if (EQ (XCONS (binding)->car, idx)) - return XCONS (binding)->cdr; - break; - - case Lisp_Vector: - if (XVECTOR (binding)->size == DENSE_TABLE_SIZE - && XTYPE (idx) == Lisp_Int) - return XVECTOR (binding)->contents[XINT (idx)]; - break; + { + val = XCONS (binding)->cdr; + if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) + return Qnil; + return val; + } + if (t_ok && EQ (XCONS (binding)->car, Qt)) + t_binding = XCONS (binding)->cdr; + } + 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)) + return Qnil; + return val; + } } QUIT; } - } - return Qnil; + return t_binding; + } } /* Given OBJECT which was found in a slot in a keymap, @@ -262,35 +340,47 @@ access_keymap (map, idx) and INDEX is the object to look up in KEYMAP to yield the definition. Also if OBJECT has a menu string as the first element, - remove that. Also remove a menu help string as second element. */ + remove that. Also remove a menu help string as second element. + + If AUTOLOAD is nonzero, load autoloadable keymaps + that are referred to with indirection. */ Lisp_Object -get_keyelt (object) +get_keyelt (object, autoload) register Lisp_Object object; + int autoload; { while (1) { register Lisp_Object map, tem; /* If the contents are (KEYMAP . ELEMENT), go indirect. */ - map = get_keymap_1 (Fcar_safe (object), 0); + map = get_keymap_1 (Fcar_safe (object), 0, autoload); tem = Fkeymapp (map); if (!NILP (tem)) - object = access_keymap (map, Fcdr (object)); + object = access_keymap (map, Fcdr (object), 0, 0); /* 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 (XTYPE (object) == Lisp_Cons - && XTYPE (XCONS (object)->car) == Lisp_String) + else if (CONSP (object) + && STRINGP (XCONS (object)->car)) { object = XCONS (object)->cdr; /* Also remove a menu help string, if any, following the menu item name. */ - if (XTYPE (object) == Lisp_Cons - && XTYPE (XCONS (object)->car) == Lisp_String) + if (CONSP (object) && STRINGP (XCONS (object)->car)) object = XCONS (object)->cdr; + /* Also remove the sublist that caches key equivalences, if any. */ + if (CONSP (object) + && CONSP (XCONS (object)->car)) + { + Lisp_Object carcar; + carcar = XCONS (XCONS (object)->car)->car; + if (NILP (carcar) || VECTORP (carcar)) + object = XCONS (object)->cdr; + } } else @@ -305,25 +395,28 @@ store_in_keymap (keymap, idx, def) register Lisp_Object idx; register Lisp_Object def; { - if (XTYPE (keymap) != Lisp_Cons - || ! EQ (XCONS (keymap)->car, Qkeymap)) + /* If we are preparing to dump, and DEF is a menu element + with a menu item string, copy it to ensure it is not pure. */ + if (!NILP (Vpurify_flag) && CONSP (def) + && 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"); /* If idx is a list (some sort of mouse click, perhaps?), the index we want to use is the car of the list, which ought to be a symbol. */ - if (EVENT_HAS_PARAMETERS (idx)) - idx = EVENT_HEAD (idx); - - if (XTYPE (idx) == Lisp_Int - && (XINT (idx) < 0 || XINT (idx) >= DENSE_TABLE_SIZE)) - error ("only ASCII characters may be used as keymap indices"); + idx = EVENT_HEAD (idx); /* If idx is a symbol, it might have modifiers, which need to be put in the canonical order. */ - else if (XTYPE (idx) == Lisp_Symbol) + if (SYMBOLP (idx)) idx = reorder_modifiers (idx); - + else if (INTEGERP (idx)) + /* Clobber the high bits that can be present on a machine + with more than 24 bits of integer. */ + XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1))); /* Scan the keymap for a binding of idx. */ { @@ -335,47 +428,49 @@ store_in_keymap (keymap, idx, def) towards the front of the alist and character lookups in dense keymaps will remain fast. Otherwise, this just points at the front of the keymap. */ - Lisp_Object insertion_point = keymap; + Lisp_Object insertion_point; + insertion_point = keymap; for (tail = XCONS (keymap)->cdr; CONSP (tail); tail = XCONS (tail)->cdr) { - Lisp_Object elt = XCONS (tail)->car; + Lisp_Object elt; - switch (XTYPE (elt)) + elt = XCONS (tail)->car; + if (VECTORP (elt)) { - case Lisp_Vector: - if (XTYPE (idx) == Lisp_Int) + 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 (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; @@ -398,26 +493,56 @@ is not copied.") for (tail = copy; CONSP (tail); tail = XCONS (tail)->cdr) { - Lisp_Object elt = XCONS (tail)->car; + Lisp_Object elt; - if (XTYPE (elt) == Lisp_Vector - && XVECTOR (elt)->size == DENSE_TABLE_SIZE) + elt = XCONS (tail)->car; + if (VECTORP (elt)) { int i; elt = Fcopy_sequence (elt); XCONS (tail)->car = elt; - for (i = 0; i < DENSE_TABLE_SIZE; i++) - if (XTYPE (XVECTOR (elt)->contents[i]) != Lisp_Symbol - && Fkeymapp (XVECTOR (elt)->contents[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]); } - else if (CONSP (elt) - && XTYPE (XCONS (elt)->cdr) != Lisp_Symbol - && ! NILP (Fkeymapp (XCONS (elt)->cdr))) - XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr); + else if (CONSP (elt)) + { + /* Skip the optional menu string. */ + if (CONSP (XCONS (elt)->cdr) + && STRINGP (XCONS (XCONS (elt)->cdr)->car)) + { + Lisp_Object tem; + + /* 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); + elt = XCONS (elt)->cdr; + + /* Also skip the optional menu help string. */ + if (CONSP (XCONS (elt)->cdr) + && STRINGP (XCONS (XCONS (elt)->cdr)->car)) + { + XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car, + XCONS (XCONS (elt)->cdr)->cdr); + elt = XCONS (elt)->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); + } } return copy; @@ -425,10 +550,14 @@ is not copied.") /* Simple Keymap mutators and accessors. */ +/* GC is possible in this function if it autoloads a keymap. */ + DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0, "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\ KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\ meaning a sequence of keystrokes and events.\n\ +Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\ +can be included if you use a vector.\n\ DEF is anything that can be a key's definition:\n\ nil (means key is undefined in this keymap),\n\ a command (a Lisp function suitable for interactive calling)\n\ @@ -444,7 +573,7 @@ DEF is anything that can be a key's definition:\n\ If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\ the front of KEYMAP.") (keymap, key, def) - register Lisp_Object keymap; + Lisp_Object keymap; Lisp_Object key; Lisp_Object def; { @@ -453,25 +582,36 @@ the front of KEYMAP.") register Lisp_Object tem; register Lisp_Object cmd; int metized = 0; + int meta_bit; int length; + struct gcpro gcpro1, gcpro2, gcpro3; - keymap = get_keymap (keymap); + keymap = get_keymap_1 (keymap, 1, 1); - if (XTYPE (key) != Lisp_Vector - && XTYPE (key) != Lisp_String) + if (!VECTORP (key) && !STRINGP (key)) key = wrong_type_argument (Qarrayp, key); - length = Flength (key); + length = XFASTINT (Flength (key)); if (length == 0) return Qnil; + GCPRO3 (keymap, key, def); + + if (VECTORP (key)) + meta_bit = meta_modifier; + else + meta_bit = 0x80; + idx = 0; while (1) { c = Faref (key, make_number (idx)); - if (XTYPE (c) == Lisp_Int - && XINT (c) >= 0200 + if (CONSP (c) && lucid_event_type_list_p (c)) + c = convert_event_type_list (c); + + if (INTEGERP (c) + && (XINT (c) & meta_bit) && !metized) { c = meta_prefix_char; @@ -479,46 +619,56 @@ the front of KEYMAP.") } else { - if (XTYPE (c) == Lisp_Int) - XSETINT (c, XINT (c) & 0177); + if (INTEGERP (c)) + XSETINT (c, XINT (c) & ~meta_bit); metized = 0; idx++; } + if (! INTEGERP (c) && ! SYMBOLP (c) && ! CONSP (c)) + error ("Key sequence contains invalid events"); + if (idx == length) - return store_in_keymap (keymap, c, def); + RETURN_UNGCPRO (store_in_keymap (keymap, c, def)); - cmd = get_keyelt (access_keymap (keymap, c)); + cmd = get_keyelt (access_keymap (keymap, c, 0, 1), 1); + /* If this key is undefined, make it a prefix. */ if (NILP (cmd)) - { - cmd = Fmake_sparse_keymap (Qnil); - store_in_keymap (keymap, c, cmd); - } + cmd = define_as_prefix (keymap, c); - tem = Fkeymapp (cmd); - if (NILP (tem)) + keymap = get_keymap_1 (cmd, 0, 1); + if (NILP (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", - XSTRING (key)->data); - - keymap = get_keymap (cmd); + XSTRING (Fkey_description (key))->data); } } /* Value is number if KEY is too long; NIL if valid but has no definition. */ +/* GC is possible in this function if it autoloads a keymap. */ -DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 2, 0, +DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\ nil means undefined. See doc of `define-key' for kinds of definitions.\n\ +\n\ A number as value means KEY is \"too long\";\n\ that is, characters or symbols in it except for the last one\n\ fail to be a valid sequence of prefix characters in KEYMAP.\n\ The number is how many characters at the front of KEY\n\ -it takes to reach a non-prefix command.") - (keymap, key) +it takes to reach a non-prefix command.\n\ +\n\ +Normally, `lookup-key' ignores bindings for t, which act as default\n\ +bindings, used when nothing else in the keymap applies; this makes it\n\ +useable as a general function for probing keymaps. However, if the\n\ +third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\ +recognize the default bindings, just as `read-key-sequence' does.") + (keymap, key, accept_default) register Lisp_Object keymap; Lisp_Object key; + Lisp_Object accept_default; { register int idx; register Lisp_Object tem; @@ -526,24 +676,36 @@ it takes to reach a non-prefix command.") register Lisp_Object c; int metized = 0; int length; + int t_ok = ! NILP (accept_default); + int meta_bit; + struct gcpro gcpro1; - keymap = get_keymap (keymap); + keymap = get_keymap_1 (keymap, 1, 1); - if (XTYPE (key) != Lisp_Vector - && XTYPE (key) != Lisp_String) + if (!VECTORP (key) && !STRINGP (key)) key = wrong_type_argument (Qarrayp, key); - length = Flength (key); + length = XFASTINT (Flength (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)); - if (XTYPE (c) == Lisp_Int - && XINT (c) >= 0200 + if (CONSP (c) && lucid_event_type_list_p (c)) + c = convert_event_type_list (c); + + if (INTEGERP (c) + && (XINT (c) & meta_bit) && !metized) { c = meta_prefix_char; @@ -551,29 +713,63 @@ it takes to reach a non-prefix command.") } else { - if (XTYPE (c) == Lisp_Int) - XSETINT (c, XINT (c) & 0177); + if (INTEGERP (c)) + XSETINT (c, XINT (c) & ~meta_bit); metized = 0; idx++; } - cmd = get_keyelt (access_keymap (keymap, c)); + cmd = get_keyelt (access_keymap (keymap, c, t_ok, 0), 1); if (idx == length) - return cmd; + RETURN_UNGCPRO (cmd); - tem = Fkeymapp (cmd); - if (NILP (tem)) - return make_number (idx); + keymap = get_keymap_1 (cmd, 0, 1); + if (NILP (keymap)) + RETURN_UNGCPRO (make_number (idx)); - keymap = get_keymap (cmd); QUIT; } } -/* Append a key to the end of a key sequence. If key_sequence is a - string and key is a character, the result will be another string; - otherwise, it will be a vector. */ +/* Make KEYMAP define event C as a keymap (i.e., as a prefix). + Assume that currently it does not define C at all. + Return the keymap. */ + +static Lisp_Object +define_as_prefix (keymap, c) + Lisp_Object keymap, c; +{ + Lisp_Object inherit, 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 (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); + } + + cmd = nconc2 (cmd, inherit); + store_in_keymap (keymap, c, cmd); + + return cmd; +} + +/* Append a key to the end of a key sequence. We always make a vector. */ + Lisp_Object append_key (key_sequence, key) Lisp_Object key_sequence, key; @@ -582,17 +778,8 @@ append_key (key_sequence, key) args[0] = key_sequence; - if (XTYPE (key_sequence) == Lisp_String - && XTYPE (key) == Lisp_Int) - { - args[1] = Fchar_to_string (key); - return Fconcat (2, args); - } - else - { - args[1] = Fcons (key, Qnil); - return Fvconcat (2, args); - } + args[1] = Fcons (key, Qnil); + return Fvconcat (2, args); } @@ -630,9 +817,9 @@ current_minor_maps (modeptr, mapptr) for (alist = Vminor_mode_map_alist; CONSP (alist); alist = XCONS (alist)->cdr) - if (CONSP (assoc = XCONS (alist)->car) - && XTYPE (var = XCONS (assoc)->car) == Lisp_Symbol - && ! EQ ((val = find_symbol_value (var)), Qunbound) + if ((assoc = XCONS (alist)->car, CONSP (assoc)) + && (var = XCONS (assoc)->car, SYMBOLP (var)) + && (val = find_symbol_value (var), ! EQ (val, Qunbound)) && ! NILP (val)) { if (i >= cmm_size) @@ -641,13 +828,25 @@ current_minor_maps (modeptr, mapptr) if (cmm_maps) { - newmodes = (Lisp_Object *) realloc (cmm_modes, cmm_size *= 2); - newmaps = (Lisp_Object *) realloc (cmm_maps, cmm_size); + 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 { - newmodes = (Lisp_Object *) malloc (cmm_size = 30); - newmaps = (Lisp_Object *) malloc (cmm_size); + 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) @@ -659,7 +858,7 @@ current_minor_maps (modeptr, mapptr) break; } cmm_modes[i] = var; - cmm_maps [i] = XCONS (assoc)->cdr; + cmm_maps [i] = Findirect_function (XCONS (assoc)->cdr); i++; } @@ -668,66 +867,102 @@ current_minor_maps (modeptr, mapptr) return i; } -DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 1, 0, +/* GC is possible in this function if it autoloads a keymap. */ + +DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0, "Return the binding for command KEY in current keymaps.\n\ -KEY is a string, a sequence of keystrokes.\n\ -The binding is probably a symbol with a function definition.") - (key) - Lisp_Object key; +KEY is a string or vector, a sequence of keystrokes.\n\ +The binding is probably a symbol with a function definition.\n\ +\n\ +Normally, `key-binding' ignores bindings for t, which act as default\n\ +bindings, used when nothing else in the keymap applies; this makes it\n\ +usable as a general function for probing keymaps. However, if the\n\ +optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\ +recognize the default bindings, just as `read-key-sequence' does.") + (key, accept_default) + Lisp_Object key, accept_default; { Lisp_Object *maps, value; int nmaps, i; + struct gcpro gcpro1; - nmaps = current_minor_maps (0, &maps); - for (i = 0; i < nmaps; i++) - if (! NILP (maps[i])) - { - value = Flookup_key (maps[i], key); - if (! NILP (value) && XTYPE (value) != Lisp_Int) - return value; - } + GCPRO1 (key); - if (! NILP (current_buffer->keymap)) + if (!NILP (Voverriding_local_map)) { - value = Flookup_key (current_buffer->keymap, key); - if (! NILP (value) && XTYPE (value) != Lisp_Int) - return value; + value = Flookup_key (Voverriding_local_map, key, accept_default); + if (! NILP (value) && !INTEGERP (value)) + RETURN_UNGCPRO (value); } + else + { + nmaps = current_minor_maps (0, &maps); + /* Note that all these maps are GCPRO'd + in the places where we found them. */ - value = Flookup_key (current_global_map, key); - if (! NILP (value) && XTYPE (value) != Lisp_Int) + for (i = 0; i < nmaps; i++) + if (! NILP (maps[i])) + { + value = Flookup_key (maps[i], key, accept_default); + if (! NILP (value) && !INTEGERP (value)) + RETURN_UNGCPRO (value); + } + + if (! NILP (current_buffer->keymap)) + { + value = Flookup_key (current_buffer->keymap, key, accept_default); + if (! NILP (value) && !INTEGERP (value)) + RETURN_UNGCPRO (value); + } + } + + value = Flookup_key (current_global_map, key, accept_default); + UNGCPRO; + if (! NILP (value) && !INTEGERP (value)) return value; return Qnil; } -DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 1, 0, +/* GC is possible in this function if it autoloads a keymap. */ + +DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0, "Return the binding for command KEYS in current local keymap only.\n\ KEYS is a string, a sequence of keystrokes.\n\ -The binding is probably a symbol with a function definition.") - (keys) - Lisp_Object keys; +The binding is probably a symbol with a function definition.\n\ +\n\ +If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\ +bindings; see the description of `lookup-key' for more details about this.") + (keys, accept_default) + Lisp_Object keys, accept_default; { register Lisp_Object map; map = current_buffer->keymap; if (NILP (map)) return Qnil; - return Flookup_key (map, keys); + return Flookup_key (map, keys, accept_default); } -DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 1, 0, +/* GC is possible in this function if it autoloads a keymap. */ + +DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0, "Return the binding for command KEYS in current global keymap only.\n\ KEYS is a string, a sequence of keystrokes.\n\ The binding is probably a symbol with a function definition.\n\ This function's return values are the same as those of lookup-key\n\ -(which see).") - (keys) - Lisp_Object keys; +\(which see).\n\ +\n\ +If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\ +bindings; see the description of `lookup-key' for more details about this.") + (keys, accept_default) + Lisp_Object keys, accept_default; { - return Flookup_key (current_global_map, keys); + return Flookup_key (current_global_map, keys, accept_default); } -DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 1, 0, +/* GC is possible in this function if it autoloads a keymap. */ + +DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0, "Find the visible minor mode bindings of KEY.\n\ Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\ the symbol which names the minor mode binding KEY, and BINDING is\n\ @@ -735,98 +970,43 @@ KEY's definition in that mode. In particular, if KEY has no\n\ minor-mode bindings, return nil. If the first binding is a\n\ non-prefix, all subsequent bindings will be omitted, since they would\n\ be ignored. Similarly, the list doesn't include non-prefix bindings\n\ -that come after prefix bindings.") - (key) +that come after prefix bindings.\n\ +\n\ +If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\ +bindings; see the description of `lookup-key' for more details about this.") + (key, accept_default) + Lisp_Object key, accept_default; { Lisp_Object *modes, *maps; int nmaps; Lisp_Object binding; int i, j; + struct gcpro gcpro1, gcpro2; nmaps = current_minor_maps (&modes, &maps); + /* Note that all these maps are GCPRO'd + in the places where we found them. */ + + binding = Qnil; + GCPRO2 (key, binding); for (i = j = 0; i < nmaps; i++) if (! NILP (maps[i]) - && ! NILP (binding = Flookup_key (maps[i], key)) - && XTYPE (binding) != Lisp_Int) + && ! NILP (binding = Flookup_key (maps[i], key, accept_default)) + && !INTEGERP (binding)) { - if (! NILP (get_keymap_1 (binding, 0))) + if (! NILP (get_keymap (binding))) maps[j++] = Fcons (modes[i], binding); else if (j == 0) - return Fcons (Fcons (modes[i], binding), Qnil); + RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil)); } + UNGCPRO; 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 string representing a sequence of keystrokes.\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 (XTYPE (keys) != Lisp_Vector - && XTYPE (keys) != Lisp_String) - 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 string representing a sequence of keystrokes.\n\ -The binding goes in the current buffer's local map,\n\ -which is shared with 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 (XTYPE (keys) != Lisp_Vector - && XTYPE (keys) != Lisp_String) - 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.\n\ + "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\ @@ -851,6 +1031,8 @@ 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; } @@ -864,6 +1046,7 @@ If KEYMAP is nil, that means no local keymap.") keymap = get_keymap (keymap); current_buffer->keymap = keymap; + record_asynch_buffer_change (); return Qnil; } @@ -894,18 +1077,46 @@ DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_ /* Help functions for describing and documenting keymaps. */ +/* This function cannot GC. */ + DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, - 1, 1, 0, + 1, 2, 0, "Find all keymaps accessible via prefix characters from KEYMAP.\n\ Returns a list of elements of the form (KEYS . MAP), where the sequence\n\ KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\ -so that the KEYS increase in length. The first element is (\"\" . KEYMAP).") - (startmap) - Lisp_Object startmap; +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; { - Lisp_Object maps, tail; + Lisp_Object maps, good_maps, tail; + int prefixlen = 0; + + /* no need for gcpro because we don't autoload any keymaps. */ - maps = Fcons (Fcons (build_string (""), get_keymap (startmap)), Qnil); + if (!NILP (prefix)) + prefixlen = XINT (Flength (prefix)); + + if (!NILP (prefix)) + { + /* 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); + /* 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); + else + return Qnil; + } + else + maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil), + get_keymap (startmap)), + Qnil); /* For each map in the list maps, look at any other maps it points to, @@ -916,31 +1127,36 @@ so that the KEYS increase in length. The first element is (\"\" . KEYMAP).") for (tail = maps; CONSP (tail); tail = XCONS (tail)->cdr) { - register Lisp_Object thisseq = Fcar (Fcar (tail)); - register Lisp_Object thismap = Fcdr (Fcar (tail)); - Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1); - + register Lisp_Object thisseq, thismap; + Lisp_Object last; /* Does the current sequence end in the meta-prefix-char? */ - int is_metized = (XINT (last) >= 0 - && EQ (Faref (thisseq, last), meta_prefix_char)); + int is_metized; + + thisseq = Fcar (Fcar (tail)); + thismap = Fcdr (Fcar (tail)); + last = make_number (XINT (Flength (thisseq)) - 1); + is_metized = (XINT (last) >= 0 + && EQ (Faref (thisseq, last), meta_prefix_char)); for (; CONSP (thismap); thismap = XCONS (thismap)->cdr) { - Lisp_Object elt = XCONS (thismap)->car; + Lisp_Object elt; + + elt = XCONS (thismap)->car; QUIT; - if (XTYPE (elt) == Lisp_Vector) + if (VECTORP (elt)) { register int i; /* Vector keymap. Scan all the elements. */ - for (i = 0; i < DENSE_TABLE_SIZE; i++) + for (i = 0; i < XVECTOR (elt)->size; i++) { register Lisp_Object tem; register Lisp_Object cmd; - cmd = get_keyelt (XVECTOR (elt)->contents[i]); + cmd = get_keyelt (XVECTOR (elt)->contents[i], 0); if (NILP (cmd)) continue; tem = Fkeymapp (cmd); if (!NILP (tem)) @@ -957,14 +1173,16 @@ so that the KEYS increase in length. The first element is (\"\" . KEYMAP).") keymap table. */ if (is_metized) { + int meta_bit = meta_modifier; tem = Fcopy_sequence (thisseq); - Faset (tem, last, make_number (i | 0200)); + + 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); + XCONS (tail)->cdr + = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr); } else { @@ -977,9 +1195,9 @@ so that the KEYS increase in length. The first element is (\"\" . KEYMAP).") } else if (CONSP (elt)) { - register Lisp_Object cmd = get_keyelt (XCONS (elt)->cdr); - register Lisp_Object tem; + 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)) @@ -989,22 +1207,23 @@ so that the KEYS increase in length. The first element is (\"\" . KEYMAP).") tem = Frassq (cmd, maps); if (NILP (tem)) { - /* let elt be the event defined by this map entry. */ + /* 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 && XTYPE (elt) == Lisp_Int) + if (is_metized && INTEGERP (elt)) { tem = Fcopy_sequence (thisseq); - Faset (tem, last, make_number (XINT (elt) | 0200)); + Faset (tem, last, + make_number (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); + XCONS (tail)->cdr + = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr); } else nconc2 (tail, @@ -1016,11 +1235,41 @@ so that the KEYS increase in length. The first element is (\"\" . KEYMAP).") } } - return maps; + if (NILP (prefix)) + return maps; + + /* Now find just the maps whose access prefixes start with PREFIX. */ + + good_maps = Qnil; + for (; CONSP (maps); maps = XCONS (maps)->cdr) + { + Lisp_Object elt, thisseq; + elt = XCONS (maps)->car; + thisseq = XCONS (elt)->car; + /* The access prefix must be at least as long as PREFIX, + and the first elements must match those of PREFIX. */ + if (XINT (Flength (thisseq)) >= prefixlen) + { + int i; + for (i = 0; i < prefixlen; i++) + { + Lisp_Object i1; + XSETFASTINT (i1, i); + if (!EQ (Faref (thisseq, i1), Faref (prefix, i1))) + break; + } + if (i == prefixlen) + good_maps = Fcons (elt, good_maps); + } + } + + return Fnreverse (good_maps); } Lisp_Object Qsingle_key_description, Qkey_description; +/* This function cannot GC. */ + DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0, "Return a pretty description of key-sequence KEYS.\n\ Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\ @@ -1028,7 +1277,45 @@ spaces are put between sequence elements, etc.") (keys) Lisp_Object keys; { - return Fmapconcat (Qsingle_key_description, keys, build_string (" ")); + int len; + int i; + Lisp_Object sep; + Lisp_Object *args; + + if (STRINGP (keys)) + { + Lisp_Object vector; + vector = Fmake_vector (Flength (keys), Qnil); + for (i = 0; i < XSTRING (keys)->size; i++) + { + if (XSTRING (keys)->data[i] & 0x80) + XSETFASTINT (XVECTOR (vector)->contents[i], + meta_modifier | (XSTRING (keys)->data[i] & ~0x80)); + else + XSETFASTINT (XVECTOR (vector)->contents[i], + XSTRING (keys)->data[i]); + } + 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. */ + + 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++) + { + args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i]); + args[i * 2 + 1] = sep; + } + + return Fconcat (len * 2 - 1, args); } char * @@ -1036,11 +1323,44 @@ push_key_description (c, p) register unsigned int c; register char *p; { - if (c >= 0200) + /* Clear all the meaningless bits above the meta bit. */ + c &= meta_modifier | ~ - meta_modifier; + + if (c & alt_modifier) + { + *p++ = 'A'; + *p++ = '-'; + c -= alt_modifier; + } + if (c & ctrl_modifier) + { + *p++ = 'C'; + *p++ = '-'; + c -= ctrl_modifier; + } + if (c & hyper_modifier) + { + *p++ = 'H'; + *p++ = '-'; + c -= hyper_modifier; + } + if (c & meta_modifier) { *p++ = 'M'; *p++ = '-'; - c -= 0200; + c -= meta_modifier; + } + if (c & shift_modifier) + { + *p++ = 'S'; + *p++ = '-'; + c -= shift_modifier; + } + if (c & super_modifier) + { + *p++ = 's'; + *p++ = '-'; + c -= super_modifier; } if (c < 040) { @@ -1050,7 +1370,7 @@ push_key_description (c, p) *p++ = 'S'; *p++ = 'C'; } - else if (c == Ctl('I')) + else if (c == '\t') { *p++ = 'T'; *p++ = 'A'; @@ -1090,37 +1410,45 @@ push_key_description (c, p) *p++ = 'P'; *p++ = 'C'; } - else + else if (c < 256) *p++ = c; + else + { + *p++ = '\\'; + *p++ = (7 & (c >> 15)) + '0'; + *p++ = (7 & (c >> 12)) + '0'; + *p++ = (7 & (c >> 9)) + '0'; + *p++ = (7 & (c >> 6)) + '0'; + *p++ = (7 & (c >> 3)) + '0'; + *p++ = (7 & (c >> 0)) + '0'; + } return p; } +/* This function cannot GC. */ + DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0, "Return a pretty description of command character KEY.\n\ Control characters turn into C-whatever, etc.") (key) Lisp_Object key; { - register unsigned char c; - char tem[6]; + char tem[20]; - if (EVENT_HAS_PARAMETERS (key)) - key = EVENT_HEAD (key); + key = EVENT_HEAD (key); - switch (XTYPE (key)) + if (INTEGERP (key)) /* Normal character */ { - case Lisp_Int: /* Normal character */ - c = XINT (key) & 0377; - *push_key_description (c, tem) = 0; + *push_key_description (XUINT (key), tem) = 0; return build_string (tem); - - case Lisp_Symbol: /* Function key or event-symbol */ - return Fsymbol_name (key); - - default: - error ("KEY must be an integer, cons, or symbol."); } + 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 * @@ -1149,6 +1477,8 @@ push_text_char_description (c, p) return p; } +/* This function cannot GC. */ + DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0, "Return a pretty description of file-character CHAR.\n\ Control characters turn into \"^char\", etc.") @@ -1163,46 +1493,100 @@ Control characters turn into \"^char\", etc.") return build_string (tem); } + +/* Return non-zero if SEQ contains only ASCII characters, perhaps with + a meta bit. */ +static int +ascii_sequence_p (seq) + Lisp_Object seq; +{ + int i; + int len = XINT (Flength (seq)); + + for (i = 0; i < len; i++) + { + Lisp_Object ii, elt; + + XSETFASTINT (ii, i); + elt = Faref (seq, ii); + + if (!INTEGERP (elt) + || (XUINT (elt) & ~CHAR_META) >= 0x80) + return 0; + } + + return 1; +} + /* where-is - finding a command in a set of keymaps. */ -DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0, - "Return list of keys that invoke DEFINITION in KEYMAP or KEYMAP1.\n\ -If KEYMAP is nil, search only KEYMAP1.\n\ -If KEYMAP1 is nil, use the current global map.\n\ +/* 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 4th arg FIRSTONLY is non-nil,\n\ -return a string representing the first key sequence found,\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 5th arg NOINDIRECT is non-nil, don't follow indirections\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, local_keymap, global_keymap, firstonly, noindirect) - Lisp_Object definition, local_keymap, global_keymap; + (definition, keymap, firstonly, noindirect) + Lisp_Object definition, keymap; Lisp_Object firstonly, noindirect; { - register Lisp_Object maps; - Lisp_Object found; + Lisp_Object maps; + Lisp_Object found, sequence; + 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); - if (NILP (global_keymap)) - global_keymap = current_global_map; + if (! keymap_specified) + { +#ifdef USE_TEXT_PROPERTIES + keymap = get_local_map (PT, current_buffer); +#else + keymap = current_buffer->keymap; +#endif + } - if (!NILP (local_keymap)) - maps = nconc2 (Faccessible_keymaps (get_keymap (local_keymap)), - Faccessible_keymaps (get_keymap (global_keymap))); + if (!NILP (keymap)) + maps = nconc2 (Faccessible_keymaps (get_keymap (keymap), Qnil), + Faccessible_keymaps (get_keymap (current_global_map), + Qnil)); else - maps = Faccessible_keymaps (get_keymap (global_keymap)); + maps = Faccessible_keymaps (get_keymap (current_global_map), Qnil); + + /* Put the minor mode keymaps on the front. */ + if (! keymap_specified) + { + 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; + } + } + GCPRO5 (definition, keymap, maps, found, sequence); found = Qnil; + sequence = Qnil; for (; !NILP (maps); maps = Fcdr (maps)) { - /* Key sequence to reach map */ - register Lisp_Object this = Fcar (Fcar (maps)); - - /* The map that it reaches */ - register Lisp_Object map = Fcdr (Fcar (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; @@ -1210,9 +1594,14 @@ indirect definition itself.") /* 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. */ - Lisp_Object last = make_number (XINT (Flength (this)) - 1); - int last_is_meta = (XINT (last) >= 0 - && EQ (Faref (this, last), meta_prefix_char)); + Lisp_Object last; + int last_is_meta; + + this = Fcar (Fcar (maps)); + map = Fcdr (Fcar (maps)); + last = make_number (XINT (Flength (this)) - 1); + last_is_meta = (XINT (last) >= 0 + && EQ (Faref (this, last), meta_prefix_char)); QUIT; @@ -1227,24 +1616,24 @@ indirect definition itself.") advance map to the next element until i indicates that we have finished off the vector. */ - Lisp_Object elt = XCONS (map)->car; - Lisp_Object key, binding, sequence; + Lisp_Object elt, key, binding; + elt = XCONS (map)->car; QUIT; /* Set key and binding to the current key and binding, and advance map and i to the next binding. */ - if (XTYPE (elt) == Lisp_Vector) + if (VECTORP (elt)) { /* In a vector, look at each element. */ binding = XVECTOR (elt)->contents[i]; - XFASTINT (key) = i; + XSETFASTINT (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 >= DENSE_TABLE_SIZE) + if (i >= XVECTOR (elt)->size) { map = XCONS (map)->cdr; i = 0; @@ -1267,12 +1656,33 @@ indirect definition itself.") /* Search through indirections unless that's not wanted. */ if (NILP (noindirect)) - binding = get_keyelt (binding); + { + 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 (STRING ...), reject. */ + if (CONSP (definition) + && STRINGP (XCONS (definition)->car)) + continue; + } + else + binding = get_keyelt (binding, 0); + } /* End this iteration if this element does not match the target. */ - if (XTYPE (definition) == Lisp_Cons) + if (CONSP (definition)) { Lisp_Object tem; tem = Fequal (binding, definition); @@ -1285,10 +1695,10 @@ indirect definition itself.") /* We have found a match. Construct the key sequence where we found it. */ - if (XTYPE (key) == Lisp_Int && last_is_meta) + if (INTEGERP (key) && last_is_meta) { sequence = Fcopy_sequence (this); - Faset (sequence, last, make_number (XINT (key) | 0200)); + Faset (sequence, last, make_number (XINT (key) | meta_modifier)); } else sequence = append_key (this, key); @@ -1302,12 +1712,12 @@ indirect definition itself.") Either nil or number as value from Flookup_key means undefined. */ - if (!NILP (local_keymap)) + if (keymap_specified) { - binding = Flookup_key (local_keymap, sequence); - if (!NILP (binding) && XTYPE (binding) != Lisp_Int) + binding = Flookup_key (keymap, sequence, Qnil); + if (!NILP (binding) && !INTEGERP (binding)) { - if (XTYPE (definition) == Lisp_Cons) + if (CONSP (definition)) { Lisp_Object tem; tem = Fequal (binding, definition); @@ -1319,86 +1729,85 @@ indirect definition itself.") continue; } } + else + { + binding = Fkey_binding (sequence, Qnil); + if (!EQ (binding, definition)) + continue; + } - /* It is a true unshadowed match. Record it. */ - - if (!NILP (firstonly)) - return sequence; - found = Fcons (sequence, found); + /* 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 Fnreverse (found); -} -/* Return a string listing the keys and buttons that run DEFINITION. */ - -static Lisp_Object -where_is_string (definition) - Lisp_Object definition; -{ - register Lisp_Object keys, keys1; + UNGCPRO; - keys = Fwhere_is_internal (definition, - current_buffer->keymap, Qnil, Qnil, Qnil); - keys1 = Fmapconcat (Qkey_description, keys, build_string (", ")); + found = Fnreverse (found); - return keys1; -} - -DEFUN ("where-is", Fwhere_is, Swhere_is, 1, 1, "CWhere is command: ", - "Print message listing key sequences that invoke specified command.\n\ -Argument is a command definition, usually a symbol with a function definition.") - (definition) - Lisp_Object definition; -{ - register Lisp_Object string; - - CHECK_SYMBOL (definition, 0); - string = where_is_string (definition); - - if (XSTRING (string)->size) - message ("%s is on %s", XSYMBOL (definition)->name->data, - XSTRING (string)->data); - else - message ("%s is not on any key", XSYMBOL (definition)->name->data); - return Qnil; + /* 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)) + return Fcar (found); + + return found; } /* describe-bindings - summarizing all the bindings in a set of keymaps. */ -DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 0, "", +DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 1, "", "Show a list of all defined keys, and their definitions.\n\ -The list is put in a buffer, which is displayed.") - () +The list is put in a buffer, which is displayed.\n\ +An 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; { register Lisp_Object thisbuf; - XSET (thisbuf, Lisp_Buffer, current_buffer); + XSETBUFFER (thisbuf, current_buffer); internal_with_output_to_temp_buffer ("*Help*", describe_buffer_bindings, - thisbuf); + Fcons (thisbuf, prefix)); return Qnil; } +/* ARG is (BUFFER . PREFIX). */ + static Lisp_Object -describe_buffer_bindings (descbuf) - Lisp_Object descbuf; +describe_buffer_bindings (arg) + Lisp_Object arg; { - register Lisp_Object start1, start2; + Lisp_Object descbuf, prefix, shadow; + register Lisp_Object start1; + struct gcpro gcpro1; - char *key_heading - = "\ -key binding\n\ ---- -------\n"; char *alternate_heading = "\ Alternate Characters (use anywhere the nominal character is listed):\n\ nominal alternate\n\ ------- ---------\n"; + descbuf = XCONS (arg)->car; + prefix = XCONS (arg)->cdr; + shadow = Qnil; + GCPRO1 (shadow); + Fset_buffer (Vstandard_output); /* Report on alternates for keys. */ - if (XTYPE (Vkeyboard_translate_table) == Lisp_String) + if (STRINGP (Vkeyboard_translate_table)) { int c; unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data; @@ -1435,42 +1844,58 @@ nominal alternate\n\ /* Temporarily switch to descbuf, so that we can get that buffer's minor modes correctly. */ Fset_buffer (descbuf); - nmaps = current_minor_maps (&modes, &maps); + if (!NILP (Voverriding_local_map)) + nmaps = 0; + else + nmaps = current_minor_maps (&modes, &maps); Fset_buffer (Vstandard_output); + /* Print the minor mode maps. */ for (i = 0; i < nmaps; i++) { - if (XTYPE (modes[i]) == Lisp_Symbol) - { - insert_char ('`'); - insert_string (XSYMBOL (modes[i])->name->data); - insert_char ('\''); - } - else - insert_string ("Strangely Named"); - insert_string (" Minor Mode Bindings:\n"); - insert_string (key_heading); - describe_map_tree (maps[i], 0, Qnil); - insert_char ('\n'); + /* The title for a minor mode keymap + is constructed at run time. + We let describe_map_tree do the actual insertion + because it takes care of other features when doing so. */ + char *title, *p; + + if (!SYMBOLP (modes[i])) + abort(); + + p = title = (char *) alloca (40 + XSYMBOL (modes[i])->name->size); + *p++ = '`'; + bcopy (XSYMBOL (modes[i])->name->data, p, + XSYMBOL (modes[i])->name->size); + p += XSYMBOL (modes[i])->name->size; + *p++ = '\''; + bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1); + p += sizeof (" Minor Mode Bindings") - 1; + *p = 0; + + describe_map_tree (maps[i], 0, shadow, prefix, title, 0); + shadow = Fcons (maps[i], shadow); } } - start1 = XBUFFER (descbuf)->keymap; + /* Print the (major mode) local map. */ + if (!NILP (Voverriding_local_map)) + start1 = Voverriding_local_map; + else + start1 = XBUFFER (descbuf)->keymap; + if (!NILP (start1)) { - insert_string ("Local Bindings:\n"); - insert_string (key_heading); - describe_map_tree (start1, 0, Qnil); - insert_string ("\n"); + describe_map_tree (start1, 0, shadow, prefix, + "Major Mode Bindings", 0); + shadow = Fcons (start1, shadow); } - insert_string ("Global Bindings:\n"); - if (NILP (start1)) - insert_string (key_heading); - - describe_map_tree (current_global_map, 0, XBUFFER (descbuf)->keymap); + describe_map_tree (current_global_map, 0, shadow, prefix, + "Global Bindings", 0); + call0 (intern ("help-mode")); Fset_buffer (descbuf); + UNGCPRO; return Qnil; } @@ -1478,57 +1903,118 @@ nominal alternate\n\ followed by those of all maps reachable through STARTMAP. If PARTIAL is nonzero, omit certain "uninteresting" commands (such as `undefined'). - If SHADOW is non-nil, it is another map; - don't mention keys which would be shadowed by it. */ + If SHADOW is non-nil, it is a list of maps; + don't mention keys which would be shadowed by any of them. + 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. */ void -describe_map_tree (startmap, partial, shadow) - Lisp_Object startmap, shadow; +describe_map_tree (startmap, partial, shadow, prefix, title, nomenu) + Lisp_Object startmap, shadow, prefix; int partial; + char *title; + int nomenu; { - register Lisp_Object elt, sh; - Lisp_Object maps; - struct gcpro gcpro1; + Lisp_Object maps, seen, sub_shadows; + struct gcpro gcpro1, gcpro2, gcpro3; + int something = 0; + char *key_heading + = "\ +key binding\n\ +--- -------\n"; + + maps = Faccessible_keymaps (startmap, prefix); + seen = Qnil; + sub_shadows = Qnil; + GCPRO3 (maps, seen, sub_shadows); + + if (nomenu) + { + Lisp_Object list; + + /* Delete from MAPS each element that is for the menu bar. */ + for (list = maps; !NILP (list); list = XCONS (list)->cdr) + { + Lisp_Object elt, prefix, tem; - maps = Faccessible_keymaps (startmap); - GCPRO1 (maps); + elt = Fcar (list); + prefix = Fcar (elt); + if (XVECTOR (prefix)->size >= 1) + { + tem = Faref (prefix, make_number (0)); + if (EQ (tem, Qmenu_bar)) + maps = Fdelq (elt, maps); + } + } + } + + if (!NILP (maps)) + { + if (title) + { + insert_string (title); + if (!NILP (prefix)) + { + insert_string (" Starting With "); + insert1 (Fkey_description (prefix)); + } + insert_string (":\n"); + } + insert_string (key_heading); + something = 1; + } for (; !NILP (maps); maps = Fcdr (maps)) { + register Lisp_Object elt, prefix, tail; + elt = Fcar (maps); - sh = Fcar (elt); - - /* If there is no shadow keymap given, don't shadow. */ - if (NILP (shadow)) - sh = Qnil; - - /* If the sequence by which we reach this keymap is zero-length, - then the shadow map for this keymap is just SHADOW. */ - else if ((XTYPE (sh) == Lisp_String - && XSTRING (sh)->size == 0) - || (XTYPE (sh) == Lisp_Vector - && XVECTOR (sh)->size == 0)) - sh = shadow; - - /* If the sequence by which we reach this keymap actually has - some elements, then the sequence's definition in SHADOW is - what we should use. */ - else + prefix = Fcar (elt); + + sub_shadows = Qnil; + + for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr) { - sh = Flookup_key (shadow, Fcar (elt)); - if (XTYPE (sh) == Lisp_Int) - sh = Qnil; + Lisp_Object shmap; + + shmap = XCONS (tail)->car; + + /* If the sequence by which we reach this keymap is zero-length, + then the shadow map for this keymap is just SHADOW. */ + if ((STRINGP (prefix) && XSTRING (prefix)->size == 0) + || (VECTORP (prefix) && XVECTOR (prefix)->size == 0)) + ; + /* If the sequence by which we reach this keymap actually has + some elements, then the sequence's definition in SHADOW is + what we should use. */ + else + { + shmap = Flookup_key (shmap, Fcar (elt), Qt); + if (INTEGERP (shmap)) + shmap = Qnil; + } + + /* 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))) + goto skip; + + if (!NILP (shmap)) + sub_shadows = Fcons (shmap, sub_shadows); } - /* If sh is null (meaning that the current map is not shadowed), - or a keymap (meaning that bindings from the current map might - show through), describe the map. Otherwise, sh is a command - that completely shadows the current map, and we shouldn't - bother. */ - if (NILP (sh) || !NILP (Fkeymapp (sh))) - describe_map (Fcdr (elt), Fcar (elt), partial, sh); + describe_map (Fcdr (elt), Fcar (elt), describe_command, + partial, sub_shadows, &seen); + + skip: ; } + if (something) + insert_string ("\n"); + UNGCPRO; } @@ -1540,12 +2026,14 @@ describe_command (definition) Findent_to (make_number (16), make_number (1)); - if (XTYPE (definition) == Lisp_Symbol) + if (SYMBOLP (definition)) { - XSET (tem1, Lisp_String, XSYMBOL (definition)->name); + XSETSTRING (tem1, XSYMBOL (definition)->name); insert1 (tem1); insert_string ("\n"); } + else if (STRINGP (definition)) + insert_string ("Keyboard Macro\n"); else { tem1 = Fkeymapp (definition); @@ -1556,44 +2044,54 @@ describe_command (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 is as in `describe_map_tree' above. */ +/* 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 void -describe_map (map, keys, partial, shadow) - Lisp_Object map, keys; - int partial; - Lisp_Object shadow; +static Lisp_Object +shadow_lookup (shadow, key, flag) + Lisp_Object shadow, key, flag; { - register Lisp_Object keysdesc; - - if (!NILP (keys) && Flength (keys) > 0) - keysdesc = concat2 (Fkey_description (keys), - build_string (" ")); - else - keysdesc = Qnil; + Lisp_Object tail, value; - describe_map_2 (map, keysdesc, describe_command, partial, shadow); + 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 a description of KEYMAP into the current buffer. */ +/* 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. */ static void -describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow) - register Lisp_Object keymap; - Lisp_Object elt_prefix; +describe_map (map, keys, elt_describer, partial, shadow, seen) + register Lisp_Object map; + Lisp_Object keys; int (*elt_describer) (); int partial; Lisp_Object shadow; + Lisp_Object *seen; { - Lisp_Object this; - Lisp_Object tem1, tem2 = Qnil; + Lisp_Object elt_prefix; + Lisp_Object tail, definition, event; + Lisp_Object tem; Lisp_Object suppress; Lisp_Object kludge; int first = 1; struct gcpro gcpro1, gcpro2, gcpro3; + if (!NILP (keys) && XFASTINT (Flength (keys)) > 0) + { + /* Call Fkey_description first, to avoid GC bug for the other string. */ + tem = Fkey_description (keys); + elt_prefix = concat2 (tem, build_string (" ")); + } + else + elt_prefix = Qnil; + if (partial) suppress = intern ("suppress-keymap"); @@ -1601,42 +2099,50 @@ describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow) that is done once per keymap element, we don't want to cons up a fresh vector every time. */ kludge = Fmake_vector (make_number (1), Qnil); + definition = Qnil; - GCPRO3 (elt_prefix, tem2, kludge); + GCPRO3 (elt_prefix, definition, kludge); - for (; CONSP (keymap); keymap = Fcdr (keymap)) + for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr) { QUIT; - if (XTYPE (XCONS (keymap)->car) == Lisp_Vector) - describe_vector (XCONS (keymap)->car, + if (VECTORP (XCONS (tail)->car)) + describe_vector (XCONS (tail)->car, elt_prefix, elt_describer, partial, shadow); - else + else if (CONSP (XCONS (tail)->car)) { - tem1 = Fcar_safe (Fcar (keymap)); - tem2 = get_keyelt (Fcdr_safe (Fcar (keymap))); + event = XCONS (XCONS (tail)->car)->car; + + /* Ignore bindings whose "keys" are not really valid events. + (We get these in the frames and buffers menu.) */ + if (! (SYMBOLP (event) || INTEGERP (event))) + continue; + + definition = get_keyelt (XCONS (XCONS (tail)->car)->cdr, 0); /* Don't show undefined commands or suppressed commands. */ - if (NILP (tem2)) continue; - if (XTYPE (tem2) == Lisp_Symbol && partial) + if (NILP (definition)) continue; + if (SYMBOLP (definition) && partial) { - this = Fget (tem2, suppress); - if (!NILP (this)) + tem = Fget (definition, suppress); + if (!NILP (tem)) 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; if (!NILP (shadow)) { - Lisp_Object tem; - - XVECTOR (kludge)->contents[0] = tem1; - tem = Flookup_key (shadow, kludge); + tem = shadow_lookup (shadow, kludge, Qt); if (!NILP (tem)) continue; } + tem = Flookup_key (map, kludge, Qt); + if (! EQ (tem, definition)) continue; + if (first) { insert ("\n", 1); @@ -1646,14 +2152,23 @@ describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow) if (!NILP (elt_prefix)) insert1 (elt_prefix); - /* THIS gets the string to describe the character TEM1. */ - this = Fsingle_key_description (tem1); - insert1 (this); + /* THIS gets the string to describe the character EVENT. */ + insert1 (Fsingle_key_description (event)); /* Print a description of the definition of this character. elt_describer will take care of spacing out far enough for alignment purposes. */ - (*elt_describer) (tem2); + (*elt_describer) (definition); + } + else if (EQ (XCONS (tail)->car, 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))) + break; + *seen = Fcons (Fcons (tail, keys), *seen); } } @@ -1664,17 +2179,24 @@ static int describe_vector_princ (elt) Lisp_Object elt; { + Findent_to (make_number (16), make_number (1)); Fprinc (elt, Qnil); + Fterpri (Qnil); } DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0, - "Print on `standard-output' a description of contents of VECTOR.\n\ + "Insert a description of contents of VECTOR.\n\ This is text showing the elements of vector matched against indices.") (vector) Lisp_Object vector; { + int count = specpdl_ptr - specpdl; + + specbind (Qstandard_output, Fcurrent_buffer ()); CHECK_VECTOR (vector, 0); - describe_vector (vector, Qnil, describe_vector_princ, 0, Qnil, Qnil); + describe_vector (vector, Qnil, describe_vector_princ, 0, Qnil); + + return unbind_to (count, Qnil); } describe_vector (vector, elt_prefix, elt_describer, partial, shadow) @@ -1704,15 +2226,15 @@ describe_vector (vector, elt_prefix, elt_describer, partial, shadow) if (partial) suppress = intern ("suppress-keymap"); - for (i = 0; i < DENSE_TABLE_SIZE; i++) + for (i = 0; i < XVECTOR (vector)->size; i++) { QUIT; - tem1 = get_keyelt (XVECTOR (vector)->contents[i]); + tem1 = get_keyelt (XVECTOR (vector)->contents[i], 0); if (NILP (tem1)) continue; /* Don't mention suppressed commands. */ - if (XTYPE (tem1) == Lisp_Symbol && partial) + if (SYMBOLP (tem1) && partial) { this = Fget (tem1, suppress); if (!NILP (this)) @@ -1726,7 +2248,7 @@ describe_vector (vector, elt_prefix, elt_describer, partial, shadow) Lisp_Object tem; XVECTOR (kludge)->contents[0] = make_number (i); - tem = Flookup_key (shadow, kludge); + tem = shadow_lookup (shadow, kludge, Qt); if (!NILP (tem)) continue; } @@ -1742,15 +2264,15 @@ describe_vector (vector, elt_prefix, elt_describer, partial, shadow) insert1 (elt_prefix); /* Get the string to describe the character I, and print it. */ - XFASTINT (dummy) = i; + XSETFASTINT (dummy, i); /* THIS gets the string to describe the character DUMMY. */ this = Fsingle_key_description (dummy); insert1 (this); /* Find all consecutive characters that have the same definition. */ - while (i + 1 < DENSE_TABLE_SIZE - && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1]), + while (i + 1 < XVECTOR (vector)->size + && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1], 0), EQ (tem2, tem1))) i++; @@ -1763,7 +2285,7 @@ describe_vector (vector, elt_prefix, elt_describer, partial, shadow) if (!NILP (elt_prefix)) insert1 (elt_prefix); - XFASTINT (dummy) = i; + XSETFASTINT (dummy, i); insert1 (Fsingle_key_description (dummy)); } @@ -1823,7 +2345,8 @@ syms_of_keymap () Each one is the value of a Lisp variable, and is also pointed to by a C variable */ - global_map = Fmake_keymap (Qnil); + global_map = Fcons (Qkeymap, + Fcons (Fmake_vector (make_number (0400), Qnil), Qnil)); Fset (intern ("global-map"), global_map); meta_map = Fmake_keymap (Qnil); @@ -1865,17 +2388,20 @@ in the list takes precedence."); This allows Emacs to recognize function keys sent from ASCII\n\ terminals at any point in a key sequence.\n\ \n\ -The read-key-sequence function replaces subsequences bound by\n\ -function-key-map with their bindings. When the current local and global\n\ +The `read-key-sequence' function replaces any subsequence bound by\n\ +`function-key-map' with its binding. More precisely, when the active\n\ keymaps have no binding for the current key sequence but\n\ -function-key-map binds a suffix of the sequence to a vector,\n\ -read-key-sequence replaces the matching suffix with its binding, and\n\ +`function-key-map' binds a suffix of the sequence to a vector or string,\n\ +`read-key-sequence' replaces the matching suffix with its binding, and\n\ continues with the new sequence.\n\ \n\ -For example, suppose function-key-map binds `ESC O P' to [pf1].\n\ -Typing `ESC O P' to read-key-sequence would return [pf1]. Typing\n\ -`C-x ESC O P' would return [?\C-x pf1]. If [pf1] were a prefix\n\ -key, typing `ESC O P x' would return [pf1 x]."); +The events that come from bindings in `function-key-map' are not\n\ +themselves looked up in `function-key-map'.\n\ +\n\ +For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\ +Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\ +`C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\ +key, typing `ESC O P x' would return [f1 x]."); Vfunction_key_map = Fmake_sparse_keymap (Qnil); Qsingle_key_description = intern ("single-key-description"); @@ -1887,6 +2413,9 @@ key, typing `ESC O P x' would return [pf1 x]."); Qkeymapp = intern ("keymapp"); staticpro (&Qkeymapp); + Qnon_ascii = intern ("non-ascii"); + staticpro (&Qnon_ascii); + defsubr (&Skeymapp); defsubr (&Smake_keymap); defsubr (&Smake_sparse_keymap); @@ -1895,12 +2424,8 @@ key, typing `ESC O P x' would return [pf1 x]."); 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); @@ -1913,7 +2438,6 @@ key, typing `ESC O P x' would return [pf1 x]."); defsubr (&Ssingle_key_description); defsubr (&Stext_char_description); defsubr (&Swhere_is_internal); - defsubr (&Swhere_is); defsubr (&Sdescribe_bindings); defsubr (&Sapropos_internal); }