X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/32ce36ad51e3c0eb7a7c2eabe8ee88cf489dd02d..b1314e15504ca365f79942dfff08591e5ef553d3:/src/keymap.c diff --git a/src/keymap.c b/src/keymap.c index b6a15754b6..1b67338480 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1,5 +1,5 @@ /* Manipulation of keymaps - Copyright (C) 1985, 86, 87, 88, 93, 94 Free Software Foundation, Inc. + Copyright (C) 1985, 86,87,88,93,94,95,98 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -15,18 +15,24 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ #include #include +#ifdef STDC_HEADERS +#include +#endif #undef NULL #include "lisp.h" #include "commands.h" #include "buffer.h" +#include "charset.h" #include "keyboard.h" #include "termhooks.h" #include "blockinput.h" +#include "puresize.h" #define min(a, b) ((a) < (b) ? (a) : (b)) @@ -68,12 +74,25 @@ Lisp_Object Vminibuffer_local_must_match_map; /* Alist of minor mode variables and keymaps. */ Lisp_Object Vminor_mode_map_alist; +/* Alist of major-mode-specific overrides for + minor mode variables and keymaps. */ +Lisp_Object Vminor_mode_overriding_map_alist; + /* Keymap mapping ASCII function key sequences onto their preferred forms. Initialized by the terminal-specific lisp files. See DEFVAR for more documentation. */ Lisp_Object Vfunction_key_map; -Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii; +/* Keymap mapping ASCII function key sequences onto their preferred forms. */ +Lisp_Object Vkey_translation_map; + +/* A list of all commands given new bindings since a certain time + when nil was stored here. + This is used to speed up recomputation of menu key equivalents + when Emacs starts up. t means don't record anything here. */ +Lisp_Object Vdefine_key_rebound_commands; + +Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item; /* A char with the CHAR_META bit set in a vector or the 0200 bit set in a string key sequence is equivalent to prefixing with this @@ -82,17 +101,16 @@ extern Lisp_Object meta_prefix_char; extern Lisp_Object Voverriding_local_map; -void describe_map_tree (); static Lisp_Object define_as_prefix (); static Lisp_Object describe_buffer_bindings (); -static void describe_command (); +static void describe_command (), describe_translation (); static void describe_map (); /* Keymap object support - constructors and predicates. */ DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0, - "Construct and return a new keymap, of the form (keymap VECTOR . ALIST).\n\ -VECTOR is a vector which holds the bindings for the ASCII\n\ + "Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).\n\ +CHARTABLE is a char-table that holds the bindings for the ASCII\n\ characters. ALIST is an assoc-list which holds bindings for function keys,\n\ mouse events, and any other things that appear in the input stream.\n\ All entries in it are initially nil, meaning \"command undefined\".\n\n\ @@ -107,8 +125,7 @@ in case you use it as a menu with `x-popup-menu'.") else tail = Qnil; return Fcons (Qkeymap, - Fcons (Fmake_vector (make_number (DENSE_TABLE_SIZE), Qnil), - tail)); + Fcons (Fmake_char_table (Qkeymap, Qnil), tail)); } DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0, @@ -170,7 +187,7 @@ synkey (frommap, fromchar, tomap, tochar) #endif /* 0 */ DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0, - "Return t if ARG is a keymap.\n\ + "Return t if OBJECT is a keymap.\n\ \n\ A keymap is a list (keymap . ALIST),\n\ or a symbol whose function definition is itself a keymap.\n\ @@ -207,9 +224,16 @@ get_keymap_1 (object, error, autoload) Lisp_Object tem; autoload_retry: - tem = indirect_function (object); - if (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap)) - return tem; + if (NILP (object)) + goto end; + if (CONSP (object) && EQ (XCAR (object), Qkeymap)) + return object; + else + { + 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. */ @@ -233,6 +257,7 @@ get_keymap_1 (object, error, autoload) } } + end: if (error) wrong_type_argument (Qkeymapp, object); else @@ -248,8 +273,162 @@ get_keymap (object) { return get_keymap_1 (object, 1, 0); } + +/* Return the parent map of the keymap MAP, or nil if it has none. + We assume that MAP is a valid keymap. */ + +DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0, + "Return the parent keymap of KEYMAP.") + (keymap) + Lisp_Object keymap; +{ + Lisp_Object list; + + keymap = get_keymap_1 (keymap, 1, 1); + + /* Skip past the initial element `keymap'. */ + list = XCONS (keymap)->cdr; + for (; CONSP (list); list = XCONS (list)->cdr) + { + /* See if there is another `keymap'. */ + if (EQ (Qkeymap, XCONS (list)->car)) + return list; + } + + return Qnil; +} + +/* Set the parent keymap of MAP to PARENT. */ + +DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0, + "Modify KEYMAP to set its parent map to PARENT.\n\ +PARENT should be nil or another keymap.") + (keymap, parent) + Lisp_Object keymap, parent; +{ + Lisp_Object list, prev; + int i; + + keymap = get_keymap_1 (keymap, 1, 1); + if (!NILP (parent)) + parent = get_keymap_1 (parent, 1, 1); + + /* Skip past the initial element `keymap'. */ + prev = keymap; + while (1) + { + list = XCONS (prev)->cdr; + /* If there is a parent keymap here, replace it. + If we came to the end, add the parent in PREV. */ + if (! CONSP (list) || EQ (Qkeymap, XCONS (list)->car)) + { + /* If we already have the right parent, return now + so that we avoid the loops below. */ + if (EQ (XCONS (prev)->cdr, parent)) + return parent; + + XCONS (prev)->cdr = parent; + break; + } + prev = list; + } + + /* Scan through for submaps, and set their parents too. */ + + for (list = XCONS (keymap)->cdr; CONSP (list); list = XCONS (list)->cdr) + { + /* Stop the scan when we come to the parent. */ + if (EQ (XCONS (list)->car, Qkeymap)) + break; + + /* If this element holds a prefix map, deal with it. */ + if (CONSP (XCONS (list)->car) + && CONSP (XCONS (XCONS (list)->car)->cdr)) + fix_submap_inheritance (keymap, XCONS (XCONS (list)->car)->car, + XCONS (XCONS (list)->car)->cdr); + + if (VECTORP (XCONS (list)->car)) + for (i = 0; i < XVECTOR (XCONS (list)->car)->size; i++) + if (CONSP (XVECTOR (XCONS (list)->car)->contents[i])) + fix_submap_inheritance (keymap, make_number (i), + XVECTOR (XCONS (list)->car)->contents[i]); + + if (CHAR_TABLE_P (XCONS (list)->car)) + { + Lisp_Object indices[3]; + + map_char_table (fix_submap_inheritance, Qnil, XCONS (list)->car, + keymap, 0, indices); + } + } + + return parent; +} + +/* EVENT is defined in MAP as a prefix, and SUBMAP is its definition. + if EVENT is also a prefix in MAP's parent, + make sure that SUBMAP inherits that definition as its own parent. */ + +void +fix_submap_inheritance (map, event, submap) + Lisp_Object map, event, submap; +{ + Lisp_Object map_parent, parent_entry; + + /* SUBMAP is a cons that we found as a key binding. + Discard the other things found in a menu key binding. */ + + if (CONSP (submap)) + { + /* May be an old format menu item */ + if (STRINGP (XCONS (submap)->car)) + { + submap = XCONS (submap)->cdr; + /* Also remove a menu help string, if any, + following the menu item name. */ + if (CONSP (submap) && STRINGP (XCONS (submap)->car)) + submap = XCONS (submap)->cdr; + /* Also remove the sublist that caches key equivalences, if any. */ + if (CONSP (submap) + && CONSP (XCONS (submap)->car)) + { + Lisp_Object carcar; + carcar = XCONS (XCONS (submap)->car)->car; + if (NILP (carcar) || VECTORP (carcar)) + submap = XCONS (submap)->cdr; + } + } + + /* Or a new format menu item */ + else if (EQ (XCONS (submap)->car, Qmenu_item) + && CONSP (XCONS (submap)->cdr)) + { + submap = XCONS (XCONS (submap)->cdr)->cdr; + if (CONSP (submap)) + submap = XCONS (submap)->car; + } + } + + /* If it isn't a keymap now, there's no work to do. */ + if (! CONSP (submap) + || ! EQ (XCONS (submap)->car, Qkeymap)) + return; + map_parent = Fkeymap_parent (map); + if (! NILP (map_parent)) + parent_entry = access_keymap (map_parent, event, 0, 0); + else + parent_entry = Qnil; + + /* If MAP's parent has something other than a keymap, + our own submap shadows it completely, so use nil as SUBMAP's parent. */ + if (! (CONSP (parent_entry) && EQ (XCONS (parent_entry)->car, Qkeymap))) + parent_entry = Qnil; + if (! EQ (parent_entry, submap)) + Fset_keymap_parent (submap, parent_entry); +} + /* Look up IDX in MAP. IDX may be any sort of event. Note that this does only one level of lookup; IDX must be a single event, not a sequence. @@ -310,6 +489,8 @@ access_keymap (map, idx, t_ok, noinherit) val = XCONS (binding)->cdr; if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) return Qnil; + if (CONSP (val)) + fix_submap_inheritance (map, idx, val); return val; } if (t_ok && EQ (XCONS (binding)->car, Qt)) @@ -322,6 +503,26 @@ access_keymap (map, idx, t_ok, noinherit) val = XVECTOR (binding)->contents[XFASTINT (idx)]; if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) return Qnil; + if (CONSP (val)) + fix_submap_inheritance (map, idx, val); + return val; + } + } + else if (CHAR_TABLE_P (binding)) + { + /* Character codes with modifiers + are not included in a char-table. + All character codes without modifiers are included. */ + if (NATNUMP (idx) + && ! (XFASTINT (idx) + & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER + | CHAR_SHIFT | CHAR_CTL | CHAR_META))) + { + val = Faref (binding, idx); + if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) + return Qnil; + if (CONSP (val)) + fix_submap_inheritance (map, idx, val); return val; } } @@ -352,40 +553,76 @@ 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)) - object = access_keymap (map, Fcdr (object), 0, 0); - - /* If the keymap contents looks like (STRING . DEFN), - use DEFN. + /* 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)) + { + if (CONSP (XCDR (object))) + { + object = XCDR (XCDR (object)); + if (CONSP (object)) + object = XCAR (object); + } + else + /* Invalid keymap */ + return object; + } + + /* If the keymap contents looks like (STRING . DEFN), use DEFN. Keymap alist elements like (CHAR MENUSTRING . DEFN) will be used by HierarKey menus. */ - else if (CONSP (object) - && STRINGP (XCONS (object)->car)) + else if (STRINGP (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 contents are (KEYMAP . ELEMENT), go indirect. */ else - /* Anything else is really the value. */ - return object; + { + register Lisp_Object map; + map = get_keymap_1 (Fcar_safe (object), 0, autoload); + if (NILP (map)) + /* Invalid keymap */ + return object; + else + { + Lisp_Object key; + key = Fcdr (object); + if (INTEGERP (key) && (XINT (key) & meta_modifier)) + { + object = access_keymap (map, meta_prefix_char, 0, 0); + map = get_keymap_1 (object, 0, autoload); + object = access_keymap (map, make_number (XINT (key) + & ~meta_modifier), + 0, 0); + } + else + object = access_keymap (map, key, 0, 0); + } + } } } @@ -395,9 +632,10 @@ store_in_keymap (keymap, idx, def) register Lisp_Object idx; register Lisp_Object def; { - /* If we are preparing to dump, and DEF might be pure, - copy it to ensure it is not pure. */ - if (!NILP (Vpurify_flag) && CONSP (def)) + /* If we are preparing to dump, and DEF is a menu element + with a menu item indicator, copy it to ensure it is not pure. */ + if (CONSP (def) && PURE_P (def) + && (EQ (XCONS (def)->car, Qmenu_item) || STRINGP (XCONS (def)->car))) def = Fcons (XCONS (def)->car, XCONS (def)->cdr); if (!CONSP (keymap) || ! EQ (XCONS (keymap)->car, Qkeymap)) @@ -444,6 +682,21 @@ store_in_keymap (keymap, idx, def) } insertion_point = tail; } + else if (CHAR_TABLE_P (elt)) + { + /* Character codes with modifiers + are not included in a char-table. + All character codes without modifiers are included. */ + if (NATNUMP (idx) + && ! (XFASTINT (idx) + & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER + | CHAR_SHIFT | CHAR_CTL | CHAR_META))) + { + Faset (elt, idx, def); + return def; + } + insertion_point = tail; + } else if (CONSP (elt)) { if (EQ (idx, XCONS (elt)->car)) @@ -475,6 +728,13 @@ store_in_keymap (keymap, idx, def) return def; } +void +copy_keymap_1 (chartable, idx, elt) + Lisp_Object chartable, idx, elt; +{ + if (!SYMBOLP (elt) && ! NILP (Fkeymapp (elt))) + Faset (chartable, idx, Fcopy_keymap (elt)); +} DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0, "Return a copy of the keymap KEYMAP.\n\ @@ -495,7 +755,16 @@ is not copied.") Lisp_Object elt; elt = XCONS (tail)->car; - if (VECTORP (elt)) + if (CHAR_TABLE_P (elt)) + { + Lisp_Object indices[3]; + + elt = Fcopy_sequence (elt); + XCONS (tail)->car = elt; + + map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices); + } + else if (VECTORP (elt)) { int i; @@ -505,45 +774,83 @@ is not copied.") for (i = 0; i < XVECTOR (elt)->size; i++) if (!SYMBOLP (XVECTOR (elt)->contents[i]) && ! NILP (Fkeymapp (XVECTOR (elt)->contents[i]))) - XVECTOR (elt)->contents[i] = - Fcopy_keymap (XVECTOR (elt)->contents[i]); + XVECTOR (elt)->contents[i] + = Fcopy_keymap (XVECTOR (elt)->contents[i]); } - else if (CONSP (elt)) + else if (CONSP (elt) && CONSP (XCONS (elt)->cdr)) { - /* Skip the optional menu string. */ - if (CONSP (XCONS (elt)->cdr) - && STRINGP (XCONS (XCONS (elt)->cdr)->car)) - { - Lisp_Object tem; + Lisp_Object tem; + tem = XCONS (elt)->cdr; - /* Copy the cell, since copy-alist didn't go this deep. */ - XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car, - XCONS (XCONS (elt)->cdr)->cdr); + /* Is this a new format menu item. */ + if (EQ (XCONS (tem)->car,Qmenu_item)) + { + /* Copy cell with menu-item marker. */ + XCONS (elt)->cdr + = Fcons (XCONS (tem)->car, XCONS (tem)->cdr); elt = XCONS (elt)->cdr; - - /* Also skip the optional menu help string. */ - if (CONSP (XCONS (elt)->cdr) - && STRINGP (XCONS (XCONS (elt)->cdr)->car)) + tem = XCONS (elt)->cdr; + if (CONSP (tem)) + { + /* Copy cell with menu-item name. */ + XCONS (elt)->cdr + = Fcons (XCONS (tem)->car, XCONS (tem)->cdr); + elt = XCONS (elt)->cdr; + tem = XCONS (elt)->cdr; + }; + if (CONSP (tem)) + { + /* Copy cell with binding and if the binding is a keymap, + copy that. */ + XCONS (elt)->cdr + = Fcons (XCONS (tem)->car, XCONS (tem)->cdr); + elt = XCONS (elt)->cdr; + tem = XCONS (elt)->car; + if (!(SYMBOLP (tem) || NILP (Fkeymapp (tem)))) + XCONS (elt)->car = Fcopy_keymap (tem); + tem = XCONS (elt)->cdr; + if (CONSP (tem) && CONSP (XCONS (tem)->car)) + /* Delete cache for key equivalences. */ + XCONS (elt)->cdr = XCONS (tem)->cdr; + } + } + else + { + /* It may be an old fomat menu item. + Skip the optional menu string. + */ + if (STRINGP (XCONS (tem)->car)) { - XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car, - XCONS (XCONS (elt)->cdr)->cdr); + /* Copy the cell, since copy-alist didn't go this deep. */ + XCONS (elt)->cdr + = Fcons (XCONS (tem)->car, XCONS (tem)->cdr); elt = XCONS (elt)->cdr; + tem = XCONS (elt)->cdr; + /* Also skip the optional menu help string. */ + if (CONSP (tem) && STRINGP (XCONS (tem)->car)) + { + XCONS (elt)->cdr + = Fcons (XCONS (tem)->car, XCONS (tem)->cdr); + elt = XCONS (elt)->cdr; + tem = XCONS (elt)->cdr; + } + /* There may also be a list that caches key equivalences. + Just delete it for the new keymap. */ + if (CONSP (tem) + && CONSP (XCONS (tem)->car) + && (NILP (XCONS (XCONS (tem)->car)->car) + || VECTORP (XCONS (XCONS (tem)->car)->car))) + XCONS (elt)->cdr = XCONS (tem)->cdr; } - /* There may also be a list that caches key equivalences. - Just delete it for the new keymap. */ - if (CONSP (XCONS (elt)->cdr) - && CONSP (XCONS (XCONS (elt)->cdr)->car) - && (NILP (tem = XCONS (XCONS (XCONS (elt)->cdr)->car)->car) - || VECTORP (tem))) - XCONS (elt)->cdr = XCONS (XCONS (elt)->cdr)->cdr; + if (CONSP (elt) + && ! SYMBOLP (XCONS (elt)->cdr) + && ! NILP (Fkeymapp (XCONS (elt)->cdr))) + XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr); } - if (CONSP (elt) - && ! SYMBOLP (XCONS (elt)->cdr) - && ! NILP (Fkeymapp (XCONS (elt)->cdr))) - XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr); + } } - + return copy; } @@ -594,6 +901,9 @@ the front of KEYMAP.") if (length == 0) return Qnil; + if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt)) + Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands); + GCPRO3 (keymap, key, def); if (VECTORP (key)) @@ -606,6 +916,9 @@ the front of KEYMAP.") { 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) @@ -658,7 +971,7 @@ it takes to reach a non-prefix command.\n\ \n\ Normally, `lookup-key' ignores bindings for t, which act as default\n\ bindings, used when nothing else in the keymap applies; this makes it\n\ -useable as a general function for probing keymaps. However, if the\n\ +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) @@ -697,6 +1010,9 @@ recognize the default bindings, just as `read-key-sequence' does.") { 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) @@ -740,6 +1056,20 @@ define_as_prefix (keymap, c) 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 @@ -754,6 +1084,7 @@ define_as_prefix (keymap, c) if (!NILP (tail)) inherit = define_as_prefix (tail, c); } +#endif cmd = nconc2 (cmd, inherit); store_in_keymap (keymap, c, cmd); @@ -784,6 +1115,13 @@ append_key (key_sequence, key) static Lisp_Object *cmm_modes, *cmm_maps; static int cmm_size; +/* Error handler used in current_minor_maps. */ +static Lisp_Object +current_minor_maps_error () +{ + return Qnil; +} + /* Store a pointer to an array of the keymaps of the currently active minor modes in *buf, and return the number of maps it contains. @@ -805,55 +1143,81 @@ current_minor_maps (modeptr, mapptr) Lisp_Object **modeptr, **mapptr; { int i = 0; + int list_number = 0; Lisp_Object alist, assoc, var, val; + Lisp_Object lists[2]; + + lists[0] = Vminor_mode_overriding_map_alist; + lists[1] = Vminor_mode_map_alist; + + for (list_number = 0; list_number < 2; list_number++) + for (alist = lists[list_number]; + CONSP (alist); + alist = XCONS (alist)->cdr) + if ((assoc = XCONS (alist)->car, CONSP (assoc)) + && (var = XCONS (assoc)->car, SYMBOLP (var)) + && (val = find_symbol_value (var), ! EQ (val, Qunbound)) + && ! NILP (val)) + { + Lisp_Object temp; - for (alist = Vminor_mode_map_alist; - CONSP (alist); - alist = XCONS (alist)->cdr) - if ((assoc = XCONS (alist)->car, CONSP (assoc)) - && (var = XCONS (assoc)->car, SYMBOLP (var)) - && (val = find_symbol_value (var), ! EQ (val, Qunbound)) - && ! NILP (val)) - { - if (i >= cmm_size) - { - Lisp_Object *newmodes, *newmaps; + /* If a variable has an entry in Vminor_mode_overriding_map_alist, + and also an entry in Vminor_mode_map_alist, + ignore the latter. */ + if (list_number == 1) + { + val = assq_no_quit (var, lists[0]); + if (!NILP (val)) + break; + } - if (cmm_maps) - { - BLOCK_INPUT; - cmm_size *= 2; - newmodes - = (Lisp_Object *) realloc (cmm_modes, - cmm_size * sizeof (Lisp_Object)); - newmaps - = (Lisp_Object *) realloc (cmm_maps, - cmm_size * sizeof (Lisp_Object)); - UNBLOCK_INPUT; - } - else - { - BLOCK_INPUT; - cmm_size = 30; - newmodes - = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object)); - newmaps - = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object)); - UNBLOCK_INPUT; - } + if (i >= cmm_size) + { + Lisp_Object *newmodes, *newmaps; - if (newmaps && newmodes) - { - cmm_modes = newmodes; - cmm_maps = newmaps; - } - else - break; - } - cmm_modes[i] = var; - cmm_maps [i] = Findirect_function (XCONS (assoc)->cdr); - i++; - } + if (cmm_maps) + { + BLOCK_INPUT; + cmm_size *= 2; + newmodes + = (Lisp_Object *) realloc (cmm_modes, + cmm_size * sizeof (Lisp_Object)); + newmaps + = (Lisp_Object *) realloc (cmm_maps, + cmm_size * sizeof (Lisp_Object)); + UNBLOCK_INPUT; + } + else + { + BLOCK_INPUT; + cmm_size = 30; + newmodes + = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object)); + newmaps + = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object)); + UNBLOCK_INPUT; + } + + if (newmaps && newmodes) + { + cmm_modes = newmodes; + cmm_maps = newmaps; + } + else + break; + } + + /* Get the keymap definition--or nil if it is not defined. */ + temp = internal_condition_case_1 (Findirect_function, + XCONS (assoc)->cdr, + Qerror, current_minor_maps_error); + if (!NILP (temp)) + { + cmm_modes[i] = var; + cmm_maps [i] = temp; + i++; + } + } if (modeptr) *modeptr = cmm_modes; if (mapptr) *mapptr = cmm_maps; @@ -881,7 +1245,14 @@ recognize the default bindings, just as `read-key-sequence' does.") GCPRO1 (key); - if (!NILP (Voverriding_local_map)) + if (!NILP (current_kboard->Voverriding_terminal_local_map)) + { + value = Flookup_key (current_kboard->Voverriding_terminal_local_map, + key, accept_default); + if (! NILP (value) && !INTEGERP (value)) + RETURN_UNGCPRO (value); + } + else if (!NILP (Voverriding_local_map)) { value = Flookup_key (Voverriding_local_map, key, accept_default); if (! NILP (value) && !INTEGERP (value)) @@ -889,6 +1260,8 @@ recognize the default bindings, just as `read-key-sequence' does.") } else { + Lisp_Object local; + nmaps = current_minor_maps (0, &maps); /* Note that all these maps are GCPRO'd in the places where we found them. */ @@ -901,9 +1274,11 @@ recognize the default bindings, just as `read-key-sequence' does.") RETURN_UNGCPRO (value); } - if (! NILP (current_buffer->keymap)) + local = get_local_map (PT, current_buffer); + + if (! NILP (local)) { - value = Flookup_key (current_buffer->keymap, key, accept_default); + value = Flookup_key (local, key, accept_default); if (! NILP (value) && !INTEGERP (value)) RETURN_UNGCPRO (value); } @@ -998,91 +1373,25 @@ bindings; see the description of `lookup-key' for more details about this.") return Flist (j, maps); } -DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2, - "kSet key globally: \nCSet key %s to command: ", - "Give KEY a global binding as COMMAND.\n\ -COMMAND is a symbol naming an interactively-callable function.\n\ -KEY is a key sequence (a string or vector of characters or event types).\n\ -Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\ -can be included if you use a vector.\n\ -Note that if KEY has a local binding in the current buffer\n\ -that local binding will continue to shadow any global binding.") - (keys, function) - Lisp_Object keys, function; -{ - if (!VECTORP (keys) && !STRINGP (keys)) - keys = wrong_type_argument (Qarrayp, keys); - - Fdefine_key (current_global_map, keys, function); - return Qnil; -} - -DEFUN ("local-set-key", Flocal_set_key, Slocal_set_key, 2, 2, - "kSet key locally: \nCSet key %s locally to command: ", - "Give KEY a local binding as COMMAND.\n\ -COMMAND is a symbol naming an interactively-callable function.\n\ -KEY is a key sequence (a string or vector of characters or event types).\n\ -Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\ -can be included if you use a vector.\n\ -The binding goes in the current buffer's local map,\n\ -which in most cases is shared with all other buffers in the same major mode.") - (keys, function) - Lisp_Object keys, function; -{ - register Lisp_Object map; - map = current_buffer->keymap; - if (NILP (map)) - { - map = Fmake_sparse_keymap (Qnil); - current_buffer->keymap = map; - } - - if (!VECTORP (keys) && !STRINGP (keys)) - keys = wrong_type_argument (Qarrayp, keys); - - Fdefine_key (map, keys, function); - return Qnil; -} - -DEFUN ("global-unset-key", Fglobal_unset_key, Sglobal_unset_key, - 1, 1, "kUnset key globally: ", - "Remove global binding of KEY.\n\ -KEY is a string representing a sequence of keystrokes.") - (keys) - Lisp_Object keys; -{ - return Fglobal_set_key (keys, Qnil); -} - -DEFUN ("local-unset-key", Flocal_unset_key, Slocal_unset_key, 1, 1, - "kUnset key locally: ", - "Remove local binding of KEY.\n\ -KEY is a string representing a sequence of keystrokes.") - (keys) - Lisp_Object keys; -{ - if (!NILP (current_buffer->keymap)) - Flocal_set_key (keys, Qnil); - return Qnil; -} - -DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 2, 0, +DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0, "Define COMMAND as a prefix command. COMMAND should be a symbol.\n\ A new sparse keymap is stored as COMMAND's function definition and its value.\n\ If a second optional argument MAPVAR is given, the map is stored as\n\ its value instead of as COMMAND's value; but COMMAND is still defined\n\ -as a function.") - (name, mapvar) - Lisp_Object name, mapvar; +as a function.\n\ +The third optional argument NAME, if given, supplies a menu name\n\ +string for the map. This is required to use the keymap as a menu.") + (command, mapvar, name) + Lisp_Object command, mapvar, name; { Lisp_Object map; - map = Fmake_sparse_keymap (Qnil); - Ffset (name, map); + map = Fmake_sparse_keymap (name); + Ffset (command, map); if (!NILP (mapvar)) Fset (mapvar, map); else - Fset (name, map); - return name; + Fset (command, map); + return command; } DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0, @@ -1092,7 +1401,6 @@ DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0, { keymap = get_keymap (keymap); current_global_map = keymap; - record_asynch_buffer_change (); return Qnil; } @@ -1107,7 +1415,6 @@ If KEYMAP is nil, that means no local keymap.") keymap = get_keymap (keymap); current_buffer->keymap = keymap; - record_asynch_buffer_change (); return Qnil; } @@ -1138,6 +1445,8 @@ 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 (); + /* This function cannot GC. */ DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, @@ -1145,11 +1454,11 @@ DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, "Find all keymaps accessible via prefix characters from KEYMAP.\n\ Returns a list of elements of the form (KEYS . MAP), where the sequence\n\ KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\ -so that the KEYS increase in length. The first element is (\"\" . KEYMAP).\n\ +so that the KEYS increase in length. The first element is ([] . KEYMAP).\n\ An optional argument PREFIX, if non-nil, should be a key sequence;\n\ then the value includes only maps for prefixes that start with PREFIX.") - (startmap, prefix) - Lisp_Object startmap, prefix; + (keymap, prefix) + Lisp_Object keymap, prefix; { Lisp_Object maps, good_maps, tail; int prefixlen = 0; @@ -1164,19 +1473,44 @@ then the value includes only maps for prefixes that start with PREFIX.") /* If a prefix was specified, start with the keymap (if any) for that prefix, so we don't waste time considering other prefixes. */ Lisp_Object tem; - tem = Flookup_key (startmap, prefix, Qt); + tem = Flookup_key (keymap, prefix, Qt); /* Flookup_key may give us nil, or a number, if the prefix is not defined in this particular map. It might even give us a list that isn't a keymap. */ tem = get_keymap_1 (tem, 0, 0); if (!NILP (tem)) - maps = Fcons (Fcons (prefix, tem), Qnil); + { + /* Convert PREFIX to a vector now, so that later on + we don't have to deal with the possibility of a string. */ + if (STRINGP (prefix)) + { + int i, i_byte, c; + Lisp_Object copy; + + copy = Fmake_vector (make_number (XSTRING (prefix)->size), Qnil); + for (i = 0, i_byte = 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) + c ^= 0200 | meta_modifier; + } + XVECTOR (copy)->contents[i_before] = make_number (c); + } + prefix = copy; + } + maps = Fcons (Fcons (prefix, tem), Qnil); + } else return Qnil; } else maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil), - get_keymap (startmap)), + get_keymap (keymap)), Qnil); /* For each map in the list maps, @@ -1197,6 +1531,8 @@ then the value includes only maps for prefixes that start with PREFIX.") thismap = Fcdr (Fcar (tail)); last = make_number (XINT (Flength (thisseq)) - 1); is_metized = (XINT (last) >= 0 + /* Don't metize the last char of PREFIX. */ + && XINT (last) >= prefixlen && EQ (Faref (thisseq, last), meta_prefix_char)); for (; CONSP (thismap); thismap = XCONS (thismap)->cdr) @@ -1207,7 +1543,15 @@ then the value includes only maps for prefixes that start with PREFIX.") QUIT; - if (VECTORP (elt)) + if (CHAR_TABLE_P (elt)) + { + Lisp_Object indices[3]; + + map_char_table (accessible_keymaps_char_table, Qnil, + elt, Fcons (maps, Fcons (tail, thisseq)), + 0, indices); + } + else if (VECTORP (elt)) { register int i; @@ -1253,7 +1597,7 @@ then the value includes only maps for prefixes that start with PREFIX.") } } } - } + } else if (CONSP (elt)) { register Lisp_Object cmd, tem, filter; @@ -1276,9 +1620,12 @@ then the value includes only maps for prefixes that start with PREFIX.") turn it into a meta-ized keystroke. */ if (is_metized && INTEGERP (elt)) { - tem = Fcopy_sequence (thisseq); - Faset (tem, last, - make_number (XINT (elt) | meta_modifier)); + Lisp_Object element; + + element = thisseq; + tem = Fvconcat (1, &element); + XSETFASTINT (XVECTOR (tem)->contents[XINT (last)], + XINT (elt) | meta_modifier); /* This new sequence is the same length as thisseq, so stick it in the list right @@ -1327,6 +1674,34 @@ 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. */ @@ -1339,7 +1714,7 @@ spaces are put between sequence elements, etc.") Lisp_Object keys; { int len; - int i; + int i, i_byte; Lisp_Object sep; Lisp_Object *args; @@ -1347,34 +1722,62 @@ spaces are put between sequence elements, etc.") { Lisp_Object vector; vector = Fmake_vector (Flength (keys), Qnil); - for (i = 0; i < XSTRING (keys)->size; i++) + for (i = 0, i_byte = 0; i < XSTRING (keys)->size; ) { - if (XSTRING (keys)->data[i] & 0x80) - XSETFASTINT (XVECTOR (vector)->contents[i], - meta_modifier | (XSTRING (keys)->data[i] & ~0x80)); + int c; + int i_before = i; + + if (STRING_MULTIBYTE (keys)) + FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte); else - XSETFASTINT (XVECTOR (vector)->contents[i], - XSTRING (keys)->data[i]); + { + c = XSTRING (keys)->data[i++]; + if (c & 0200) + c ^= 0200 | meta_modifier; + } + + XSETFASTINT (XVECTOR (vector)->contents[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 (XVECTOR (keys)->contents[i]); + 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 (XCONS (keys)->car); + args[i * 2 + 1] = sep; + keys = XCONS (keys)->cdr; + } } + else + keys = wrong_type_argument (Qarrayp, keys); return Fconcat (len * 2 - 1, args); } @@ -1437,13 +1840,7 @@ push_key_description (c, p) *p++ = 'A'; *p++ = 'B'; } - else if (c == Ctl('J')) - { - *p++ = 'L'; - *p++ = 'F'; - *p++ = 'D'; - } - else if (c == Ctl('M')) + else if (c == Ctl ('M')) { *p++ = 'R'; *p++ = 'E'; @@ -1466,22 +1863,40 @@ push_key_description (c, p) *p++ = 'L'; } else if (c == ' ') - { + { *p++ = 'S'; *p++ = 'P'; *p++ = 'C'; } - else if (c < 256) + else if (c < 128 + || (NILP (current_buffer->enable_multibyte_characters) + && SINGLE_BYTE_CHAR_P (c))) *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'; + if (! NILP (current_buffer->enable_multibyte_characters)) + c = unibyte_char_to_multibyte (c); + + if (NILP (current_buffer->enable_multibyte_characters) + || SINGLE_BYTE_CHAR_P (c) + || ! char_valid_p (c, 0)) + { + 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 + { + unsigned char work[4], *str; + int i = CHAR_STRING (c, work, str); + bcopy (str, p, i); + p += i; + } } return p; @@ -1495,14 +1910,39 @@ Control characters turn into C-whatever, etc.") (key) Lisp_Object key; { - 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_NON_ASCII_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, 0); + return concat2 (build_string ("Character set "), name); + } + else + { + char tem[20]; + + *push_key_description (XUINT (key), tem) = 0; + return build_string (tem); + } } else if (SYMBOLP (key)) /* Function key or event-symbol */ return Fsymbol_name (key); @@ -1541,16 +1981,24 @@ push_text_char_description (c, p) /* This function cannot GC. */ DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0, - "Return a pretty description of file-character CHAR.\n\ + "Return a pretty description of file-character CHARACTER.\n\ Control characters turn into \"^char\", etc.") - (chr) - Lisp_Object chr; + (character) + Lisp_Object character; { char tem[6]; - CHECK_NUMBER (chr, 0); + CHECK_NUMBER (character, 0); + + if (!SINGLE_BYTE_CHAR_P (XFASTINT (character))) + { + unsigned char *str; + int len = non_ascii_char_to_string (XFASTINT (character), tem, &str); + + return make_multibyte_string (str, 1, len); + } - *push_text_char_description (XINT (chr) & 0377, tem) = 0; + *push_text_char_description (XINT (character) & 0377, tem) = 0; return build_string (tem); } @@ -1582,6 +2030,9 @@ ascii_sequence_p (seq) /* where-is - finding a command in a set of keymaps. */ +static Lisp_Object where_is_internal_1 (); +static void where_is_internal_2 (); + /* This function can GC if Flookup_key autoloads any keymaps. */ DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0, @@ -1591,10 +2042,10 @@ 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 t, avoid key sequences which use non-ASCII\n\ -keys and therefore may not be usable on ASCII terminals. If FIRSTONLY\n\ -is the symbol `non-ascii', return the first binding found, no matter\n\ -what its components.\n\ +If FIRSTONLY is the symbol `non-ascii', return the first binding found,\n\ +no matter what it is.\n\ +If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,\n\ +and entirely reject menu bindings.\n\ \n\ If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\ to other keymaps or slots. This makes it possible to search for an\n\ @@ -1604,21 +2055,29 @@ indirect definition itself.") Lisp_Object firstonly, noindirect; { Lisp_Object maps; - Lisp_Object found, sequence; + Lisp_Object found, sequences; + Lisp_Object keymap1; int keymap_specified = !NILP (keymap); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - + /* 1 means ignore all menu bindings entirely. */ + int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii); + + /* Find keymaps accessible from `keymap' or the current + context. But don't muck with the value of `keymap', + because `where_is_internal_1' uses it to check for + shadowed bindings. */ + keymap1 = keymap; if (! keymap_specified) { #ifdef USE_TEXT_PROPERTIES - keymap = get_local_map (PT, current_buffer); + keymap1 = get_local_map (PT, current_buffer); #else - keymap = current_buffer->keymap; + keymap1 = current_buffer->keymap; #endif } - - if (!NILP (keymap)) - maps = nconc2 (Faccessible_keymaps (get_keymap (keymap), Qnil), + + if (!NILP (keymap1)) + maps = nconc2 (Faccessible_keymaps (get_keymap (keymap1), Qnil), Faccessible_keymaps (get_keymap (current_global_map), Qnil)); else @@ -1638,18 +2097,15 @@ indirect definition itself.") } } - GCPRO5 (definition, keymap, maps, found, sequence); + GCPRO5 (definition, keymap, maps, found, sequences); found = Qnil; - sequence = Qnil; + sequences = Qnil; for (; !NILP (maps); maps = Fcdr (maps)) { /* Key sequence to reach map, and the map that it reaches */ register Lisp_Object this, map; - /* If Fcar (map) is a VECTOR, the current element within that vector. */ - int i = 0; - /* In order to fold [META-PREFIX-CHAR CHAR] sequences into [M-CHAR] sequences, check if last character of the sequence is the meta-prefix char. */ @@ -1674,9 +2130,11 @@ indirect definition itself.") For this reason, if Fcar (map) is a vector, we don't advance map to the next element until i indicates that we have finished off the vector. */ - Lisp_Object elt, key, binding; elt = XCONS (map)->car; + map = XCONS (map)->cdr; + + sequences = Qnil; QUIT; @@ -1684,109 +2142,70 @@ indirect definition itself.") advance map and i to the next binding. */ if (VECTORP (elt)) { + Lisp_Object sequence; + int i; /* In a vector, look at each element. */ - binding = XVECTOR (elt)->contents[i]; - XSETFASTINT (key, i); - i++; - - /* If we've just finished scanning a vector, advance map - to the next element, and reset i in anticipation of the - next vector we may find. */ - if (i >= XVECTOR (elt)->size) + for (i = 0; i < XVECTOR (elt)->size; i++) { - map = XCONS (map)->cdr; - i = 0; + binding = XVECTOR (elt)->contents[i]; + XSETFASTINT (key, i); + sequence = where_is_internal_1 (binding, key, definition, + noindirect, keymap, this, + last, nomenus, last_is_meta); + if (!NILP (sequence)) + sequences = Fcons (sequence, sequences); } } - else if (CONSP (elt)) + else if (CHAR_TABLE_P (elt)) { - key = Fcar (Fcar (map)); - binding = Fcdr (Fcar (map)); - - map = XCONS (map)->cdr; + Lisp_Object indices[3]; + Lisp_Object args; + + args = Fcons (Fcons (Fcons (definition, noindirect), + Fcons (keymap, Qnil)), + Fcons (Fcons (this, last), + Fcons (make_number (nomenus), + make_number (last_is_meta)))); + + map_char_table (where_is_internal_2, Qnil, elt, args, + 0, indices); + sequences = XCONS (XCONS (XCONS (args)->car)->cdr)->cdr; } - else - /* We want to ignore keymap elements that are neither - vectors nor conses. */ + else if (CONSP (elt)) { - map = XCONS (map)->cdr; - continue; - } - - /* Search through indirections unless that's not wanted. */ - if (NILP (noindirect)) - binding = get_keyelt (binding, 0); + Lisp_Object sequence; - /* End this iteration if this element does not match - the target. */ + key = XCONS (elt)->car; + binding = XCONS (elt)->cdr; - if (CONSP (definition)) - { - Lisp_Object tem; - tem = Fequal (binding, definition); - if (NILP (tem)) - continue; - } - else - if (!EQ (binding, definition)) - continue; - - /* We have found a match. - Construct the key sequence where we found it. */ - if (INTEGERP (key) && last_is_meta) - { - sequence = Fcopy_sequence (this); - Faset (sequence, last, make_number (XINT (key) | meta_modifier)); + sequence = where_is_internal_1 (binding, key, definition, + noindirect, keymap, this, + last, nomenus, last_is_meta); + if (!NILP (sequence)) + sequences = Fcons (sequence, sequences); } - else - sequence = append_key (this, key); - /* Verify that this key binding is not shadowed by another - binding for the same key, before we say it exists. - Mechanism: look for local definition of this key and if - it is defined and does not match what we found then - ignore this key. - - Either nil or number as value from Flookup_key - means undefined. */ - if (keymap_specified) - { - binding = Flookup_key (keymap, sequence, Qnil); - if (!NILP (binding) && !INTEGERP (binding)) - { - if (CONSP (definition)) - { - Lisp_Object tem; - tem = Fequal (binding, definition); - if (NILP (tem)) - continue; - } - else - if (!EQ (binding, definition)) - continue; - } - } - else + for (; ! NILP (sequences); sequences = XCONS (sequences)->cdr) { - binding = Fkey_binding (sequence, Qnil); - if (!EQ (binding, definition)) - continue; + Lisp_Object sequence; + + sequence = XCONS (sequences)->car; + + /* It is a true unshadowed match. Record it, unless it's already + been seen (as could happen when inheriting keymaps). */ + if (NILP (Fmember (sequence, found))) + found = Fcons (sequence, found); + + /* If firstonly is Qnon_ascii, then we can return the first + binding we find. If firstonly is not Qnon_ascii but not + nil, then we should return the first ascii-only binding + we find. */ + if (EQ (firstonly, Qnon_ascii)) + RETURN_UNGCPRO (sequence); + else if (! NILP (firstonly) && ascii_sequence_p (sequence)) + RETURN_UNGCPRO (sequence); } - - /* It is a true unshadowed match. Record it, unless it's already - been seen (as could happen when inheriting keymaps). */ - if (NILP (Fmember (sequence, found))) - found = Fcons (sequence, found); - - /* If firstonly is Qnon_ascii, then we can return the first - binding we find. If firstonly is not Qnon_ascii but not - nil, then we should return the first ascii-only binding - we find. */ - if (EQ (firstonly, Qnon_ascii)) - RETURN_UNGCPRO (sequence); - else if (! NILP (firstonly) && ascii_sequence_p (sequence)) - RETURN_UNGCPRO (sequence); } } @@ -1802,50 +2221,186 @@ indirect definition itself.") return found; } + +/* This is the function that Fwhere_is_internal calls using map_char_table. + ARGS has the form + (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT)) + . + ((THIS . LAST) . (NOMENUS . LAST_IS_META))) + Since map_char_table doesn't really use the return value from this function, + we the result append to RESULT, the slot in ARGS. */ + +static void +where_is_internal_2 (args, key, binding) + Lisp_Object args, key, binding; +{ + Lisp_Object definition, noindirect, keymap, this, last; + Lisp_Object result, sequence; + int nomenus, last_is_meta; + + result = XCONS (XCONS (XCONS (args)->car)->cdr)->cdr; + definition = XCONS (XCONS (XCONS (args)->car)->car)->car; + noindirect = XCONS (XCONS (XCONS (args)->car)->car)->cdr; + keymap = XCONS (XCONS (XCONS (args)->car)->cdr)->car; + this = XCONS (XCONS (XCONS (args)->cdr)->car)->car; + last = XCONS (XCONS (XCONS (args)->cdr)->car)->cdr; + nomenus = XFASTINT (XCONS (XCONS (XCONS (args)->cdr)->cdr)->car); + last_is_meta = XFASTINT (XCONS (XCONS (XCONS (args)->cdr)->cdr)->cdr); + + sequence = where_is_internal_1 (binding, key, definition, noindirect, keymap, + this, last, nomenus, last_is_meta); + + if (!NILP (sequence)) + XCONS (XCONS (XCONS (args)->car)->cdr)->cdr + = Fcons (sequence, result); +} + +static Lisp_Object +where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last, + nomenus, last_is_meta) + Lisp_Object binding, key, definition, noindirect, keymap, this, last; + int nomenus, last_is_meta; +{ + Lisp_Object sequence; + int keymap_specified = !NILP (keymap); + + /* Search through indirections unless that's not wanted. */ + if (NILP (noindirect)) + { + if (nomenus) + { + while (1) + { + Lisp_Object map, tem; + /* If the contents are (KEYMAP . ELEMENT), go indirect. */ + map = get_keymap_1 (Fcar_safe (definition), 0, 0); + tem = Fkeymapp (map); + if (!NILP (tem)) + definition = access_keymap (map, Fcdr (definition), 0, 0); + else + break; + } + /* If the contents are (menu-item ...) or (STRING ...), reject. */ + if (CONSP (definition) + && (EQ (XCONS (definition)->car,Qmenu_item) + || STRINGP (XCONS (definition)->car))) + return Qnil; + } + else + binding = get_keyelt (binding, 0); + } + + /* End this iteration if this element does not match + the target. */ + + if (CONSP (definition)) + { + Lisp_Object tem; + tem = Fequal (binding, definition); + if (NILP (tem)) + return Qnil; + } + else + if (!EQ (binding, definition)) + return Qnil; + + /* We have found a match. + Construct the key sequence where we found it. */ + if (INTEGERP (key) && last_is_meta) + { + sequence = Fcopy_sequence (this); + Faset (sequence, last, make_number (XINT (key) | meta_modifier)); + } + else + sequence = append_key (this, key); + + /* Verify that this key binding is not shadowed by another + binding for the same key, before we say it exists. + + Mechanism: look for local definition of this key and if + it is defined and does not match what we found then + ignore this key. + + Either nil or number as value from Flookup_key + means undefined. */ + if (keymap_specified) + { + binding = Flookup_key (keymap, sequence, Qnil); + if (!NILP (binding) && !INTEGERP (binding)) + { + if (CONSP (definition)) + { + Lisp_Object tem; + tem = Fequal (binding, definition); + if (NILP (tem)) + return Qnil; + } + else + if (!EQ (binding, definition)) + return Qnil; + } + } + else + { + binding = Fkey_binding (sequence, Qnil); + if (!EQ (binding, definition)) + return Qnil; + } + + return sequence; +} /* describe-bindings - summarizing all the bindings in a set of keymaps. */ -DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 1, "", +DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, Sdescribe_bindings_internal, 0, 2, "", "Show a list of all defined keys, and their definitions.\n\ -The list is put in a buffer, which is displayed.\n\ -An optional argument PREFIX, if non-nil, should be a key sequence;\n\ +We put that list in a buffer, and display the buffer.\n\ +\n\ +The optional argument MENUS, if non-nil, says to mention menu bindings.\n\ +\(Ordinarily these are omitted from the output.)\n\ +The optional argument PREFIX, if non-nil, should be a key sequence;\n\ then we display only bindings that start with that prefix.") - (prefix) - Lisp_Object prefix; + (menus, prefix) + Lisp_Object menus, prefix; { register Lisp_Object thisbuf; XSETBUFFER (thisbuf, current_buffer); internal_with_output_to_temp_buffer ("*Help*", describe_buffer_bindings, - Fcons (thisbuf, prefix)); + list3 (thisbuf, prefix, menus)); return Qnil; } -/* ARG is (BUFFER . PREFIX). */ +/* ARG is (BUFFER PREFIX MENU-FLAG). */ static Lisp_Object describe_buffer_bindings (arg) Lisp_Object arg; { Lisp_Object descbuf, prefix, shadow; + int nomenu; register Lisp_Object start1; struct gcpro gcpro1; char *alternate_heading = "\ -Alternate Characters (use anywhere the nominal character is listed):\n\ -nominal alternate\n\ -------- ---------\n"; +Keyboard translations:\n\n\ +You type Translation\n\ +-------- -----------\n"; descbuf = XCONS (arg)->car; - prefix = XCONS (arg)->cdr; + arg = XCONS (arg)->cdr; + prefix = XCONS (arg)->car; + arg = XCONS (arg)->cdr; + nomenu = NILP (XCONS (arg)->car); + shadow = Qnil; GCPRO1 (shadow); Fset_buffer (Vstandard_output); /* Report on alternates for keys. */ - if (STRINGP (Vkeyboard_translate_table)) + if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix)) { int c; unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data; @@ -1875,6 +2430,10 @@ nominal alternate\n\ insert ("\n", 1); } + if (!NILP (Vkey_translation_map)) + describe_map_tree (Vkey_translation_map, 0, Qnil, prefix, + "Key translations", nomenu, 1, 0); + { int i, nmaps; Lisp_Object *modes, *maps; @@ -1882,7 +2441,9 @@ nominal alternate\n\ /* Temporarily switch to descbuf, so that we can get that buffer's minor modes correctly. */ Fset_buffer (descbuf); - if (!NILP (Voverriding_local_map)) + + if (!NILP (current_kboard->Voverriding_terminal_local_map) + || !NILP (Voverriding_local_map)) nmaps = 0; else nmaps = current_minor_maps (&modes, &maps); @@ -1910,26 +2471,33 @@ nominal alternate\n\ p += sizeof (" Minor Mode Bindings") - 1; *p = 0; - describe_map_tree (maps[i], 0, shadow, prefix, title, 0); + describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0); shadow = Fcons (maps[i], shadow); } } /* Print the (major mode) local map. */ - if (!NILP (Voverriding_local_map)) + if (!NILP (current_kboard->Voverriding_terminal_local_map)) + start1 = current_kboard->Voverriding_terminal_local_map; + else if (!NILP (Voverriding_local_map)) start1 = Voverriding_local_map; else start1 = XBUFFER (descbuf)->keymap; if (!NILP (start1)) { - describe_map_tree (start1, 0, shadow, prefix, - "Major Mode Bindings", 0); + describe_map_tree (start1, 1, shadow, prefix, + "Major Mode Bindings", nomenu, 0, 0); shadow = Fcons (start1, shadow); } - describe_map_tree (current_global_map, 0, shadow, prefix, - "Global Bindings", 0); + describe_map_tree (current_global_map, 1, shadow, prefix, + "Global Bindings", nomenu, 0, 1); + + /* Print the function-key-map translations under this prefix. */ + if (!NILP (Vfunction_key_map)) + describe_map_tree (Vfunction_key_map, 0, Qnil, prefix, + "Function key map translations", nomenu, 1, 0); call0 (intern ("help-mode")); Fset_buffer (descbuf); @@ -1937,7 +2505,7 @@ nominal alternate\n\ return Qnil; } -/* Insert a desription of the key bindings in STARTMAP, +/* Insert a description of the key bindings in STARTMAP, followed by those of all maps reachable through STARTMAP. If PARTIAL is nonzero, omit certain "uninteresting" commands (such as `undefined'). @@ -1946,16 +2514,25 @@ nominal alternate\n\ PREFIX, if non-nil, says mention only keys that start with PREFIX. TITLE, if not 0, is a string to insert at the beginning. TITLE should not end with a colon or a newline; we supply that. - If NOMENU is not 0, then omit menu-bar commands. */ + If NOMENU is not 0, then omit menu-bar commands. + + If TRANSL is nonzero, the definitions are actually key translations + so print strings and vectors differently. + + If ALWAYS_TITLE is nonzero, print the title even if there are no maps + to look through. */ void -describe_map_tree (startmap, partial, shadow, prefix, title, nomenu) +describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl, + always_title) Lisp_Object startmap, shadow, prefix; int partial; char *title; int nomenu; + int transl; + int always_title; { - Lisp_Object maps, seen, sub_shadows; + Lisp_Object maps, orig_maps, seen, sub_shadows; struct gcpro gcpro1, gcpro2, gcpro3; int something = 0; char *key_heading @@ -1963,7 +2540,7 @@ describe_map_tree (startmap, partial, shadow, prefix, title, nomenu) key binding\n\ --- -------\n"; - maps = Faccessible_keymaps (startmap, prefix); + orig_maps = maps = Faccessible_keymaps (startmap, prefix); seen = Qnil; sub_shadows = Qnil; GCPRO3 (maps, seen, sub_shadows); @@ -1988,7 +2565,7 @@ key binding\n\ } } - if (!NILP (maps)) + if (!NILP (maps) || always_title) { if (title) { @@ -2044,8 +2621,18 @@ key binding\n\ sub_shadows = Fcons (shmap, sub_shadows); } - describe_map (Fcdr (elt), Fcar (elt), describe_command, - partial, sub_shadows, &seen); + /* Maps we have already listed in this loop shadow this map. */ + for (tail = orig_maps; ! EQ (tail, maps); tail = XCDR (tail)) + { + Lisp_Object tem; + tem = Fequal (Fcar (XCAR (tail)), prefix); + if (! NILP (tem)) + sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows); + } + + describe_map (Fcdr (elt), prefix, + transl ? describe_translation : describe_command, + partial, sub_shadows, &seen, nomenu); skip: ; } @@ -2056,13 +2643,30 @@ key binding\n\ UNGCPRO; } +static int previous_description_column; + static void describe_command (definition) Lisp_Object definition; { register Lisp_Object tem1; + int column = current_column (); + int description_column; - Findent_to (make_number (16), make_number (1)); + /* If column 16 is no good, go to col 32; + but don't push beyond that--go to next line instead. */ + if (column > 30) + { + insert_char ('\n'); + description_column = 32; + } + else if (column > 14 || (column > 10 && previous_description_column == 32)) + description_column = 32; + else + description_column = 16; + + Findent_to (make_number (description_column), make_number (1)); + previous_description_column = description_column; if (SYMBOLP (definition)) { @@ -2070,7 +2674,7 @@ describe_command (definition) insert1 (tem1); insert_string ("\n"); } - else if (STRINGP (definition)) + else if (STRINGP (definition) || VECTORP (definition)) insert_string ("Keyboard Macro\n"); else { @@ -2082,6 +2686,35 @@ describe_command (definition) } } +static void +describe_translation (definition) + Lisp_Object definition; +{ + register Lisp_Object tem1; + + Findent_to (make_number (16), make_number (1)); + + if (SYMBOLP (definition)) + { + XSETSTRING (tem1, XSYMBOL (definition)->name); + insert1 (tem1); + insert_string ("\n"); + } + else if (STRINGP (definition) || VECTORP (definition)) + { + insert1 (Fkey_description (definition)); + insert_string ("\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. */ @@ -2102,16 +2735,17 @@ shadow_lookup (shadow, key, flag) /* Describe the contents of map MAP, assuming that this map itself is reached by the sequence of prefix keys KEYS (a string or vector). - PARTIAL, SHADOW are as in `describe_map_tree' above. */ + PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */ static void -describe_map (map, keys, elt_describer, partial, shadow, seen) +describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) register Lisp_Object map; Lisp_Object keys; - int (*elt_describer) (); + void (*elt_describer) P_ ((Lisp_Object)); int partial; Lisp_Object shadow; Lisp_Object *seen; + int nomenu; { Lisp_Object elt_prefix; Lisp_Object tail, definition, event; @@ -2145,9 +2779,11 @@ describe_map (map, keys, elt_describer, partial, shadow, seen) { QUIT; - if (VECTORP (XCONS (tail)->car)) + if (VECTORP (XCONS (tail)->car) + || CHAR_TABLE_P (XCONS (tail)->car)) describe_vector (XCONS (tail)->car, - elt_prefix, elt_describer, partial, shadow); + elt_prefix, elt_describer, partial, shadow, map, + (int *)0, 0); else if (CONSP (XCONS (tail)->car)) { event = XCONS (XCONS (tail)->car)->car; @@ -2157,6 +2793,9 @@ describe_map (map, keys, elt_describer, partial, shadow, seen) if (! (SYMBOLP (event) || INTEGERP (event))) continue; + if (nomenu && EQ (event, Qmenu_bar)) + continue; + definition = get_keyelt (XCONS (XCONS (tail)->car)->cdr, 0); /* Don't show undefined commands or suppressed commands. */ @@ -2183,6 +2822,7 @@ describe_map (map, keys, elt_describer, partial, shadow, seen) if (first) { + previous_description_column = 0; insert ("\n", 1); first = 0; } @@ -2213,7 +2853,7 @@ describe_map (map, keys, elt_describer, partial, shadow, seen) UNGCPRO; } -static int +static void describe_vector_princ (elt) Lisp_Object elt; { @@ -2231,106 +2871,340 @@ This is text showing the elements of vector matched against indices.") int count = specpdl_ptr - specpdl; specbind (Qstandard_output, Fcurrent_buffer ()); - CHECK_VECTOR (vector, 0); - describe_vector (vector, Qnil, describe_vector_princ, 0, Qnil); + CHECK_VECTOR_OR_CHAR_TABLE (vector, 0); + describe_vector (vector, Qnil, describe_vector_princ, 0, + Qnil, Qnil, (int *)0, 0); return unbind_to (count, Qnil); } -describe_vector (vector, elt_prefix, elt_describer, partial, shadow) +/* Insert in the current buffer a description of the contents of VECTOR. + We call ELT_DESCRIBER to insert the description of one value found + in VECTOR. + + ELT_PREFIX describes what "comes before" the keys or indices defined + by this vector. This is a human-readable string whose size + is not necessarily related to the situation. + + If the vector is in a keymap, ELT_PREFIX is a prefix key which + leads to this keymap. + + If the vector is a chartable, ELT_PREFIX is the vector + of bytes that lead to the character set or portion of a character + set described by this chartable. + + If PARTIAL is nonzero, it means do not mention suppressed commands + (that assumes the vector is in a keymap). + + SHADOW is a list of keymaps that shadow this map. + If it is non-nil, then we look up the key in those maps + and we don't mention it now if it is defined by any of them. + + ENTIRE_MAP is the keymap in which this vector appears. + If the definition in effect in the whole map does not match + the one in this vector, we ignore this one. + + When describing a sub-char-table, INDICES is a list of + indices at higher levels in this char-table, + and CHAR_TABLE_DEPTH says how many levels down we have gone. */ + +void +describe_vector (vector, elt_prefix, elt_describer, + partial, shadow, entire_map, + indices, char_table_depth) register Lisp_Object vector; Lisp_Object elt_prefix; - int (*elt_describer) (); + void (*elt_describer) P_ ((Lisp_Object)); int partial; Lisp_Object shadow; + Lisp_Object entire_map; + int *indices; + int char_table_depth; { - Lisp_Object this; - Lisp_Object dummy; - Lisp_Object tem1, tem2; + Lisp_Object definition; + Lisp_Object tem2; register int i; Lisp_Object suppress; Lisp_Object kludge; int first = 1; - struct gcpro gcpro1, gcpro2, gcpro3; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + /* Range of elements to be handled. */ + int from, to; + /* A flag to tell if a leaf in this level of char-table is not a + generic character (i.e. a complete multibyte character). */ + int complete_char; + int character; + int starting_i; + + if (indices == 0) + indices = (int *) alloca (3 * sizeof (int)); - tem1 = Qnil; + definition = Qnil; /* This vector gets used to present single keys to Flookup_key. Since that is done once per vector element, we don't want to cons up a fresh vector every time. */ kludge = Fmake_vector (make_number (1), Qnil); - GCPRO3 (elt_prefix, tem1, kludge); + GCPRO3 (elt_prefix, definition, kludge); if (partial) suppress = intern ("suppress-keymap"); - for (i = 0; i < XVECTOR (vector)->size; i++) + if (CHAR_TABLE_P (vector)) + { + if (char_table_depth == 0) + { + /* VECTOR is a top level char-table. */ + complete_char = 1; + from = 0; + to = CHAR_TABLE_ORDINARY_SLOTS; + } + else + { + /* VECTOR is a sub char-table. */ + if (char_table_depth >= 3) + /* A char-table is never that deep. */ + error ("Too deep char table"); + + complete_char + = (CHARSET_VALID_P (indices[0]) + && ((CHARSET_DIMENSION (indices[0]) == 1 + && char_table_depth == 1) + || char_table_depth == 2)); + + /* Meaningful elements are from 32th to 127th. */ + from = 32; + to = SUB_CHAR_TABLE_ORDINARY_SLOTS; + } + } + else + { + /* This does the right thing for ordinary vectors. */ + + complete_char = 1; + from = 0; + to = XVECTOR (vector)->size; + } + + for (i = from; i < to; i++) { QUIT; - tem1 = get_keyelt (XVECTOR (vector)->contents[i], 0); - if (NILP (tem1)) continue; + if (CHAR_TABLE_P (vector)) + { + if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS) + complete_char = 0; + + if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS + && !CHARSET_DEFINED_P (i - 128)) + continue; + + definition + = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0); + } + else + definition = get_keyelt (XVECTOR (vector)->contents[i], 0); + + if (NILP (definition)) continue; /* Don't mention suppressed commands. */ - if (SYMBOLP (tem1) && partial) + if (SYMBOLP (definition) && partial) { - this = Fget (tem1, suppress); - if (!NILP (this)) - continue; + Lisp_Object tem; + + tem = Fget (definition, suppress); + + if (!NILP (tem)) continue; + } + + /* Set CHARACTER to the character this entry describes, if any. + Also update *INDICES. */ + if (CHAR_TABLE_P (vector)) + { + indices[char_table_depth] = i; + + if (char_table_depth == 0) + { + character = i; + indices[0] = i - 128; + } + else if (complete_char) + { + character + = MAKE_NON_ASCII_CHAR (indices[0], indices[1], indices[2]); + } + else + character = 0; } + else + character = i; - /* If this command in this map is shadowed by some other map, - ignore it. */ - if (!NILP (shadow)) + /* If this binding is shadowed by some other map, ignore it. */ + if (!NILP (shadow) && complete_char) { Lisp_Object tem; - XVECTOR (kludge)->contents[0] = make_number (i); + XVECTOR (kludge)->contents[0] = make_number (character); tem = shadow_lookup (shadow, kludge, Qt); if (!NILP (tem)) continue; } + /* Ignore this definition if it is shadowed by an earlier + one in the same keymap. */ + if (!NILP (entire_map) && complete_char) + { + Lisp_Object tem; + + XVECTOR (kludge)->contents[0] = make_number (character); + tem = Flookup_key (entire_map, kludge, Qt); + + if (! EQ (tem, definition)) + continue; + } + if (first) { - insert ("\n", 1); + if (char_table_depth == 0) + insert ("\n", 1); first = 0; } + /* For a sub char-table, show the depth by indentation. + CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */ + if (char_table_depth > 0) + insert (" ", char_table_depth * 2); /* depth is 1 or 2. */ + /* Output the prefix that applies to every entry in this map. */ if (!NILP (elt_prefix)) insert1 (elt_prefix); - /* Get the string to describe the character I, and print it. */ - XSETFASTINT (dummy, i); + /* Insert or describe the character this slot is for, + or a description of what it is for. */ + if (SUB_CHAR_TABLE_P (vector)) + { + if (complete_char) + insert_char (character); + else + { + /* We need an octal representation for this block of + characters. */ + char work[16]; + sprintf (work, "(row %d)", i); + insert (work, strlen (work)); + } + } + else if (CHAR_TABLE_P (vector)) + { + if (complete_char) + insert1 (Fsingle_key_description (make_number (character))); + else + { + /* Print the information for this character set. */ + insert_string ("<"); + tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX); + if (STRINGP (tem2)) + insert_from_string (tem2, 0, 0, XSTRING (tem2)->size, + STRING_BYTES (XSTRING (tem2)), 0); + else + insert ("?", 1); + insert (">", 1); + } + } + else + { + insert1 (Fsingle_key_description (make_number (character))); + } - /* THIS gets the string to describe the character DUMMY. */ - this = Fsingle_key_description (dummy); - insert1 (this); + /* If we find a sub char-table within a char-table, + scan it recursively; it defines the details for + a character set or a portion of a character set. */ + if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition)) + { + insert ("\n", 1); + describe_vector (definition, elt_prefix, elt_describer, + partial, shadow, entire_map, + indices, char_table_depth + 1); + continue; + } - /* Find all consecutive characters that have the same definition. */ - while (i + 1 < XVECTOR (vector)->size - && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1], 0), - EQ (tem2, tem1))) - i++; + starting_i = i; + + /* Find all consecutive characters or rows that have the same + definition. But, for elements of a top level char table, if + they are for charsets, we had better describe one by one even + if they have the same definition. */ + if (CHAR_TABLE_P (vector)) + { + int limit = to; + + if (char_table_depth == 0) + limit = CHAR_TABLE_SINGLE_BYTE_SLOTS; + + while (i + 1 < limit + && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0), + !NILP (tem2)) + && !NILP (Fequal (tem2, definition))) + i++; + } + else + while (i + 1 < to + && (tem2 = get_keyelt (XVECTOR (vector)->contents[i + 1], 0), + !NILP (tem2)) + && !NILP (Fequal (tem2, definition))) + i++; + /* If we have a range of more than one character, print where the range reaches to. */ - if (i != XINT (dummy)) + if (i != starting_i) { insert (" .. ", 4); + if (!NILP (elt_prefix)) insert1 (elt_prefix); - XSETFASTINT (dummy, i); - insert1 (Fsingle_key_description (dummy)); + if (CHAR_TABLE_P (vector)) + { + if (char_table_depth == 0) + { + insert1 (Fsingle_key_description (make_number (i))); + } + else if (complete_char) + { + indices[char_table_depth] = i; + character + = MAKE_NON_ASCII_CHAR (indices[0], indices[1], indices[2]); + insert_char (character); + } + else + { + /* We need an octal representation for this block of + characters. */ + char work[16]; + sprintf (work, "(row %d)", i); + insert (work, strlen (work)); + } + } + else + { + insert1 (Fsingle_key_description (make_number (i))); + } } /* Print a description of the definition of this character. elt_describer will take care of spacing out far enough for alignment purposes. */ - (*elt_describer) (tem1); + (*elt_describer) (definition); + } + + /* For (sub) char-table, print `defalt' slot at last. */ + if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt)) + { + insert (" ", char_table_depth * 2); + insert_string ("<>"); + (*elt_describer) (XCHAR_TABLE (vector)->defalt); } UNGCPRO; @@ -2355,23 +3229,24 @@ 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 PRED is non-nil, (funcall PRED SYM) is done\n\ +If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\ for each symbol and a symbol is mentioned only if that returns non-nil.\n\ Return list of symbols found.") - (string, pred) - Lisp_Object string, pred; + (regexp, predicate) + Lisp_Object regexp, predicate; { struct gcpro gcpro1, gcpro2; - CHECK_STRING (string, 0); - apropos_predicate = pred; + CHECK_STRING (regexp, 0); + apropos_predicate = predicate; GCPRO2 (apropos_predicate, apropos_accumulate); apropos_accumulate = Qnil; - map_obarray (Vobarray, apropos_accum, string); + map_obarray (Vobarray, apropos_accum, regexp); apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp); UNGCPRO; return apropos_accumulate; } +void syms_of_keymap () { Lisp_Object tem; @@ -2379,14 +3254,21 @@ syms_of_keymap () Qkeymap = intern ("keymap"); staticpro (&Qkeymap); -/* Initialize the keymaps standardly used. - Each one is the value of a Lisp variable, and is also - pointed to by a C variable */ + /* Now we are ready to set up this property, so we can + create char tables. */ + Fput (Qkeymap, Qchar_table_extra_slots, make_number (0)); - global_map = Fcons (Qkeymap, - Fcons (Fmake_vector (make_number (0400), Qnil), Qnil)); + /* Initialize the keymaps standardly used. + Each one is the value of a Lisp variable, and is also + pointed to by a C variable */ + + global_map = Fmake_keymap (Qnil); Fset (intern ("global-map"), global_map); + current_global_map = global_map; + staticpro (&global_map); + staticpro (¤t_global_map); + meta_map = Fmake_keymap (Qnil); Fset (intern ("esc-map"), meta_map); Ffset (intern ("ESC-prefix"), meta_map); @@ -2395,6 +3277,12 @@ syms_of_keymap () Fset (intern ("ctl-x-map"), control_x_map); Ffset (intern ("Control-X-prefix"), control_x_map); + DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands, + "List of commands given new key bindings recently.\n\ +This is used for internal purposes during Emacs startup;\n\ +don't alter it yourself."); + Vdefine_key_rebound_commands = Qt; + DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map, "Default keymap to use when reading from the minibuffer."); Vminibuffer_local_map = Fmake_sparse_keymap (Qnil); @@ -2411,8 +3299,6 @@ syms_of_keymap () "Local keymap for minibuffer input with completion, for exact match."); Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil); - current_global_map = global_map; - DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist, "Alist of keymaps to use for minor modes.\n\ Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\ @@ -2421,6 +3307,13 @@ If two active keymaps bind the same key, the keymap appearing earlier\n\ in the list takes precedence."); Vminor_mode_map_alist = Qnil; + DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist, + "Alist of keymaps to use for minor modes, in current major mode.\n\ +This variable is a alist just like `minor-mode-map-alist', and it is\n\ +used the same way (and before `minor-mode-map-alist'); however,\n\ +it is provided for major modes to bind locally."); + Vminor_mode_overriding_map_alist = Qnil; + DEFVAR_LISP ("function-key-map", &Vfunction_key_map, "Keymap mapping ASCII function key sequences onto their preferred forms.\n\ This allows Emacs to recognize function keys sent from ASCII\n\ @@ -2442,6 +3335,12 @@ Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\ key, typing `ESC O P x' would return [f1 x]."); Vfunction_key_map = Fmake_sparse_keymap (Qnil); + DEFVAR_LISP ("key-translation-map", &Vkey_translation_map, + "Keymap of key translations that can override keymaps.\n\ +This keymap works like `function-key-map', but comes after that,\n\ +and applies even for keys that have ordinary bindings."); + Vkey_translation_map = Qnil; + Qsingle_key_description = intern ("single-key-description"); staticpro (&Qsingle_key_description); @@ -2454,7 +3353,12 @@ key, typing `ESC O P x' would return [f1 x]."); Qnon_ascii = intern ("non-ascii"); staticpro (&Qnon_ascii); + Qmenu_item = intern ("menu-item"); + staticpro (&Qmenu_item); + defsubr (&Skeymapp); + defsubr (&Skeymap_parent); + defsubr (&Sset_keymap_parent); defsubr (&Smake_keymap); defsubr (&Smake_sparse_keymap); defsubr (&Scopy_keymap); @@ -2462,12 +3366,8 @@ key, typing `ESC O P x' would return [f1 x]."); defsubr (&Slocal_key_binding); defsubr (&Sglobal_key_binding); defsubr (&Sminor_mode_key_binding); - defsubr (&Sglobal_set_key); - defsubr (&Slocal_set_key); defsubr (&Sdefine_key); defsubr (&Slookup_key); - defsubr (&Sglobal_unset_key); - defsubr (&Slocal_unset_key); defsubr (&Sdefine_prefix_command); defsubr (&Suse_global_map); defsubr (&Suse_local_map); @@ -2480,10 +3380,11 @@ key, typing `ESC O P x' would return [f1 x]."); defsubr (&Ssingle_key_description); defsubr (&Stext_char_description); defsubr (&Swhere_is_internal); - defsubr (&Sdescribe_bindings); + defsubr (&Sdescribe_bindings_internal); defsubr (&Sapropos_internal); } +void keys_of_keymap () { Lisp_Object tem;