X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e13608fb0515d989196f14a93a21d81a41ae801f..b3561514f631090ea1af4b6a04aaa8790654595d:/src/keymap.c diff --git a/src/keymap.c b/src/keymap.c index 04d2bb28d5..33e3244c06 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1,5 +1,6 @@ /* 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. @@ -21,7 +22,6 @@ Boston, MA 02111-1307, USA. */ #include #include -#undef NULL #include "lisp.h" #include "commands.h" #include "buffer.h" @@ -30,8 +30,8 @@ Boston, MA 02111-1307, USA. */ #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) @@ -55,7 +55,7 @@ Lisp_Object Vminibuffer_local_map; minibuf */ /* was MinibufLocalNSMap */ -Lisp_Object Vminibuffer_local_ns_map; +Lisp_Object Vminibuffer_local_ns_map; /* The keymap used by the minibuf for local bindings when spaces are not encouraged in the minibuf */ @@ -98,23 +98,33 @@ extern Lisp_Object meta_prefix_char; 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 (); -Lisp_Object Fcopy_keymap (); +/* 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 void describe_command P_ ((Lisp_Object, Lisp_Object)); +static void describe_translation P_ ((Lisp_Object, Lisp_Object)); +static void describe_map P_ ((Lisp_Object, Lisp_Object, + void (*) P_ ((Lisp_Object, Lisp_Object)), + int, Lisp_Object, Lisp_Object*, int)); /* 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\ -characters. ALIST is an assoc-list which holds bindings for function keys,\n\ -mouse events, and any other things that appear in the input stream.\n\ -All entries in it are initially nil, meaning \"command undefined\".\n\n\ -The optional arg STRING supplies a menu name for the keymap\n\ -in case you use it as a menu with `x-popup-menu'.") - (string) + doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST). +CHARTABLE is a char-table that holds the bindings for the ASCII +characters. ALIST is an assoc-list which holds bindings for function keys, +mouse events, and any other things that appear in the input stream. +All entries in it are initially nil, meaning "command undefined". + +The optional arg STRING supplies a menu name for the keymap +in case you use it as a menu with `x-popup-menu'. */) + (string) Lisp_Object string; { Lisp_Object tail; @@ -127,14 +137,15 @@ in case you use it as a menu with `x-popup-menu'.") } DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0, - "Construct and return a new sparse-keymap list.\n\ -Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\ -which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\ -which binds the function key or mouse event SYMBOL to DEFINITION.\n\ -Initially the alist is nil.\n\n\ -The optional arg STRING supplies a menu name for the keymap\n\ -in case you use it as a menu with `x-popup-menu'.") - (string) + doc: /* Construct and return a new sparse keymap. +Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION), +which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION), +which binds the function key or mouse event SYMBOL to DEFINITION. +Initially the alist is nil. + +The optional arg STRING supplies a menu name for the keymap +in case you use it as a menu with `x-popup-menu'. */) + (string) Lisp_Object string; { if (!NILP (string)) @@ -167,35 +178,36 @@ initial_define_lispy_key (keymap, keyname, 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. */ - -#if 0 -void -synkey (frommap, fromchar, tomap, tochar) - struct Lisp_Vector *frommap, *tomap; - int fromchar, tochar; +DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0, + doc: /* Return t if OBJECT is a keymap. + +A keymap is a list (keymap . ALIST), +or a symbol whose function definition is itself a keymap. +ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN); +a vector of densely packed bindings for small character codes +is also allowed as an element. */) + (object) + Lisp_Object object; { - Lisp_Object v, c; - XSETVECTOR (v, tomap); - XSETFASTINT (c, tochar); - frommap->contents[fromchar] = Fcons (v, c); + return (KEYMAPP (object) ? Qt : Qnil); } -#endif /* 0 */ -DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0, - "Return t if OBJECT is a keymap.\n\ -\n\ -A keymap is a list (keymap . ALIST),\n\ -or a symbol whose function definition is itself a keymap.\n\ -ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\ -a vector of densely packed bindings for small character codes\n\ -is also allowed as an element.") - (object) - Lisp_Object object; +DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0, + doc: /* Return the prompt-string of a keymap MAP. +If non-nil, the prompt is shown in the echo-area +when reading a key-sequence to be looked-up in this keymap. */) + (map) + Lisp_Object map; { - return (NILP (get_keymap_1 (object, 0, 0)) ? Qnil : Qt); + 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 @@ -205,6 +217,9 @@ is also allowed as an element.") 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. @@ -212,112 +227,145 @@ is also allowed as an element.") 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; } /* Return the parent map of the keymap MAP, or nil if it has none. We assume that MAP is a valid keymap. */ DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0, - "Return the parent keymap of KEYMAP.") - (keymap) + doc: /* Return the parent keymap of KEYMAP. */) + (keymap) Lisp_Object keymap; { 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. */ DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0, - "Modify KEYMAP to set its parent map to PARENT.\n\ -PARENT should be nil or another keymap.") - (keymap, parent) + doc: /* Modify KEYMAP to set its parent map to PARENT. +PARENT should be nil or another keymap. */) + (keymap, parent) Lisp_Object keymap, parent; { Lisp_Object list, prev; + struct gcpro gcpro1; 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; + XSETCDR (prev, parent); break; } prev = list; @@ -325,41 +373,41 @@ PARENT should be nil or another keymap.") /* 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; { @@ -368,55 +416,46 @@ fix_submap_inheritance (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); + } } /* Look up IDX in MAP. IDX may be any sort of event. @@ -432,15 +471,18 @@ fix_submap_inheritance (map, event, submap) 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; + /* Qunbound in VAL means we have found no binding yet. */ + val = Qunbound; + /* If idx is a list (some sort of mouse click, perhaps?), the index we want to use is the car of the list, which ought to be a symbol. */ @@ -455,72 +497,126 @@ access_keymap (map, idx, t_ok, noinherit) 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; + /* t_binding is where we put a default binding that applies, + to use in case we do not find a binding specifically + for this key sequence. */ + + Lisp_Object t_binding; t_binding = Qnil; - for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr) + + /* If `t_ok' is 2, both `t' and generic-char bindings are accepted. + If it is 1, only generic-char bindings are accepted. + Otherwise, neither are. */ + t_ok = t_ok ? 2 : 0; + + 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)) - noprefix = 1; + if (noinherit && EQ (binding, Qkeymap)) + return Qnil; } else if (CONSP (binding)) { - if (EQ (XCONS (binding)->car, idx)) + Lisp_Object key = XCAR (binding); + + if (EQ (key, idx)) + val = XCDR (binding); + else if (t_ok + && 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)))) { - val = XCONS (binding)->cdr; - if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) - return Qnil; - if (CONSP (val)) - fix_submap_inheritance (map, idx, val); - return val; + /* KEY is the generic character of the charset of IDX. + Use KEY's binding if there isn't a binding for IDX + itself. */ + t_binding = XCDR (binding); + t_ok = 0; + } + else if (t_ok > 1 && EQ (key, Qt)) + { + t_binding = XCDR (binding); + t_ok = 1; } - 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; - if (CONSP (val)) - fix_submap_inheritance (map, idx, val); - return val; - } + if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding)) + val = AREF (binding, XFASTINT (idx)); } else if (CHAR_TABLE_P (binding)) { /* Character codes with modifiers are not included in a char-table. All character codes without modifiers are included. */ - if (NATNUMP (idx) - && ! (XFASTINT (idx) - & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER - | CHAR_SHIFT | CHAR_CTL | CHAR_META))) + if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0) { val = Faref (binding, idx); - if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) - return Qnil; - if (CONSP (val)) - fix_submap_inheritance (map, idx, val); - return val; + /* `nil' has a special meaning for char-tables, so + we use something else to record an explicitly + unbound entry. */ + if (NILP (val)) + val = Qunbound; } } + /* If we found a binding, clean it up and return it. */ + if (!EQ (val, Qunbound)) + { + if (EQ (val, Qt)) + /* A Qt binding is just like an explicit nil binding + (i.e. it shadows any parent binding but not bindings in + keymaps of lower precedence). */ + val = Qnil; + val = get_keyelt (val, autoload); + if (KEYMAPP (val)) + fix_submap_inheritance (map, idx, val); + return val; + } QUIT; } - return t_binding; + return get_keyelt (t_binding, autoload); } } @@ -543,84 +639,95 @@ get_keyelt (object, 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?), @@ -650,16 +757,16 @@ store_in_keymap (keymap, idx, def) 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; @@ -669,33 +776,31 @@ store_in_keymap (keymap, idx, def) /* Character codes with modifiers are not included in a char-table. All character codes without modifiers are included. */ - if (NATNUMP (idx) - && ! (XFASTINT (idx) - & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER - | CHAR_SHIFT | CHAR_CTL | CHAR_META))) + if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK)) { - Faset (elt, idx, def); + Faset (elt, idx, + /* `nil' has a special meaning for char-tables, so + we use something else to record an explicitly + unbound entry. */ + NILP (def) ? Qt : def); return def; } insertion_point = tail; } else if (CONSP (elt)) { - if (EQ (idx, XCONS (elt)->car)) + if (EQ (idx, XCAR (elt))) { - XCONS (elt)->cdr = def; + XSETCDR (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; } @@ -703,46 +808,51 @@ store_in_keymap (keymap, idx, def) 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); + XSETCDR (insertion_point, + Fcons (Fcons (idx, def), XCDR (insertion_point))); } - + return def; } +EXFUN (Fcopy_keymap, 1); + void 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)); } DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0, - "Return a copy of the keymap KEYMAP.\n\ -The copy starts out with the same definitions of KEYMAP,\n\ -but changing either the copy or KEYMAP does not affect the other.\n\ -Any key definitions that are subkeymaps are recursively copied.\n\ -However, a key definition which is a symbol whose definition is a keymap\n\ -is not copied.") - (keymap) + doc: /* Return a copy of the keymap KEYMAP. +The copy starts out with the same definitions of KEYMAP, +but changing either the copy or KEYMAP does not affect the other. +Any key definitions that are subkeymaps are recursively copied. +However, a key definition which is a symbol whose definition is a keymap +is not copied. */) + (keymap) Lisp_Object keymap; { + /* FIXME: This doesn't properly copy menu-items in vectors. */ + /* FIXME: This also copies the parent keymap. */ + register Lisp_Object copy, tail; - 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; + XSETCAR (tail, elt); map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices); } @@ -751,49 +861,47 @@ is not copied.") int i; elt = Fcopy_sequence (elt); - XCONS (tail)->car = elt; + XSETCAR (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; + XSETCDR (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; + XSETCDR (elt, + Fcons (XCAR (tem), XCDR (tem))); + elt = XCDR (elt); + tem = XCDR (elt); }; if (CONSP (tem)) { /* Copy cell with binding and if the binding is a keymap, copy that. */ - 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)) + XSETCDR (elt, + Fcons (XCAR (tem), XCDR (tem))); + elt = XCDR (elt); + tem = XCAR (elt); + if (CONSP (tem) && EQ (XCAR (tem), Qkeymap)) + XSETCAR (elt, Fcopy_keymap (tem)); + tem = XCDR (elt); + if (CONSP (tem) && CONSP (XCAR (tem))) /* Delete cache for key equivalences. */ - XCONS (elt)->cdr = XCONS (tem)->cdr; + XSETCDR (elt, XCDR (tem)); } } else @@ -801,38 +909,38 @@ is not copied.") /* 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; + XSETCDR (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; + XSETCDR (elt, + Fcons (XCAR (tem), XCDR (tem))); + elt = XCDR (elt); + tem = XCDR (elt); } /* There may also be a list that caches key equivalences. Just delete it for the new keymap. */ if (CONSP (tem) - && CONSP (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))))) + XSETCDR (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)) + XSETCDR (elt, Fcopy_keymap (XCDR (elt))); } } } - + return copy; } @@ -841,40 +949,39 @@ is not copied.") /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0, - "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\ -KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\ -meaning a sequence of keystrokes and events.\n\ -Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\ -can be included if you use a vector.\n\ -DEF is anything that can be a key's definition:\n\ - nil (means key is undefined in this keymap),\n\ - a command (a Lisp function suitable for interactive calling)\n\ - a string (treated as a keyboard macro),\n\ - a keymap (to define a prefix key),\n\ - a symbol. When the key is looked up, the symbol will stand for its\n\ - function definition, which should at that time be one of the above,\n\ - or another symbol whose function definition is used, etc.\n\ - a cons (STRING . DEFN), meaning that DEFN is the definition\n\ - (DEFN should be a valid definition in its own right),\n\ - or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\ -\n\ -If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\ -the front of KEYMAP.") - (keymap, key, def) + doc: /* Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF. +KEYMAP is a keymap. KEY is a string or a vector of symbols and characters +meaning a sequence of keystrokes and events. +Non-ASCII characters with codes above 127 (such as ISO Latin-1) +can be included if you use a vector. +DEF is anything that can be a key's definition: + nil (means key is undefined in this keymap), + a command (a Lisp function suitable for interactive calling) + a string (treated as a keyboard macro), + a keymap (to define a prefix key), + a symbol. When the key is looked up, the symbol will stand for its + function definition, which should at that time be one of the above, + or another symbol whose function definition is used, etc. + a cons (STRING . DEFN), meaning that DEFN is the definition + (DEFN should be a valid definition in its own right), + or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP. + +If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at +the front of KEYMAP. */) + (keymap, key, def) Lisp_Object keymap; Lisp_Object key; Lisp_Object def; { 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); @@ -917,20 +1024,20 @@ the front of KEYMAP.") 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", @@ -942,36 +1049,33 @@ the front of KEYMAP.") /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, - "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\ -nil means undefined. See doc of `define-key' for kinds of definitions.\n\ -\n\ -A number as value means KEY is \"too long\";\n\ -that is, characters or symbols in it except for the last one\n\ -fail to be a valid sequence of prefix characters in KEYMAP.\n\ -The number is how many characters at the front of KEY\n\ -it takes to reach a non-prefix command.\n\ -\n\ -Normally, `lookup-key' ignores bindings for t, which act as default\n\ -bindings, used when nothing else in the keymap applies; this makes it\n\ -usable as a general function for probing keymaps. However, if the\n\ -third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\ -recognize the default bindings, just as `read-key-sequence' does.") - (keymap, key, accept_default) + doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition. +nil means undefined. See doc of `define-key' for kinds of definitions. + +A number as value means KEY is "too long"; +that is, characters or symbols in it except for the last one +fail to be a valid sequence of prefix characters in KEYMAP. +The number is how many characters at the front of KEY +it takes to reach a non-prefix command. + +Normally, `lookup-key' ignores bindings for t, which act as default +bindings, used when nothing else in the keymap applies; this makes it +usable as a general function for probing keymaps. However, if the +third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will +recognize the default bindings, just as `read-key-sequence' does. */) + (keymap, key, accept_default) register Lisp_Object keymap; Lisp_Object key; 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); @@ -980,43 +1084,26 @@ recognize the default bindings, just as `read-key-sequence' does.") 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; @@ -1031,44 +1118,13 @@ static Lisp_Object 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; @@ -1135,11 +1191,11 @@ current_minor_maps (modeptr, mapptr) 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; @@ -1150,23 +1206,25 @@ current_minor_maps (modeptr, mapptr) { val = assq_no_quit (var, lists[0]); if (!NILP (val)) - break; + continue; } if (i >= cmm_size) { 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 @@ -1174,24 +1232,24 @@ current_minor_maps (modeptr, mapptr) 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)) { @@ -1206,19 +1264,60 @@ current_minor_maps (modeptr, mapptr) return i; } +DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps, + 0, 1, 0, + doc: /* Return a list of the currently active keymaps. +OLP if non-nil indicates that we should obey `overriding-local-map' and +`overriding-terminal-local-map'. */) + (olp) + Lisp_Object olp; +{ + 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 the binding for command KEY in current keymaps.\n\ -KEY is a string or vector, a sequence of keystrokes.\n\ -The binding is probably a symbol with a function definition.\n\ -\n\ -Normally, `key-binding' ignores bindings for t, which act as default\n\ -bindings, used when nothing else in the keymap applies; this makes it\n\ -usable as a general function for probing keymaps. However, if the\n\ -optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\ -recognize the default bindings, just as `read-key-sequence' does.") - (key, accept_default) + doc: /* Return the binding for command KEY in current keymaps. +KEY is a string or vector, a sequence of keystrokes. +The binding is probably a symbol with a function definition. + +Normally, `key-binding' ignores bindings for t, which act as default +bindings, used when nothing else in the keymap applies; this makes it +usable as a general function for probing keymaps. However, if the +optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does +recognize the default bindings, just as `read-key-sequence' does. */) + (key, accept_default) Lisp_Object key, accept_default; { Lisp_Object *maps, value; @@ -1256,7 +1355,15 @@ recognize the default bindings, just as `read-key-sequence' does.") 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)) { @@ -1277,13 +1384,13 @@ recognize the default bindings, just as `read-key-sequence' does.") /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0, - "Return the binding for command KEYS in current local keymap only.\n\ -KEYS is a string, a sequence of keystrokes.\n\ -The binding is probably a symbol with a function definition.\n\ -\n\ -If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\ -bindings; see the description of `lookup-key' for more details about this.") - (keys, accept_default) + doc: /* Return the binding for command KEYS in current local keymap only. +KEYS is a string, a sequence of keystrokes. +The binding is probably a symbol with a function definition. + +If optional argument ACCEPT-DEFAULT is non-nil, recognize default +bindings; see the description of `lookup-key' for more details about this. */) + (keys, accept_default) Lisp_Object keys, accept_default; { register Lisp_Object map; @@ -1296,15 +1403,15 @@ bindings; see the description of `lookup-key' for more details about this.") /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0, - "Return the binding for command KEYS in current global keymap only.\n\ -KEYS is a string, a sequence of keystrokes.\n\ -The binding is probably a symbol with a function definition.\n\ -This function's return values are the same as those of lookup-key\n\ -\(which see).\n\ -\n\ -If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\ -bindings; see the description of `lookup-key' for more details about this.") - (keys, accept_default) + doc: /* Return the binding for command KEYS in current global keymap only. +KEYS is a string, a sequence of keystrokes. +The binding is probably a symbol with a function definition. +This function's return values are the same as those of lookup-key +\(which see). + +If optional argument ACCEPT-DEFAULT is non-nil, recognize default +bindings; see the description of `lookup-key' for more details about this. */) + (keys, accept_default) Lisp_Object keys, accept_default; { return Flookup_key (current_global_map, keys, accept_default); @@ -1313,18 +1420,18 @@ bindings; see the description of `lookup-key' for more details about this.") /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0, - "Find the visible minor mode bindings of KEY.\n\ -Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\ -the symbol which names the minor mode binding KEY, and BINDING is\n\ -KEY's definition in that mode. In particular, if KEY has no\n\ -minor-mode bindings, return nil. If the first binding is a\n\ -non-prefix, all subsequent bindings will be omitted, since they would\n\ -be ignored. Similarly, the list doesn't include non-prefix bindings\n\ -that come after prefix bindings.\n\ -\n\ -If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\ -bindings; see the description of `lookup-key' for more details about this.") - (key, accept_default) + doc: /* Find the visible minor mode bindings of KEY. +Return an alist of pairs (MODENAME . BINDING), where MODENAME is the +the symbol which names the minor mode binding KEY, and BINDING is +KEY's definition in that mode. In particular, if KEY has no +minor-mode bindings, return nil. If the first binding is a +non-prefix, all subsequent bindings will be omitted, since they would +be ignored. Similarly, the list doesn't include non-prefix bindings +that come after prefix bindings. + +If optional argument ACCEPT-DEFAULT is non-nil, recognize default +bindings; see the description of `lookup-key' for more details about this. */) + (key, accept_default) Lisp_Object key, accept_default; { Lisp_Object *modes, *maps; @@ -1341,11 +1448,11 @@ bindings; see the description of `lookup-key' for more details about this.") 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)); @@ -1355,17 +1462,19 @@ bindings; see the description of `lookup-key' for more details about this.") return Flist (j, maps); } -DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 2, 0, - "Define COMMAND as a prefix command. COMMAND should be a symbol.\n\ -A new sparse keymap is stored as COMMAND's function definition and its value.\n\ -If a second optional argument MAPVAR is given, the map is stored as\n\ -its value instead of as COMMAND's value; but COMMAND is still defined\n\ -as a function.") - (command, mapvar) - Lisp_Object command, mapvar; +DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0, + doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol. +A new sparse keymap is stored as COMMAND's function definition and its value. +If a second optional argument MAPVAR is given, the map is stored as +its value instead of as COMMAND's value; but COMMAND is still defined +as a function. +The third optional argument NAME, if given, supplies a menu name +string for the map. This is required to use the keymap as a menu. */) + (command, mapvar, name) + Lisp_Object command, mapvar, name; { Lisp_Object map; - map = Fmake_sparse_keymap (Qnil); + map = Fmake_sparse_keymap (name); Ffset (command, map); if (!NILP (mapvar)) Fset (mapvar, map); @@ -1375,24 +1484,24 @@ as a function.") } DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0, - "Select KEYMAP as the global keymap.") - (keymap) + doc: /* Select KEYMAP as the global keymap. */) + (keymap) Lisp_Object keymap; { - keymap = get_keymap (keymap); + keymap = get_keymap (keymap, 1, 1); current_global_map = keymap; return Qnil; } DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0, - "Select KEYMAP as the local keymap.\n\ -If KEYMAP is nil, that means no local keymap.") - (keymap) + doc: /* Select KEYMAP as the local keymap. +If KEYMAP is nil, that means no local keymap. */) + (keymap) Lisp_Object keymap; { if (!NILP (keymap)) - keymap = get_keymap (keymap); + keymap = get_keymap (keymap, 1, 1); current_buffer->keymap = keymap; @@ -1400,22 +1509,22 @@ If KEYMAP is nil, that means no local keymap.") } DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0, - "Return current buffer's local keymap, or nil if it has none.") - () + doc: /* Return current buffer's local keymap, or nil if it has none. */) + () { return current_buffer->keymap; } DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0, - "Return the current global keymap.") - () + doc: /* Return the current global keymap. */) + () { return current_global_map; } DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0, - "Return a list of keymaps for the minor modes of the current buffer.") - () + doc: /* Return a list of keymaps for the minor modes of the current buffer. */) + () { Lisp_Object *maps; int nmaps = current_minor_maps (0, &maps); @@ -1425,19 +1534,76 @@ DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_ /* 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. */ + XSETCDR (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. */ DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, - 1, 2, 0, - "Find all keymaps accessible via prefix characters from KEYMAP.\n\ -Returns a list of elements of the form (KEYS . MAP), where the sequence\n\ -KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\ -so that the KEYS increase in length. The first element is ([] . KEYMAP).\n\ -An optional argument PREFIX, if non-nil, should be a key sequence;\n\ -then the value includes only maps for prefixes that start with PREFIX.") - (keymap, prefix) + 1, 2, 0, + doc: /* Find all keymaps accessible via prefix characters from KEYMAP. +Returns a list of elements of the form (KEYS . MAP), where the sequence +KEYS starting from KEYMAP gets you to MAP. These elements are ordered +so that the KEYS increase in length. The first element is ([] . KEYMAP). +An optional argument PREFIX, if non-nil, should be a key sequence; +then the value includes only maps for prefixes that start with PREFIX. */) + (keymap, prefix) Lisp_Object keymap, prefix; { Lisp_Object maps, good_maps, tail; @@ -1457,8 +1623,8 @@ then the value includes only maps for prefixes that start with PREFIX.") /* 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. */ @@ -1468,16 +1634,14 @@ then the value includes only maps for prefixes that start with PREFIX.") 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; } @@ -1488,7 +1652,7 @@ then the value includes only maps for prefixes that start with PREFIX.") } 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, @@ -1498,7 +1662,7 @@ then the value includes only maps for prefixes that start with PREFIX.") 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; @@ -1513,11 +1677,11 @@ then the value includes only maps for prefixes that start with PREFIX.") && 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; @@ -1526,7 +1690,8 @@ then the value includes only maps for prefixes that start with PREFIX.") 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)) @@ -1534,90 +1699,16 @@ then the value includes only maps for prefixes that start with PREFIX.") 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))); + } } @@ -1627,11 +1718,11 @@ then the value includes only maps for prefixes that start with PREFIX.") /* 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) @@ -1651,101 +1742,95 @@ then the value includes only maps for prefixes that start with PREFIX.") 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)); - } - } -} Lisp_Object Qsingle_key_description, Qkey_description; /* This function cannot GC. */ DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0, - "Return a pretty description of key-sequence KEYS.\n\ -Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\ -spaces are put between sequence elements, etc.") - (keys) + doc: /* Return a pretty description of key-sequence KEYS. +Control characters turn into "C-foo" sequences, meta into "M-foo" +spaces are put between sequence elements, etc. */) + (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 empty_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) { @@ -1753,11 +1838,12 @@ push_key_description (c, p) *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) { @@ -1805,8 +1891,7 @@ push_key_description (c, p) } else { - *p++ = 'C'; - *p++ = '-'; + /* `C-' already added above. */ if (c > 0 && c <= Ctl ('Z')) *p++ = c + 0140; else @@ -1820,57 +1905,120 @@ push_key_description (c, p) *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 { - *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'; + 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; + 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; +DEFUN ("single-key-description", Fsingle_key_description, + Ssingle_key_description, 1, 2, 0, + doc: /* Return a pretty description of command character KEY. +Control characters turn into C-whatever, etc. +Optional argument NO-ANGLES non-nil means don't put angle brackets +around function keys and event symbols. */) + (key, no_angles) + Lisp_Object key, no_angles; { - char tem[20]; + if (CONSP (key) && lucid_event_type_list_p (key)) + key = Fevent_convert_list (key); key = EVENT_HEAD (key); if (INTEGERP (key)) /* Normal character */ { - *push_key_description (XUINT (key), tem) = 0; - return build_string (tem); + unsigned int charset, c1, c2; + int without_bits = XINT (key) & ~((-1) << CHARACTERBITS); + + if (SINGLE_BYTE_CHAR_P (without_bits)) + charset = 0; + else + SPLIT_CHAR (without_bits, charset, c1, c2); + + if (charset + && CHARSET_DEFINED_P (charset) + && ((c1 >= 0 && c1 < 32) + || (c2 >= 0 && c2 < 32))) + { + /* Handle a generic character. */ + Lisp_Object name; + name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX); + CHECK_STRING (name); + return concat2 (build_string ("Character set "), name); + } + else + { + char tem[KEY_DESCRIPTION_SIZE], *end; + int nbytes, nchars; + Lisp_Object string; + + end = push_key_description (XUINT (key), tem, 1); + nbytes = end - tem; + nchars = multibyte_chars_in_text (tem, nbytes); + if (nchars == nbytes) + { + *end = '\0'; + string = build_string (tem); + } + else + string = make_multibyte_string (tem, nchars, nbytes); + return string; + } } 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 * @@ -1896,32 +2044,34 @@ push_text_char_description (c, p) } else *p++ = c; - return p; + return p; } /* This function cannot GC. */ DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0, - "Return a pretty description of file-character CHARACTER.\n\ -Control characters turn into \"^char\", etc.") - (character) + doc: /* Return a pretty description of file-character CHARACTER. +Control characters turn into "^char", etc. */) + (character) Lisp_Object character; { - char tem[6]; + /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */ + unsigned char str[6]; + int c; - CHECK_NUMBER (character, 0); + CHECK_NUMBER (character); - 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 @@ -1954,71 +2104,47 @@ ascii_sequence_p (seq) 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) + found = keymaps; + while (CONSP (found)) { -#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) - { - 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; @@ -2039,6 +2165,14 @@ indirect definition itself.") 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)) @@ -2052,8 +2186,8 @@ indirect definition itself.") 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; @@ -2068,10 +2202,10 @@ indirect definition itself.") /* 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); @@ -2083,35 +2217,46 @@ indirect definition itself.") 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). */ @@ -2124,7 +2269,7 @@ indirect definition itself.") 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); } } @@ -2137,96 +2282,172 @@ indirect definition itself.") /* 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, + doc: /* Return list of keys that invoke DEFINITION. +If KEYMAP is non-nil, search only KEYMAP and the global keymap. +If KEYMAP is nil, search all the currently active keymaps. +If KEYMAP is a list of keymaps, search only those keymaps. + +If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found, +rather than a list of all possible key sequences. +If FIRSTONLY is the symbol `non-ascii', return the first binding found, +no matter what it is. +If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters, +and entirely reject menu bindings. + +If optional 4th arg NOINDIRECT is non-nil, don't follow indirections +to other keymaps or slots. This makes it possible to search for an +indirect definition itself. */) + (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); + XSETCDR (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); @@ -2235,71 +2456,31 @@ where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last, 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; } /* describe-bindings - summarizing all the bindings in a set of keymaps. */ -DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, Sdescribe_bindings_internal, 0, 2, "", - "Show a list of all defined keys, and their definitions.\n\ -We put that list in a buffer, and display the buffer.\n\ -\n\ -The optional argument MENUS, if non-nil, says to mention menu bindings.\n\ -\(Ordinarily these are omitted from the output.)\n\ -The optional argument PREFIX, if non-nil, should be a key sequence;\n\ -then we display only bindings that start with that prefix.") - (menus, prefix) - Lisp_Object menus, prefix; -{ - register Lisp_Object thisbuf; - XSETBUFFER (thisbuf, current_buffer); - internal_with_output_to_temp_buffer ("*Help*", - describe_buffer_bindings, - list3 (thisbuf, prefix, menus)); - return Qnil; -} - -/* 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, + doc: /* Insert the list of all defined keys and their definitions. +The list is inserted in the current buffer, while the bindings are +looked up in BUFFER. +The optional argument PREFIX, if non-nil, should be a key sequence; +then we display only bindings that start with that prefix. +The optional argument MENUS, if non-nil, says to mention menu bindings. +\(Ordinarily these are omitted from the output.) */) + (buffer, prefix, menus) + Lisp_Object buffer, prefix, menus; { - Lisp_Object descbuf, prefix, shadow; - int nomenu; + Lisp_Object outbuf, shadow; + int nomenu = NILP (menus); register Lisp_Object start1; struct gcpro gcpro1; @@ -2309,16 +2490,10 @@ Keyboard translations:\n\n\ 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)) @@ -2330,7 +2505,7 @@ You type Translation\n\ for (c = 0; c < translate_len; c++) if (translate[c] != c) { - char buf[20]; + char buf[KEY_DESCRIPTION_SIZE]; char *bufend; if (alternate_heading) @@ -2339,10 +2514,10 @@ You type Translation\n\ 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); @@ -2355,73 +2530,93 @@ You type Translation\n\ describe_map_tree (Vkey_translation_map, 0, Qnil, prefix, "Key translations", nomenu, 1, 0); - { - int i, nmaps; - Lisp_Object *modes, *maps; - - /* Temporarily switch to descbuf, so that we can get that buffer's - minor modes correctly. */ - Fset_buffer (descbuf); - - if (!NILP (current_kboard->Voverriding_terminal_local_map) - || !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++) - { - /* 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], 1, shadow, prefix, title, nomenu, 0, 0); - shadow = Fcons (maps[i], shadow); - } - } /* Print the (major mode) local map. */ + start1 = Qnil; if (!NILP (current_kboard->Voverriding_terminal_local_map)) start1 = current_kboard->Voverriding_terminal_local_map; else if (!NILP (Voverriding_local_map)) start1 = Voverriding_local_map; - else - start1 = XBUFFER (descbuf)->keymap; if (!NILP (start1)) { describe_map_tree (start1, 1, shadow, prefix, - "Major Mode Bindings", nomenu, 0, 0); + "\f\nOverriding Bindings", nomenu, 0, 0); shadow = Fcons (start1, shadow); } + else + { + /* Print the minor mode and major mode keymaps. */ + int i, nmaps; + Lisp_Object *modes, *maps; + + /* Temporarily switch to `buffer', so that we can get that buffer's + minor modes correctly. */ + Fset_buffer (buffer); + + nmaps = current_minor_maps (&modes, &maps); + Fset_buffer (outbuf); + + /* Print the minor mode maps. */ + for (i = 0; i < nmaps; i++) + { + /* The title for a minor mode keymap + is constructed at run time. + We let describe_map_tree do the actual insertion + because it takes care of other features when doing so. */ + char *title, *p; + + if (!SYMBOLP (modes[i])) + abort(); + + p = title = (char *) alloca (42 + XSYMBOL (modes[i])->name->size); + *p++ = '\f'; + *p++ = '\n'; + *p++ = '`'; + bcopy (XSYMBOL (modes[i])->name->data, p, + XSYMBOL (modes[i])->name->size); + p += XSYMBOL (modes[i])->name->size; + *p++ = '\''; + bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1); + p += sizeof (" Minor Mode Bindings") - 1; + *p = 0; + + describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0); + shadow = Fcons (maps[i], shadow); + } + + start1 = get_local_map (BUF_PT (XBUFFER (buffer)), + XBUFFER (buffer), Qkeymap); + if (!NILP (start1)) + { + describe_map_tree (start1, 1, shadow, prefix, + "\f\nChar Property Bindings", nomenu, 0, 0); + shadow = Fcons (start1, shadow); + } + + start1 = get_local_map (BUF_PT (XBUFFER (buffer)), + XBUFFER (buffer), Qlocal_map); + if (!NILP (start1)) + { + if (EQ (start1, XBUFFER (buffer)->keymap)) + describe_map_tree (start1, 1, shadow, prefix, + "\f\nMajor Mode Bindings", nomenu, 0, 0); + else + describe_map_tree (start1, 1, shadow, prefix, + "\f\nChar Property 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; } @@ -2471,7 +2666,7 @@ key binding\n\ 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; @@ -2511,11 +2706,11 @@ key binding\n\ 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. */ @@ -2535,7 +2730,7 @@ key binding\n\ /* 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)) @@ -2543,11 +2738,11 @@ key binding\n\ } /* 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); } @@ -2567,8 +2762,8 @@ key binding\n\ static int previous_description_column; static void -describe_command (definition) - Lisp_Object definition; +describe_command (definition, args) + Lisp_Object definition, args; { register Lisp_Object tem1; int column = current_column (); @@ -2592,25 +2787,20 @@ describe_command (definition) if (SYMBOLP (definition)) { XSETSTRING (tem1, XSYMBOL (definition)->name); - insert_string ("`"); insert1 (tem1); - insert_string ("'\n"); + insert_string ("\n"); } 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 -describe_translation (definition) - Lisp_Object definition; +describe_translation (definition, args) + Lisp_Object definition, args; { register Lisp_Object tem1; @@ -2627,32 +2817,10 @@ describe_translation (definition) 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 @@ -2663,7 +2831,7 @@ static void describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) register Lisp_Object map; Lisp_Object keys; - void (*elt_describer) P_ ((Lisp_Object)); + void (*elt_describer) P_ ((Lisp_Object, Lisp_Object)); int partial; Lisp_Object shadow; Lisp_Object *seen; @@ -2677,6 +2845,8 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) 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. */ @@ -2697,28 +2867,28 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) 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, - elt_prefix, elt_describer, partial, shadow, map, + if (VECTORP (XCAR (tail)) + || CHAR_TABLE_P (XCAR (tail))) + describe_vector (XCAR (tail), + elt_prefix, Qnil, 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; @@ -2732,7 +2902,7 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) /* 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); @@ -2740,7 +2910,7 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) } tem = Flookup_key (map, kludge, Qt); - if (! EQ (tem, definition)) continue; + if (!EQ (tem, definition)) continue; if (first) { @@ -2753,20 +2923,20 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) 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); + (*elt_describer) (definition, Qnil); } - 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); } @@ -2776,25 +2946,26 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) } static void -describe_vector_princ (elt) - Lisp_Object elt; +describe_vector_princ (elt, fun) + Lisp_Object elt, fun; { Findent_to (make_number (16), make_number (1)); - Fprinc (elt, Qnil); + call1 (fun, elt); Fterpri (Qnil); } -DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0, - "Insert a description of contents of VECTOR.\n\ -This is text showing the elements of vector matched against indices.") - (vector) - Lisp_Object vector; +DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0, + doc: /* Insert a description of contents of VECTOR. +This is text showing the elements of vector matched against indices. */) + (vector, describer) + Lisp_Object vector, describer; { int count = specpdl_ptr - specpdl; - + if (NILP (describer)) + describer = intern ("princ"); specbind (Qstandard_output, Fcurrent_buffer ()); - CHECK_VECTOR_OR_CHAR_TABLE (vector, 0); - describe_vector (vector, Qnil, describe_vector_princ, 0, + CHECK_VECTOR_OR_CHAR_TABLE (vector); + describe_vector (vector, Qnil, describer, describe_vector_princ, 0, Qnil, Qnil, (int *)0, 0); return unbind_to (count, Qnil); @@ -2828,15 +2999,17 @@ This is text showing the elements of vector matched against indices.") When describing a sub-char-table, INDICES is a list of indices at higher levels in this char-table, - and CHAR_TABLE_DEPTH says how many levels down we have gone. */ + and CHAR_TABLE_DEPTH says how many levels down we have gone. + + ARGS is simply passed as the second argument to ELT_DESCRIBER. */ void -describe_vector (vector, elt_prefix, elt_describer, +describe_vector (vector, elt_prefix, args, elt_describer, partial, shadow, entire_map, indices, char_table_depth) register Lisp_Object vector; - Lisp_Object elt_prefix; - void (*elt_describer) P_ ((Lisp_Object)); + Lisp_Object elt_prefix, args; + void (*elt_describer) P_ ((Lisp_Object, Lisp_Object)); int partial; Lisp_Object shadow; Lisp_Object entire_map; @@ -2849,7 +3022,7 @@ describe_vector (vector, elt_prefix, elt_describer, 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 @@ -2858,6 +3031,8 @@ describe_vector (vector, elt_prefix, elt_describer, int character; int starting_i; + suppress = Qnil; + if (indices == 0) indices = (int *) alloca (3 * sizeof (int)); @@ -2925,9 +3100,9 @@ describe_vector (vector, elt_prefix, elt_describer, = 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; + if (NILP (definition)) continue; /* Don't mention suppressed commands. */ if (SYMBOLP (definition) && partial) @@ -2952,8 +3127,7 @@ describe_vector (vector, elt_prefix, elt_describer, } 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; @@ -2966,7 +3140,7 @@ describe_vector (vector, elt_prefix, elt_describer, { 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; @@ -2978,10 +3152,10 @@ describe_vector (vector, elt_prefix, elt_describer, { 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; } @@ -3019,7 +3193,7 @@ describe_vector (vector, elt_prefix, elt_describer, 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. */ @@ -3035,7 +3209,7 @@ describe_vector (vector, elt_prefix, elt_describer, } 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, @@ -3044,7 +3218,7 @@ describe_vector (vector, elt_prefix, elt_describer, if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition)) { insert ("\n", 1); - describe_vector (definition, elt_prefix, elt_describer, + describe_vector (definition, elt_prefix, args, elt_describer, partial, shadow, entire_map, indices, char_table_depth + 1); continue; @@ -3071,7 +3245,7 @@ describe_vector (vector, elt_prefix, elt_describer, } 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++; @@ -3091,13 +3265,12 @@ describe_vector (vector, elt_prefix, elt_describer, { 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 @@ -3111,14 +3284,14 @@ describe_vector (vector, elt_prefix, elt_describer, } else { - insert1 (Fsingle_key_description (make_number (i))); + insert1 (Fsingle_key_description (make_number (i), 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); + (*elt_describer) (definition, args); } /* For (sub) char-table, print `defalt' slot at last. */ @@ -3126,7 +3299,7 @@ describe_vector (vector, elt_prefix, elt_describer, { insert (" ", char_table_depth * 2); insert_string ("<>"); - (*elt_describer) (XCHAR_TABLE (vector)->defalt); + (*elt_describer) (XCHAR_TABLE (vector)->defalt, args); } UNGCPRO; @@ -3150,15 +3323,15 @@ apropos_accum (symbol, string) } DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0, - "Show all symbols whose names contain match for REGEXP.\n\ -If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\ -for each symbol and a symbol is mentioned only if that returns non-nil.\n\ -Return list of symbols found.") - (regexp, predicate) + doc: /* Show all symbols whose names contain match for REGEXP. +If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done +for each symbol and a symbol is mentioned only if that returns non-nil. +Return list of symbols found. */) + (regexp, predicate) Lisp_Object regexp, predicate; { struct gcpro gcpro1, gcpro2; - CHECK_STRING (regexp, 0); + CHECK_STRING (regexp); apropos_predicate = predicate; GCPRO2 (apropos_predicate, apropos_accumulate); apropos_accumulate = Qnil; @@ -3168,10 +3341,9 @@ Return list of symbols found.") return apropos_accumulate; } +void syms_of_keymap () { - Lisp_Object tem; - Qkeymap = intern ("keymap"); staticpro (&Qkeymap); @@ -3199,67 +3371,71 @@ syms_of_keymap () Ffset (intern ("Control-X-prefix"), control_x_map); DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands, - "List of commands given new key bindings recently.\n\ -This is used for internal purposes during Emacs startup;\n\ -don't alter it yourself."); + doc: /* List of commands given new key bindings recently. +This is used for internal purposes during Emacs startup; +don't alter it yourself. */); Vdefine_key_rebound_commands = Qt; DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map, - "Default keymap to use when reading from the minibuffer."); + doc: /* Default keymap to use when reading from the minibuffer. */); Vminibuffer_local_map = Fmake_sparse_keymap (Qnil); DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map, - "Local keymap for the minibuffer when spaces are not allowed."); + doc: /* Local keymap for the minibuffer when spaces are not allowed. */); Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil); + Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map); DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map, - "Local keymap for minibuffer input with completion."); + doc: /* Local keymap for minibuffer input with completion. */); Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil); + Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map); DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map, - "Local keymap for minibuffer input with completion, for exact match."); + doc: /* Local keymap for minibuffer input with completion, for exact match. */); Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil); + Fset_keymap_parent (Vminibuffer_local_must_match_map, + Vminibuffer_local_completion_map); DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist, - "Alist of keymaps to use for minor modes.\n\ -Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\ -key sequences and look up bindings iff VARIABLE's value is non-nil.\n\ -If two active keymaps bind the same key, the keymap appearing earlier\n\ -in the list takes precedence."); + doc: /* Alist of keymaps to use for minor modes. +Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read +key sequences and look up bindings iff VARIABLE's value is non-nil. +If two active keymaps bind the same key, the keymap appearing earlier +in the list takes precedence. */); Vminor_mode_map_alist = Qnil; DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist, - "Alist of keymaps to use for minor modes, in current major mode.\n\ -This variable is a alist just like `minor-mode-map-alist', and it is\n\ -used the same way (and before `minor-mode-map-alist'); however,\n\ -it is provided for major modes to bind locally."); + doc: /* Alist of keymaps to use for minor modes, in current major mode. +This variable is a alist just like `minor-mode-map-alist', and it is +used the same way (and before `minor-mode-map-alist'); however, +it is provided for major modes to bind locally. */); Vminor_mode_overriding_map_alist = Qnil; DEFVAR_LISP ("function-key-map", &Vfunction_key_map, - "Keymap mapping ASCII function key sequences onto their preferred forms.\n\ -This allows Emacs to recognize function keys sent from ASCII\n\ -terminals at any point in a key sequence.\n\ -\n\ -The `read-key-sequence' function replaces any subsequence bound by\n\ -`function-key-map' with its binding. More precisely, when the active\n\ -keymaps have no binding for the current key sequence but\n\ -`function-key-map' binds a suffix of the sequence to a vector or string,\n\ -`read-key-sequence' replaces the matching suffix with its binding, and\n\ -continues with the new sequence.\n\ -\n\ -The events that come from bindings in `function-key-map' are not\n\ -themselves looked up in `function-key-map'.\n\ -\n\ -For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\ -Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\ -`C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\ -key, typing `ESC O P x' would return [f1 x]."); + doc: /* Keymap mapping ASCII function key sequences onto their preferred forms. +This allows Emacs to recognize function keys sent from ASCII +terminals at any point in a key sequence. + +The `read-key-sequence' function replaces any subsequence bound by +`function-key-map' with its binding. More precisely, when the active +keymaps have no binding for the current key sequence but +`function-key-map' binds a suffix of the sequence to a vector or string, +`read-key-sequence' replaces the matching suffix with its binding, and +continues with the new sequence. + +The events that come from bindings in `function-key-map' are not +themselves looked up in `function-key-map'. + +For example, suppose `function-key-map' binds `ESC O P' to [f1]. +Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing +`C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix +key, typing `ESC O P x' would return [f1 x]. */); Vfunction_key_map = Fmake_sparse_keymap (Qnil); DEFVAR_LISP ("key-translation-map", &Vkey_translation_map, - "Keymap of key translations that can override keymaps.\n\ -This keymap works like `function-key-map', but comes after that,\n\ -and applies even for keys that have ordinary bindings."); + doc: /* Keymap of key translations that can override keymaps. +This keymap works like `function-key-map', but comes after that, +and applies even for keys that have ordinary bindings. */); Vkey_translation_map = Qnil; Qsingle_key_description = intern ("single-key-description"); @@ -3277,8 +3453,14 @@ and applies even for keys that have ordinary bindings."); 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); @@ -3295,20 +3477,20 @@ and applies even for keys that have ordinary bindings."); 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 (&Ssingle_key_description); 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"); }