X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/d1d070e3c5595ae6aab66287651f60ea102039d0..d3ee989e859e0a610527c18113edc1c51d77a429:/src/keymap.c?ds=sidebyside diff --git a/src/keymap.c b/src/keymap.c index 362f022b10..ecc2f7b294 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1,6 +1,7 @@ /* Manipulation of keymaps - Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 2001 - Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, + 1998, 1999, 2000, 2001, 2002, 2003, 2004, + 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -16,8 +17,8 @@ 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, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ #include @@ -64,6 +65,13 @@ Lisp_Object Vminibuffer_local_ns_map; /* was MinibufLocalCompletionMap */ Lisp_Object Vminibuffer_local_completion_map; +/* keymap used for minibuffers when doing completion in filenames */ +Lisp_Object Vminibuffer_local_filename_completion_map; + +/* keymap used for minibuffers when doing completion in filenames + with require-match*/ +Lisp_Object Vminibuffer_local_must_match_filename_map; + /* keymap used for minibuffers when doing completion and require a match */ /* was MinibufLocalMustMatchMap */ Lisp_Object Vminibuffer_local_must_match_map; @@ -75,6 +83,9 @@ Lisp_Object Vminor_mode_map_alist; minor mode variables and keymaps. */ Lisp_Object Vminor_mode_overriding_map_alist; +/* List of emulation mode keymap alists. */ +Lisp_Object Vemulation_mode_map_alists; + /* Keymap mapping ASCII function key sequences onto their preferred forms. Initialized by the terminal-specific lisp files. See DEFVAR for more documentation. */ @@ -89,11 +100,14 @@ Lisp_Object Vkey_translation_map; 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; +Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item, Qremap; /* Alist of elements like (DEL . "\d"). */ static Lisp_Object exclude_keys; +/* Pre-allocated 2-element vector for Fcommand_remapping to use. */ +static Lisp_Object command_remapping_vector; + /* A char with the CHAR_META bit set in a vector or the 0200 bit set in a string key sequence is equivalent to prefixing with this character. */ @@ -114,17 +128,22 @@ 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)); + int, Lisp_Object, Lisp_Object*, int, int)); +static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object, + void (*) (Lisp_Object, Lisp_Object), int, + Lisp_Object, Lisp_Object, int *, + int, int, int)); static void silly_event_symbol_error P_ ((Lisp_Object)); /* Keymap object support - constructors and predicates. */ DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0, 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". +CHARTABLE is a char-table that holds the bindings for all characters +without modifiers. All entries in it are initially nil, meaning +"command undefined". ALIST is an assoc-list which holds bindings for +function keys, mouse events, and any other things that appear in the +input stream. Initially, 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'. */) @@ -203,13 +222,13 @@ when reading a key-sequence to be looked-up in this keymap. */) (map) Lisp_Object map; { + map = get_keymap (map, 0, 0); while (CONSP (map)) { - register Lisp_Object tem; - tem = Fcar (map); + Lisp_Object tem = XCAR (map); if (STRINGP (tem)) return tem; - map = Fcdr (map); + map = XCDR (map); } return Qnil; } @@ -257,7 +276,8 @@ get_keymap (object, error, autoload) /* Should we do an autoload? Autoload forms for keymaps have Qkeymap as their fifth element. */ - if ((autoload || !error) && EQ (XCAR (tem), Qautoload)) + if ((autoload || !error) && EQ (XCAR (tem), Qautoload) + && SYMBOLP (object)) { Lisp_Object tail; @@ -267,11 +287,11 @@ get_keymap (object, error, autoload) if (autoload) { struct gcpro gcpro1, gcpro2; - + GCPRO2 (tem, object); do_autoload (tem, object); UNGCPRO; - + goto autoload_retry; } else @@ -286,17 +306,17 @@ get_keymap (object, error, autoload) return Qnil; } -/* Return the parent map of the keymap MAP, or nil if it has none. - We assume that MAP is a valid keymap. */ +/* Return the parent map of KEYMAP, or nil if it has none. + We assume that KEYMAP is a valid keymap. */ -DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0, - doc: /* Return the parent keymap of KEYMAP. */) - (keymap) +Lisp_Object +keymap_parent (keymap, autoload) Lisp_Object keymap; + int autoload; { Lisp_Object list; - keymap = get_keymap (keymap, 1, 1); + keymap = get_keymap (keymap, 1, autoload); /* Skip past the initial element `keymap'. */ list = XCDR (keymap); @@ -307,9 +327,16 @@ DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0, return list; } - return get_keymap (list, 0, 1); + return get_keymap (list, 0, autoload); } +DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0, + doc: /* Return the parent keymap of KEYMAP. */) + (keymap) + Lisp_Object keymap; +{ + return keymap_parent (keymap, 1); +} /* Check whether MAP is one of MAPS parents. */ int @@ -318,7 +345,7 @@ keymap_memberp (map, maps) { if (NILP (map)) return 0; while (KEYMAPP (maps) && !EQ (map, maps)) - maps = Fkeymap_parent (maps); + maps = keymap_parent (maps, 0); return (EQ (map, maps)); } @@ -326,12 +353,12 @@ keymap_memberp (map, maps) DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0, doc: /* Modify KEYMAP to set its parent map to PARENT. -PARENT should be nil or another keymap. */) +Return PARENT. PARENT should be nil or another keymap. */) (keymap, parent) Lisp_Object keymap, parent; { Lisp_Object list, prev; - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2; int i; /* Force a keymap flush for the next call to where-is. @@ -343,9 +370,9 @@ PARENT should be nil or another keymap. */) This is a very minor correctness (rather than safety) issue. */ where_is_cache_keymaps = Qt; + GCPRO2 (keymap, parent); keymap = get_keymap (keymap, 1, 1); - GCPRO1 (keymap); - + if (!NILP (parent)) { parent = get_keymap (parent, 1, 1); @@ -369,6 +396,7 @@ PARENT should be nil or another keymap. */) if (EQ (XCDR (prev), parent)) RETURN_UNGCPRO (parent); + CHECK_IMPURE (prev); XSETCDR (prev, parent); break; } @@ -399,7 +427,8 @@ PARENT should be nil or another keymap. */) { Lisp_Object indices[3]; - map_char_table (fix_submap_inheritance, Qnil, XCAR (list), + map_char_table (fix_submap_inheritance, Qnil, + XCAR (list), XCAR (list), keymap, 0, indices); } } @@ -426,7 +455,7 @@ fix_submap_inheritance (map, event, submap) if (!CONSP (submap)) return; - map_parent = Fkeymap_parent (map); + map_parent = keymap_parent (map, 0); if (!NILP (map_parent)) parent_entry = get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0); @@ -446,7 +475,7 @@ fix_submap_inheritance (map, event, submap) { Lisp_Object tem; - tem = Fkeymap_parent (submap_parent); + tem = keymap_parent (submap_parent, 0); if (KEYMAPP (tem)) { @@ -464,11 +493,11 @@ fix_submap_inheritance (map, event, submap) /* Look up IDX in MAP. IDX may be any sort of event. Note that this does only one level of lookup; IDX must be a single - event, not a sequence. + event, not a sequence. If T_OK is non-zero, bindings for Qt are treated as default bindings; any key left unmentioned by other tables and bindings is - given the binding of Qt. + given the binding of Qt. If T_OK is zero, bindings for Qt are not treated specially. @@ -506,10 +535,17 @@ access_keymap (map, idx, t_ok, noinherit, autoload) { /* 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); + struct gcpro gcpro1; + Lisp_Object meta_map; + GCPRO1 (map); + /* A strange value in which Meta is set would cause + infinite recursion. Protect against that. */ + if (XINT (meta_prefix_char) & CHAR_META) + meta_prefix_char = make_number (27); + meta_map = get_keymap (access_keymap (map, meta_prefix_char, + t_ok, noinherit, autoload), + 0, autoload); + UNGCPRO; if (CONSP (meta_map)) { map = meta_map; @@ -523,15 +559,15 @@ access_keymap (map, idx, t_ok, noinherit, autoload) return Qnil; } + /* 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 tail; + Lisp_Object t_binding = Qnil; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - /* 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; + GCPRO4 (map, tail, idx, t_binding); /* If `t_ok' is 2, both `t' and generic-char bindings are accepted. If it is 1, only generic-char bindings are accepted. @@ -551,12 +587,12 @@ access_keymap (map, idx, t_ok, noinherit, autoload) /* If NOINHERIT, stop finding prefix definitions after we pass a second occurrence of the `keymap' symbol. */ if (noinherit && EQ (binding, Qkeymap)) - return Qnil; + RETURN_UNGCPRO (Qnil); } else if (CONSP (binding)) { Lisp_Object key = XCAR (binding); - + if (EQ (key, idx)) val = XCDR (binding); else if (t_ok @@ -615,15 +651,121 @@ access_keymap (map, idx, t_ok, noinherit, autoload) val = get_keyelt (val, autoload); if (KEYMAPP (val)) fix_submap_inheritance (map, idx, val); - return val; + RETURN_UNGCPRO (val); } QUIT; } - + UNGCPRO; return get_keyelt (t_binding, autoload); } } +static void +map_keymap_item (fun, args, key, val, data) + map_keymap_function_t fun; + Lisp_Object args, key, val; + void *data; +{ + /* We should maybe try to detect bindings shadowed by previous + ones and things like that. */ + if (EQ (val, Qt)) + val = Qnil; + (*fun) (key, val, args, data); +} + +static void +map_keymap_char_table_item (args, key, val) + Lisp_Object args, key, val; +{ + if (!NILP (val)) + { + map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer; + args = XCDR (args); + map_keymap_item (fun, XCDR (args), key, val, + XSAVE_VALUE (XCAR (args))->pointer); + } +} + +/* Call FUN for every binding in MAP. + FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA). + AUTOLOAD if non-zero means that we can autoload keymaps if necessary. */ +void +map_keymap (map, fun, args, data, autoload) + map_keymap_function_t fun; + Lisp_Object map, args; + void *data; + int autoload; +{ + struct gcpro gcpro1, gcpro2, gcpro3; + Lisp_Object tail; + + tail = Qnil; + GCPRO3 (map, args, tail); + map = get_keymap (map, 1, autoload); + for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map; + CONSP (tail) || (tail = get_keymap (tail, 0, autoload), CONSP (tail)); + tail = XCDR (tail)) + { + Lisp_Object binding = XCAR (tail); + + if (CONSP (binding)) + map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data); + else if (VECTORP (binding)) + { + /* Loop over the char values represented in the vector. */ + int len = ASIZE (binding); + int c; + for (c = 0; c < len; c++) + { + Lisp_Object character; + XSETFASTINT (character, c); + map_keymap_item (fun, args, character, AREF (binding, c), data); + } + } + else if (CHAR_TABLE_P (binding)) + { + Lisp_Object indices[3]; + map_char_table (map_keymap_char_table_item, Qnil, binding, binding, + Fcons (make_save_value (fun, 0), + Fcons (make_save_value (data, 0), + args)), + 0, indices); + } + } + UNGCPRO; +} + +static void +map_keymap_call (key, val, fun, dummy) + Lisp_Object key, val, fun; + void *dummy; +{ + call2 (fun, key, val); +} + +DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0, + doc: /* Call FUNCTION once for each event binding in KEYMAP. +FUNCTION is called with two arguments: the event that is bound, and +the definition it is bound to. + +If KEYMAP has a parent, the parent's bindings are included as well. +This works recursively: if the parent has itself a parent, then the +grandparent's bindings are also included and so on. +usage: (map-keymap FUNCTION KEYMAP) */) + (function, keymap, sort_first) + Lisp_Object function, keymap, sort_first; +{ + if (INTEGERP (function)) + /* We have to stop integers early since map_keymap gives them special + significance. */ + Fsignal (Qinvalid_function, Fcons (function, Qnil)); + if (! NILP (sort_first)) + return call3 (intern ("map-keymap-internal"), function, keymap, Qt); + + map_keymap (keymap, map_keymap_call, function, NULL, 1); + return Qnil; +} + /* Given OBJECT which was found in a slot in a keymap, trace indirect definitions to get the actual definition of that slot. An indirect definition is a list of the form @@ -634,11 +776,13 @@ access_keymap (map, idx, t_ok, noinherit, autoload) remove that. Also remove a menu help string as second element. If AUTOLOAD is nonzero, load autoloadable keymaps - that are referred to with indirection. */ + that are referred to with indirection. + + This can GC because menu_item_eval_property calls Feval. */ Lisp_Object get_keyelt (object, autoload) - register Lisp_Object object; + Lisp_Object object; int autoload; { while (1) @@ -680,7 +824,7 @@ get_keyelt (object, autoload) } } else - /* Invalid keymap */ + /* Invalid keymap. */ return object; } @@ -707,8 +851,11 @@ get_keyelt (object, autoload) /* If the contents are (KEYMAP . ELEMENT), go indirect. */ else { + struct gcpro gcpro1; Lisp_Object map; + GCPRO1 (object); map = get_keymap (Fcar_safe (object), 0, autoload); + UNGCPRO; return (!CONSP (map) ? object /* Invalid keymap */ : access_keymap (map, Fcdr (object), 0, 0, autoload)); } @@ -719,7 +866,7 @@ static Lisp_Object store_in_keymap (keymap, idx, def) Lisp_Object keymap; register Lisp_Object idx; - register Lisp_Object def; + Lisp_Object def; { /* Flush any reverse-map cache. */ where_is_cache = Qnil; @@ -770,6 +917,7 @@ store_in_keymap (keymap, idx, def) { if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt)) { + CHECK_IMPURE (elt); ASET (elt, XFASTINT (idx), def); return def; } @@ -795,6 +943,7 @@ store_in_keymap (keymap, idx, def) { if (EQ (idx, XCAR (elt))) { + CHECK_IMPURE (elt); XSETCDR (elt, def); return def; } @@ -812,21 +961,95 @@ 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. */ + CHECK_IMPURE (insertion_point); XSETCDR (insertion_point, Fcons (Fcons (idx, def), XCDR (insertion_point))); } - + return def; } EXFUN (Fcopy_keymap, 1); -void +Lisp_Object +copy_keymap_item (elt) + Lisp_Object elt; +{ + Lisp_Object res, tem; + + if (!CONSP (elt)) + return elt; + + res = tem = elt; + + /* Is this a new format menu item. */ + if (EQ (XCAR (tem), Qmenu_item)) + { + /* Copy cell with menu-item marker. */ + res = elt = Fcons (XCAR (tem), XCDR (tem)); + tem = XCDR (elt); + if (CONSP (tem)) + { + /* Copy cell with menu-item name. */ + 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. */ + 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. */ + XSETCDR (elt, XCDR (tem)); + } + } + else + { + /* It may be an old fomat menu item. + Skip the optional menu string. */ + if (STRINGP (XCAR (tem))) + { + /* Copy the cell, since copy-alist didn't go this deep. */ + res = elt = Fcons (XCAR (tem), XCDR (tem)); + tem = XCDR (elt); + /* Also skip the optional menu help string. */ + if (CONSP (tem) && STRINGP (XCAR (tem))) + { + 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 (XCAR (tem)) + && (NILP (XCAR (XCAR (tem))) + || VECTORP (XCAR (XCAR (tem))))) + { + XSETCDR (elt, XCDR (tem)); + tem = XCDR (tem); + } + if (CONSP (tem) && EQ (XCAR (tem), Qkeymap)) + XSETCDR (elt, Fcopy_keymap (tem)); + } + else if (EQ (XCAR (tem), Qkeymap)) + res = Fcopy_keymap (elt); + } + return res; +} + +static void copy_keymap_1 (chartable, idx, elt) Lisp_Object chartable, idx, elt; { - if (CONSP (elt) && EQ (XCAR (elt), Qkeymap)) - Faset (chartable, idx, Fcopy_keymap (elt)); + Faset (chartable, idx, copy_keymap_item (elt)); } DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0, @@ -839,112 +1062,34 @@ 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; + keymap = get_keymap (keymap, 1, 0); + copy = tail = Fcons (Qkeymap, Qnil); + keymap = XCDR (keymap); /* Skip the `keymap' symbol. */ - copy = Fcopy_alist (get_keymap (keymap, 1, 0)); - - for (tail = copy; CONSP (tail); tail = XCDR (tail)) + while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap)) { - Lisp_Object elt; - - elt = XCAR (tail); + Lisp_Object elt = XCAR (keymap); if (CHAR_TABLE_P (elt)) { Lisp_Object indices[3]; - elt = Fcopy_sequence (elt); - XSETCAR (tail, elt); - - map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices); + map_char_table (copy_keymap_1, Qnil, elt, elt, elt, 0, indices); } else if (VECTORP (elt)) { int i; - elt = Fcopy_sequence (elt); - XSETCAR (tail, elt); - 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 (XCDR (elt))) - { - Lisp_Object tem; - tem = XCDR (elt); - - /* Is this a new format menu item. */ - if (EQ (XCAR (tem),Qmenu_item)) - { - /* Copy cell with menu-item marker. */ - XSETCDR (elt, - Fcons (XCAR (tem), XCDR (tem))); - elt = XCDR (elt); - tem = XCDR (elt); - if (CONSP (tem)) - { - /* Copy cell with menu-item name. */ - 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. */ - 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. */ - XSETCDR (elt, XCDR (tem)); - } - } - else - { - /* It may be an old fomat menu item. - Skip the optional menu string. - */ - if (STRINGP (XCAR (tem))) - { - /* Copy the cell, since copy-alist didn't go this deep. */ - XSETCDR (elt, - Fcons (XCAR (tem), XCDR (tem))); - elt = XCDR (elt); - tem = XCDR (elt); - /* Also skip the optional menu help string. */ - if (CONSP (tem) && STRINGP (XCAR (tem))) - { - 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 (XCAR (tem)) - && (NILP (XCAR (XCAR (tem))) - || VECTORP (XCAR (XCAR (tem))))) - XSETCDR (elt, XCDR (tem)); - } - if (CONSP (elt) - && CONSP (XCDR (elt)) - && EQ (XCAR (XCDR (elt)), Qkeymap)) - XSETCDR (elt, Fcopy_keymap (XCDR (elt))); - } - + ASET (elt, i, copy_keymap_item (AREF (elt, i))); } + else if (CONSP (elt)) + elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt))); + XSETCDR (tail, Fcons (elt, Qnil)); + tail = XCDR (tail); + keymap = XCDR (keymap); } - + XSETCDR (tail, keymap); return copy; } @@ -953,25 +1098,30 @@ is not copied. */) /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0, - 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. + doc: /* In KEYMAP, define key sequence KEY 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. +Using [t] for KEY creates a default definition, which applies to any +event type that has no other definition in this keymap. + 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 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 + 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. + 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. + or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP. -If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at -the front of KEYMAP. */) +If KEYMAP is a sparse keymap with a binding for KEY, the existing +binding is altered. If there is no binding for KEY, the new pair +binding KEY to DEF is added at the front of KEYMAP. */) (keymap, key, def) Lisp_Object keymap; Lisp_Object key; @@ -985,6 +1135,7 @@ the front of KEYMAP. */) int length; struct gcpro gcpro1, gcpro2, gcpro3; + GCPRO3 (keymap, key, def); keymap = get_keymap (keymap, 1, 1); if (!VECTORP (key) && !STRINGP (key)) @@ -992,17 +1143,12 @@ the front of KEYMAP. */) length = XFASTINT (Flength (key)); if (length == 0) - return Qnil; + RETURN_UNGCPRO (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)) - meta_bit = meta_modifier; - else - meta_bit = 0x80; + meta_bit = VECTORP (key) ? meta_modifier : 0x80; idx = 0; while (1) @@ -1047,11 +1193,29 @@ the front of KEYMAP. */) 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", - XSTRING (Fkey_description (key))->data); + error ("Key sequence %s starts with non-prefix key %s", + SDATA (Fkey_description (key, Qnil)), + SDATA (Fkey_description (Fsubstring (key, make_number (0), + make_number (idx)), + Qnil))); } } +/* This function may GC (it calls Fkey_binding). */ + +DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 1, 0, + doc: /* Return the remapping for command COMMAND in current keymaps. +Returns nil if COMMAND is not remapped (or not a symbol). */) + (command) + Lisp_Object command; +{ + if (!SYMBOLP (command)) + return Qnil; + + ASET (command_remapping_vector, 1, command); + return Fkey_binding (command_remapping_vector, Qnil, Qt); +} + /* Value is number if KEY is too long; nil if valid but has no definition. */ /* GC is possible in this function if it autoloads a keymap. */ @@ -1063,7 +1227,7 @@ 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. +it takes to reach a non-prefix key. Normally, `lookup-key' ignores bindings for t, which act as default bindings, used when nothing else in the keymap applies; this makes it @@ -1071,7 +1235,7 @@ 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 keymap; Lisp_Object key; Lisp_Object accept_default; { @@ -1080,8 +1244,9 @@ recognize the default bindings, just as `read-key-sequence' does. */) register Lisp_Object c; int length; int t_ok = !NILP (accept_default); - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2; + GCPRO2 (keymap, key); keymap = get_keymap (keymap, 1, 1); if (!VECTORP (key) && !STRINGP (key)) @@ -1089,9 +1254,7 @@ recognize the default bindings, just as `read-key-sequence' does. */) length = XFASTINT (Flength (key)); if (length == 0) - return keymap; - - GCPRO1 (key); + RETURN_UNGCPRO (keymap); idx = 0; while (1) @@ -1102,10 +1265,12 @@ recognize the default bindings, just as `read-key-sequence' does. */) c = Fevent_convert_list (c); /* Turn the 8th bit of string chars into a meta modifier. */ - if (XINT (c) & 0x80 && STRINGP (key)) + if (INTEGERP (c) && XINT (c) & 0x80 && STRINGP (key)) XSETINT (c, (XINT (c) | meta_modifier) & ~0x80); - if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c)) + /* Allow string since binding for `menu-bar-select-buffer' + includes the buffer name in the key sequence. */ + if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c)) error ("Key sequence contains invalid event"); cmd = access_keymap (keymap, c, t_ok, 0, 1); @@ -1163,7 +1328,7 @@ silly_event_symbol_error (c) { Lisp_Object parsed, base, name, assoc; int modifiers; - + parsed = parse_modifiers (c); modifiers = (int) XUINT (XCAR (XCDR (parsed))); base = XCAR (parsed); @@ -1192,12 +1357,12 @@ silly_event_symbol_error (c) c = reorder_modifiers (c); keystring = concat2 (build_string (new_mods), XCDR (assoc)); - + error ((modifiers & ~meta_modifier ? "To bind the key %s, use [?%s], not [%s]" : "To bind the key %s, use \"%s\", not [%s]"), - XSYMBOL (c)->name->data, XSTRING (keystring)->data, - XSYMBOL (c)->name->data); + SDATA (SYMBOL_NAME (c)), SDATA (keystring), + SDATA (SYMBOL_NAME (c))); } } @@ -1206,15 +1371,8 @@ silly_event_symbol_error (c) /* We can't put these variables inside current_minor_maps, since under some systems, static gets macro-defined to be the empty string. Ickypoo. */ -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; -} +static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL; +static int cmm_size = 0; /* 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. @@ -1239,81 +1397,93 @@ current_minor_maps (modeptr, mapptr) int i = 0; int list_number = 0; Lisp_Object alist, assoc, var, val; + Lisp_Object emulation_alists; Lisp_Object lists[2]; + emulation_alists = Vemulation_mode_map_alists; 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 = 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; - - /* 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)) - continue; - } + { + if (CONSP (emulation_alists)) + { + alist = XCAR (emulation_alists); + emulation_alists = XCDR (emulation_alists); + if (SYMBOLP (alist)) + alist = find_symbol_value (alist); + list_number = -1; + } + else + alist = lists[list_number]; - if (i >= cmm_size) - { - Lisp_Object *newmodes, *newmaps; + for ( ; CONSP (alist); 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; - /* 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 *newmodes); - newmaps - = (Lisp_Object *) realloc (cmm_maps, - cmm_size * sizeof *newmaps); - UNBLOCK_INPUT; - } - else - { - BLOCK_INPUT; - cmm_size = 30; - newmodes - = (Lisp_Object *) malloc (cmm_size * sizeof *newmodes); - newmaps - = (Lisp_Object *) malloc (cmm_size * sizeof *newmaps); - UNBLOCK_INPUT; - } + /* 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)) + continue; + } - if (newmodes) - cmm_modes = newmodes; - if (newmaps) - cmm_maps = newmaps; - - if (newmodes == NULL || newmaps == NULL) - break; - } + if (i >= cmm_size) + { + int newsize, allocsize; + Lisp_Object *newmodes, *newmaps; - /* Get the keymap definition--or nil if it is not defined. */ - temp = internal_condition_case_1 (Findirect_function, - XCDR (assoc), - Qerror, current_minor_maps_error); - if (!NILP (temp)) - { - cmm_modes[i] = var; - cmm_maps [i] = temp; - i++; - } - } + newsize = cmm_size == 0 ? 30 : cmm_size * 2; + allocsize = newsize * sizeof *newmodes; + + /* Use malloc here. See the comment above this function. + Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */ + BLOCK_INPUT; + newmodes = (Lisp_Object *) malloc (allocsize); + if (newmodes) + { + if (cmm_modes) + { + bcopy (cmm_modes, newmodes, cmm_size * sizeof cmm_modes[0]); + free (cmm_modes); + } + cmm_modes = newmodes; + } + + newmaps = (Lisp_Object *) malloc (allocsize); + if (newmaps) + { + if (cmm_maps) + { + bcopy (cmm_maps, newmaps, cmm_size * sizeof cmm_maps[0]); + free (cmm_maps); + } + cmm_maps = newmaps; + } + UNBLOCK_INPUT; + + if (newmodes == NULL || newmaps == NULL) + break; + cmm_size = newsize; + } + + /* Get the keymap definition--or nil if it is not defined. */ + temp = Findirect_function (XCDR (assoc), Qt); + if (!NILP (temp)) + { + cmm_modes[i] = var; + cmm_maps [i] = temp; + i++; + } + } + } if (modeptr) *modeptr = cmm_modes; if (mapptr) *mapptr = cmm_maps; @@ -1332,10 +1502,13 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and 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); + /* The doc said that overriding-terminal-local-map should + override overriding-local-map. The code used them both, + but it seems clearer to use just one. rms, jan 2005. */ + else if (!NILP (Voverriding_local_map)) + keymaps = Fcons (Voverriding_local_map, keymaps); } if (NILP (XCDR (keymaps))) { @@ -1343,27 +1516,31 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and Lisp_Object *maps; int nmaps, i; + /* This usually returns the buffer's local map, + but that can be overridden by a `local-map' property. */ local = get_local_map (PT, current_buffer, Qlocal_map); if (!NILP (local)) keymaps = Fcons (local, keymaps); + /* Now put all the minor mode keymaps on the list. */ nmaps = current_minor_maps (0, &maps); for (i = --nmaps; i >= 0; i--) if (!NILP (maps[i])) keymaps = Fcons (maps[i], keymaps); + /* This returns nil unless there is a `keymap' property. */ local = get_local_map (PT, current_buffer, Qkeymap); if (!NILP (local)) keymaps = Fcons (local, keymaps); } - + return keymaps; } /* GC is possible in this function if it autoloads a keymap. */ -DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0, +DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 3, 0, 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. @@ -1372,9 +1549,14 @@ 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; +recognize the default bindings, just as `read-key-sequence' does. + +Like the normal command loop, `key-binding' will remap the command +resulting from looking up KEY by looking up the command in the +current keymaps. However, if the optional third argument NO-REMAP +is non-nil, `key-binding' returns the unmapped command. */) + (key, accept_default, no_remap) + Lisp_Object key, accept_default, no_remap; { Lisp_Object *maps, value; int nmaps, i; @@ -1387,16 +1569,16 @@ recognize the default bindings, just as `read-key-sequence' does. */) value = Flookup_key (current_kboard->Voverriding_terminal_local_map, key, accept_default); if (! NILP (value) && !INTEGERP (value)) - RETURN_UNGCPRO (value); + goto done; } else if (!NILP (Voverriding_local_map)) { value = Flookup_key (Voverriding_local_map, key, accept_default); if (! NILP (value) && !INTEGERP (value)) - RETURN_UNGCPRO (value); + goto done; } else - { + { Lisp_Object local; local = get_local_map (PT, current_buffer, Qkeymap); @@ -1404,7 +1586,7 @@ recognize the default bindings, just as `read-key-sequence' does. */) { value = Flookup_key (local, key, accept_default); if (! NILP (value) && !INTEGERP (value)) - RETURN_UNGCPRO (value); + goto done; } nmaps = current_minor_maps (0, &maps); @@ -1416,7 +1598,7 @@ recognize the default bindings, just as `read-key-sequence' does. */) { value = Flookup_key (maps[i], key, accept_default); if (! NILP (value) && !INTEGERP (value)) - RETURN_UNGCPRO (value); + goto done; } local = get_local_map (PT, current_buffer, Qlocal_map); @@ -1424,23 +1606,35 @@ recognize the default bindings, just as `read-key-sequence' does. */) { value = Flookup_key (local, key, accept_default); if (! NILP (value) && !INTEGERP (value)) - RETURN_UNGCPRO (value); + goto done; } } value = Flookup_key (current_global_map, key, accept_default); + + done: UNGCPRO; - if (! NILP (value) && !INTEGERP (value)) - return value; - - return Qnil; + if (NILP (value) || INTEGERP (value)) + return Qnil; + + /* If the result of the ordinary keymap lookup is an interactive + command, look for a key binding (ie. remapping) for that command. */ + + if (NILP (no_remap) && SYMBOLP (value)) + { + Lisp_Object value1; + if (value1 = Fcommand_remapping (value), !NILP (value1)) + value = value1; + } + + return value; } /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0, doc: /* Return the binding for command KEYS in current local keymap only. -KEYS is a string, a sequence of keystrokes. +KEYS is a string or vector, a sequence of keystrokes. The binding is probably a symbol with a function definition. If optional argument ACCEPT-DEFAULT is non-nil, recognize default @@ -1459,9 +1653,9 @@ bindings; see the description of `lookup-key' for more details about this. */) DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0, doc: /* Return the binding for command KEYS in current global keymap only. -KEYS is a string, a sequence of keystrokes. +KEYS is a string or vector, 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 +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 @@ -1476,7 +1670,7 @@ bindings; see the description of `lookup-key' for more details about this. */) DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0, doc: /* Find the visible minor mode bindings of KEY. -Return an alist of pairs (MODENAME . BINDING), where MODENAME is the +Return an alist of pairs (MODENAME . BINDING), where MODENAME is 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 @@ -1524,7 +1718,8 @@ 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. */) +string for the map. This is required to use the keymap as a menu. +This function returns COMMAND. */) (command, mapvar, name) Lisp_Object command, mapvar, name; { @@ -1597,43 +1792,54 @@ accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized) { Lisp_Object tem; - cmd = get_keyelt (cmd, 0); + cmd = get_keymap (get_keyelt (cmd, 0), 0, 0); if (NILP (cmd)) return; - tem = get_keymap (cmd, 0, 0); - if (CONSP (tem)) + /* Look for and break cycles. */ + while (!NILP (tem = Frassq (cmd, maps))) { - 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)); - } + Lisp_Object prefix = XCAR (tem); + int lim = XINT (Flength (XCAR (tem))); + if (lim <= XINT (Flength (thisseq))) + { /* This keymap was already seen with a smaller prefix. */ + int i = 0; + while (i < lim && EQ (Faref (prefix, make_number (i)), + Faref (thisseq, make_number (i)))) + i++; + if (i >= lim) + /* `prefix' is a prefix of `thisseq' => there's a cycle. */ + return; } + /* This occurrence of `cmd' in `maps' does not correspond to a cycle, + but maybe `cmd' occurs again further down in `maps', so keep + looking. */ + maps = XCDR (Fmemq (tem, maps)); + } + + /* 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)); } } @@ -1661,7 +1867,7 @@ then the value includes only maps for prefixes that start with PREFIX. */) (keymap, prefix) Lisp_Object keymap, prefix; { - Lisp_Object maps, good_maps, tail; + Lisp_Object maps, tail; int prefixlen = 0; /* no need for gcpro because we don't autoload any keymaps. */ @@ -1688,8 +1894,8 @@ then the value includes only maps for prefixes that start with 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;) + copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil); + for (i = 0, i_byte = 0; i < SCHARS (prefix);) { int i_before = i; @@ -1744,7 +1950,7 @@ then the value includes only maps for prefixes that start with PREFIX. */) { Lisp_Object indices[3]; - map_char_table (accessible_keymaps_char_table, Qnil, + map_char_table (accessible_keymaps_char_table, Qnil, elt, elt, Fcons (Fcons (maps, make_number (is_metized)), Fcons (tail, thisseq)), 0, indices); @@ -1757,123 +1963,126 @@ then the value includes only maps for prefixes that start with PREFIX. */) 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)) accessible_keymaps_1 (XCAR (elt), XCDR (elt), maps, tail, thisseq, is_metized && INTEGERP (XCAR (elt))); - - } - } - - if (NILP (prefix)) - return maps; - - /* Now find just the maps whose access prefixes start with PREFIX. */ - good_maps = Qnil; - for (; CONSP (maps); maps = XCDR (maps)) - { - Lisp_Object elt, thisseq; - 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) - { - int i; - for (i = 0; i < prefixlen; i++) - { - Lisp_Object i1; - XSETFASTINT (i1, i); - if (!EQ (Faref (thisseq, i1), Faref (prefix, i1))) - break; - } - if (i == prefixlen) - good_maps = Fcons (elt, good_maps); } } - return Fnreverse (good_maps); + return maps; } Lisp_Object Qsingle_key_description, Qkey_description; /* This function cannot GC. */ -DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0, +DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0, doc: /* Return a pretty description of key-sequence KEYS. -Control characters turn into "C-foo" sequences, meta into "M-foo" +Optional arg PREFIX is the sequence of keys leading up to KEYS. +Control characters turn into "C-foo" sequences, meta into "M-foo", spaces are put between sequence elements, etc. */) - (keys) - Lisp_Object keys; + (keys, prefix) + Lisp_Object keys, prefix; { int len = 0; int i, i_byte; - Lisp_Object sep; - Lisp_Object *args = NULL; + Lisp_Object *args; + int size = XINT (Flength (keys)); + Lisp_Object list; + Lisp_Object sep = build_string (" "); + Lisp_Object key; + int add_meta = 0; + + if (!NILP (prefix)) + size += XINT (Flength (prefix)); + + /* This has one extra element at the end that we don't pass to Fconcat. */ + args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object)); + + /* In effect, this computes + (mapconcat 'single-key-description keys " ") + but we shouldn't use mapconcat because it can do GC. */ - if (STRINGP (keys)) + next_list: + if (!NILP (prefix)) + list = prefix, prefix = Qnil; + else if (!NILP (keys)) + list = keys, keys = Qnil; + else { - Lisp_Object vector; - vector = Fmake_vector (Flength (keys), Qnil); - for (i = 0, i_byte = 0; i < XSTRING (keys)->size; ) + if (add_meta) { - int c; - int i_before = i; - - 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); + args[len] = Fsingle_key_description (meta_prefix_char, Qnil); + len += 2; } - keys = vector; + else if (len == 0) + return empty_string; + return Fconcat (len - 1, args); } - if (VECTORP (keys)) - { - /* In effect, this computes - (mapconcat 'single-key-description keys " ") - but we shouldn't use mapconcat because it can do GC. */ + if (STRINGP (list)) + size = SCHARS (list); + else if (VECTORP (list)) + size = XVECTOR (list)->size; + else if (CONSP (list)) + size = XINT (Flength (list)); + else + wrong_type_argument (Qarrayp, list); - 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)); + i = i_byte = 0; - for (i = 0; i < len; i++) + while (i < size) + { + if (STRINGP (list)) + { + int c; + FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte); + if (SINGLE_BYTE_CHAR_P (c) && (c & 0200)) + c ^= 0200 | meta_modifier; + XSETFASTINT (key, c); + } + else if (VECTORP (list)) { - args[i * 2] = Fsingle_key_description (AREF (keys, i), Qnil); - args[i * 2 + 1] = sep; + key = AREF (list, i++); + } + else + { + key = XCAR (list); + list = XCDR (list); + i++; } - } - else if (CONSP (keys)) - { - /* 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++) + if (add_meta) { - args[i * 2] = Fsingle_key_description (XCAR (keys), Qnil); - args[i * 2 + 1] = sep; - keys = XCDR (keys); + if (!INTEGERP (key) + || EQ (key, meta_prefix_char) + || (XINT (key) & meta_modifier)) + { + args[len++] = Fsingle_key_description (meta_prefix_char, Qnil); + args[len++] = sep; + if (EQ (key, meta_prefix_char)) + continue; + } + else + XSETINT (key, (XINT (key) | meta_modifier) & ~0x80); + add_meta = 0; } + else if (EQ (key, meta_prefix_char)) + { + add_meta = 1; + continue; + } + args[len++] = Fsingle_key_description (key, Qnil); + args[len++] = sep; } - else - keys = wrong_type_argument (Qarrayp, keys); - - if (len == 0) - return empty_string; - return Fconcat (len * 2 - 1, args); + goto next_list; } + char * push_key_description (c, p, force_multibyte) register unsigned int c; @@ -1881,12 +2090,21 @@ push_key_description (c, p, force_multibyte) int force_multibyte; { unsigned c2; - + int valid_p; + /* 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); + valid_p = SINGLE_BYTE_CHAR_P (c2) || char_valid_p (c2, 0); + if (! valid_p) + { + /* KEY_DESCRIPTION_SIZE is large enough for this. */ + p += sprintf (p, "[%d]", c); + return p; + } + if (c & alt_modifier) { *p++ = 'A'; @@ -1974,16 +2192,13 @@ push_key_description (c, p, force_multibyte) } else { - int valid_p = SINGLE_BYTE_CHAR_P (c) || char_valid_p (c, 0); - - if (force_multibyte && valid_p) + if (force_multibyte) { 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) + else if (NILP (current_buffer->enable_multibyte_characters)) { int bit_offset; *p++ = '\\'; @@ -2062,8 +2277,8 @@ around function keys and event symbols. */) if (NILP (no_angles)) { char *buffer - = (char *) alloca (STRING_BYTES (XSYMBOL (key)->name) + 5); - sprintf (buffer, "<%s>", XSYMBOL (key)->name->data); + = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5); + sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key))); return build_string (buffer); } else @@ -2106,7 +2321,11 @@ push_text_char_description (c, p) DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0, doc: /* Return a pretty description of file-character CHARACTER. -Control characters turn into "^char", etc. */) +Control characters turn into "^char", etc. This differs from +`single-key-description' which turns them into "C-char". +Also, this function recognizes the 2**7 bit as the Meta character, +whereas `single-key-description' uses the 2**27 bit for Meta. +See Info node `(elisp)Describing Characters' for examples. */) (character) Lisp_Object character; { @@ -2156,6 +2375,7 @@ ascii_sequence_p (seq) /* where-is - finding a command in a set of keymaps. */ +static Lisp_Object where_is_internal (); static Lisp_Object where_is_internal_1 (); static void where_is_internal_2 (); @@ -2171,18 +2391,27 @@ shadow_lookup (shadow, key, flag) for (tail = shadow; CONSP (tail); tail = XCDR (tail)) { value = Flookup_key (XCAR (tail), key, flag); - if (!NILP (value) && !NATNUMP (value)) + if (NATNUMP (value)) + { + value = Flookup_key (XCAR (tail), + Fsubstring (key, make_number (0), value), flag); + if (!NILP (value)) + return Qnil; + } + else if (!NILP (value)) return value; } return Qnil; } +static Lisp_Object Vmouse_events; + /* This function can GC if Flookup_key autoloads any keymaps. */ static Lisp_Object -where_is_internal (definition, keymaps, firstonly, noindirect) +where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) Lisp_Object definition, keymaps; - Lisp_Object firstonly, noindirect; + Lisp_Object firstonly, noindirect, no_remap; { Lisp_Object maps = Qnil; Lisp_Object found, sequences; @@ -2190,6 +2419,15 @@ where_is_internal (definition, keymaps, firstonly, noindirect) /* 1 means ignore all menu bindings entirely. */ int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii); + /* If this command is remapped, then it has no key bindings + of its own. */ + if (NILP (no_remap) && SYMBOLP (definition)) + { + Lisp_Object tem; + if (tem = Fcommand_remapping (definition), !NILP (tem)) + return Qnil; + } + found = keymaps; while (CONSP (found)) { @@ -2198,7 +2436,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect) Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil)); found = XCDR (found); } - + GCPRO5 (definition, keymaps, maps, found, sequences); found = Qnil; sequences = Qnil; @@ -2206,7 +2444,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect) for (; !NILP (maps); maps = Fcdr (maps)) { /* Key sequence to reach map, and the map that it reaches */ - register Lisp_Object this, map; + register Lisp_Object this, map, tem; /* In order to fold [META-PREFIX-CHAR CHAR] sequences into [M-CHAR] sequences, check if last character of the sequence @@ -2222,12 +2460,13 @@ where_is_internal (definition, keymaps, firstonly, noindirect) /* if (nomenus && !ascii_sequence_p (this)) */ if (nomenus && XINT (last) >= 0 - && !INTEGERP (Faref (this, make_number (0)))) + && SYMBOLP (tem = Faref (this, make_number (0))) + && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events))) /* 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)) @@ -2276,7 +2515,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect) Fcons (Fcons (this, last), Fcons (make_number (nomenus), make_number (last_is_meta)))); - map_char_table (where_is_internal_2, Qnil, elt, args, + map_char_table (where_is_internal_2, Qnil, elt, elt, args, 0, indices); sequences = XCDR (XCAR (args)); } @@ -2295,11 +2534,36 @@ where_is_internal (definition, keymaps, firstonly, noindirect) } - for (; !NILP (sequences); sequences = XCDR (sequences)) + while (!NILP (sequences)) { - Lisp_Object sequence; + Lisp_Object sequence, remapped, function; sequence = XCAR (sequences); + sequences = XCDR (sequences); + + /* If the current sequence is a command remapping with + format [remap COMMAND], find the key sequences + which run COMMAND, and use those sequences instead. */ + remapped = Qnil; + if (NILP (no_remap) + && VECTORP (sequence) && XVECTOR (sequence)->size == 2 + && EQ (AREF (sequence, 0), Qremap) + && (function = AREF (sequence, 1), SYMBOLP (function))) + { + Lisp_Object remapped1; + + remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt); + if (CONSP (remapped1)) + { + /* Verify that this key binding actually maps to the + remapped command (see below). */ + if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function)) + continue; + sequence = XCAR (remapped1); + remapped = XCDR (remapped1); + goto record_sequence; + } + } /* Verify that this key binding is not shadowed by another binding for the same key, before we say it exists. @@ -2313,6 +2577,20 @@ where_is_internal (definition, keymaps, firstonly, noindirect) if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition)) continue; + record_sequence: + /* Don't annoy user with strings from a menu such as + Select Paste. Change them all to "(any string)", + so that there seems to be only one menu item + to report. */ + if (! NILP (sequence)) + { + Lisp_Object tem; + tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1)); + if (STRINGP (tem)) + Faset (sequence, make_number (XVECTOR (sequence)->size - 1), + build_string ("(any string)")); + } + /* 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))) @@ -2326,6 +2604,13 @@ where_is_internal (definition, keymaps, firstonly, noindirect) RETURN_UNGCPRO (sequence); else if (!NILP (firstonly) && ascii_sequence_p (sequence)) RETURN_UNGCPRO (sequence); + + if (CONSP (remapped)) + { + sequence = XCAR (remapped); + remapped = XCDR (remapped); + goto record_sequence; + } } } } @@ -2339,13 +2624,13 @@ where_is_internal (definition, keymaps, firstonly, noindirect) return the best we could find. */ if (!NILP (firstonly)) return Fcar (found); - + return found; } -DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0, +DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0, doc: /* Return list of keys that invoke DEFINITION. -If KEYMAP is non-nil, search only KEYMAP and the global keymap. +If KEYMAP is a keymap, 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. @@ -2353,15 +2638,19 @@ 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 FIRSTONLY has another non-nil value, prefer sequences of ASCII characters +\(or their meta variants) 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) +indirect definition itself. + +If optional 5th arg NO-REMAP is non-nil, don't search for key sequences +that invoke a command which is remapped to DEFINITION, but include the +remapped command in the returned list. */) + (definition, keymap, firstonly, noindirect, no_remap) Lisp_Object definition, keymap; - Lisp_Object firstonly, noindirect; + Lisp_Object firstonly, noindirect, no_remap; { Lisp_Object sequences, keymaps; /* 1 means ignore all menu bindings entirely. */ @@ -2382,8 +2671,8 @@ indirect definition itself. */) { Lisp_Object *defns; int i, j, n; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + /* Check heuristic-consistency of the cache. */ if (NILP (Fequal (keymaps, where_is_cache_keymaps))) where_is_cache = Qnil; @@ -2394,10 +2683,10 @@ indirect definition itself. */) 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); + GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap); + where_is_internal (definition, keymaps, firstonly, noindirect, no_remap); UNGCPRO; where_is_cache_keymaps = keymaps; @@ -2411,7 +2700,7 @@ indirect definition itself. */) 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); @@ -2434,7 +2723,7 @@ indirect definition itself. */) /* 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); + result = where_is_internal (definition, keymaps, firstonly, noindirect, no_remap); } return result; @@ -2479,7 +2768,7 @@ where_is_internal_2 (args, key, binding) } -/* This function cannot GC. */ +/* This function can GC because get_keyelt can. */ static Lisp_Object where_is_internal_1 (binding, key, definition, noindirect, this, last, @@ -2554,8 +2843,8 @@ You type Translation\n\ if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix)) { int c; - unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data; - int translate_len = XSTRING (Vkeyboard_translate_table)->size; + const unsigned char *translate = SDATA (Vkeyboard_translate_table); + int translate_len = SCHARS (Vkeyboard_translate_table); for (c = 0; c < translate_len; c++) if (translate[c] != c) @@ -2576,6 +2865,9 @@ You type Translation\n\ insert (buf, bufend - buf); insert ("\n", 1); + + /* Insert calls signal_after_change which may GC. */ + translate = SDATA (Vkeyboard_translate_table); } insert ("\n", 1); @@ -2583,7 +2875,7 @@ You type Translation\n\ if (!NILP (Vkey_translation_map)) describe_map_tree (Vkey_translation_map, 0, Qnil, prefix, - "Key translations", nomenu, 1, 0); + "Key translations", nomenu, 1, 0, 0); /* Print the (major mode) local map. */ @@ -2596,7 +2888,7 @@ You type Translation\n\ if (!NILP (start1)) { describe_map_tree (start1, 1, shadow, prefix, - "\f\nOverriding Bindings", nomenu, 0, 0); + "\f\nOverriding Bindings", nomenu, 0, 0, 0); shadow = Fcons (start1, shadow); } else @@ -2617,7 +2909,8 @@ You type Translation\n\ if (!NILP (start1)) { describe_map_tree (start1, 1, shadow, prefix, - "\f\n`keymap' Property Bindings", nomenu, 0, 0); + "\f\n`keymap' Property Bindings", nomenu, + 0, 0, 0); shadow = Fcons (start1, shadow); } @@ -2633,19 +2926,20 @@ You type Translation\n\ if (!SYMBOLP (modes[i])) abort(); - p = title = (char *) alloca (42 + XSYMBOL (modes[i])->name->size); + p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i]))); *p++ = '\f'; *p++ = '\n'; *p++ = '`'; - bcopy (XSYMBOL (modes[i])->name->data, p, - XSYMBOL (modes[i])->name->size); - p += XSYMBOL (modes[i])->name->size; + bcopy (SDATA (SYMBOL_NAME (modes[i])), p, + SCHARS (SYMBOL_NAME (modes[i]))); + p += SCHARS (SYMBOL_NAME (modes[i])); *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); + describe_map_tree (maps[i], 1, shadow, prefix, + title, nomenu, 0, 0, 0); shadow = Fcons (maps[i], shadow); } @@ -2655,23 +2949,23 @@ You type Translation\n\ { if (EQ (start1, XBUFFER (buffer)->keymap)) describe_map_tree (start1, 1, shadow, prefix, - "\f\nMajor Mode Bindings", nomenu, 0, 0); + "\f\nMajor Mode Bindings", nomenu, 0, 0, 0); else describe_map_tree (start1, 1, shadow, prefix, "\f\n`local-map' Property Bindings", - nomenu, 0, 0); + nomenu, 0, 0, 0); shadow = Fcons (start1, shadow); } } describe_map_tree (current_global_map, 1, shadow, prefix, - "\f\nGlobal Bindings", nomenu, 0, 1); + "\f\nGlobal Bindings", nomenu, 0, 1, 0); /* Print the function-key-map translations under this prefix. */ if (!NILP (Vfunction_key_map)) describe_map_tree (Vfunction_key_map, 0, Qnil, prefix, - "\f\nFunction key map translations", nomenu, 1, 0); + "\f\nFunction key map translations", nomenu, 1, 0, 0); UNGCPRO; return Qnil; @@ -2692,17 +2986,21 @@ You type Translation\n\ so print strings and vectors differently. If ALWAYS_TITLE is nonzero, print the title even if there are no maps - to look through. */ + to look through. + + If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW, + don't omit it; instead, mention it but say it is shadowed. */ void describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl, - always_title) + always_title, mention_shadow) Lisp_Object startmap, shadow, prefix; int partial; char *title; int nomenu; int transl; int always_title; + int mention_shadow; { Lisp_Object maps, orig_maps, seen, sub_shadows; struct gcpro gcpro1, gcpro2, gcpro3; @@ -2745,7 +3043,7 @@ key binding\n\ if (!NILP (prefix)) { insert_string (" Starting With "); - insert1 (Fkey_description (prefix)); + insert1 (Fkey_description (prefix, Qnil)); } insert_string (":\n"); } @@ -2770,7 +3068,7 @@ key binding\n\ /* If the sequence by which we reach this keymap is zero-length, then the shadow map for this keymap is just SHADOW. */ - if ((STRINGP (prefix) && XSTRING (prefix)->size == 0) + if ((STRINGP (prefix) && SCHARS (prefix) == 0) || (VECTORP (prefix) && XVECTOR (prefix)->size == 0)) ; /* If the sequence by which we reach this keymap actually has @@ -2804,7 +3102,7 @@ key binding\n\ describe_map (Fcdr (elt), prefix, transl ? describe_translation : describe_command, - partial, sub_shadows, &seen, nomenu); + partial, sub_shadows, &seen, nomenu, mention_shadow); skip: ; } @@ -2822,7 +3120,7 @@ describe_command (definition, args) Lisp_Object definition, args; { register Lisp_Object tem1; - int column = current_column (); + int column = (int) current_column (); /* iftc */ int description_column; /* If column 16 is no good, go to col 32; @@ -2842,7 +3140,7 @@ describe_command (definition, args) if (SYMBOLP (definition)) { - XSETSTRING (tem1, XSYMBOL (definition)->name); + tem1 = SYMBOL_NAME (definition); insert1 (tem1); insert_string ("\n"); } @@ -2864,13 +3162,13 @@ describe_translation (definition, args) if (SYMBOLP (definition)) { - XSETSTRING (tem1, XSYMBOL (definition)->name); + tem1 = SYMBOL_NAME (definition); insert1 (tem1); insert_string ("\n"); } else if (STRINGP (definition) || VECTORP (definition)) { - insert1 (Fkey_description (definition)); + insert1 (Fkey_description (definition, Qnil)); insert_string ("\n"); } else if (KEYMAPP (definition)) @@ -2879,21 +3177,50 @@ describe_translation (definition, args) insert_string ("??\n"); } +/* describe_map puts all the usable elements of a sparse keymap + into an array of `struct describe_map_elt', + then sorts them by the events. */ + +struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; }; + +/* qsort comparison function for sorting `struct describe_map_elt' by + the event field. */ + +static int +describe_map_compare (aa, bb) + const void *aa, *bb; +{ + const struct describe_map_elt *a = aa, *b = bb; + if (INTEGERP (a->event) && INTEGERP (b->event)) + return ((XINT (a->event) > XINT (b->event)) + - (XINT (a->event) < XINT (b->event))); + if (!INTEGERP (a->event) && INTEGERP (b->event)) + return 1; + if (INTEGERP (a->event) && !INTEGERP (b->event)) + return -1; + if (SYMBOLP (a->event) && SYMBOLP (b->event)) + return (!NILP (Fstring_lessp (a->event, b->event)) ? -1 + : !NILP (Fstring_lessp (b->event, a->event)) ? 1 + : 0); + return 0; +} + /* Describe the contents of map MAP, assuming that this map itself is - reached by the sequence of prefix keys KEYS (a string or vector). + reached by the sequence of prefix keys PREFIX (a string or vector). PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */ static void -describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) +describe_map (map, prefix, elt_describer, partial, shadow, + seen, nomenu, mention_shadow) register Lisp_Object map; - Lisp_Object keys; + Lisp_Object prefix; void (*elt_describer) P_ ((Lisp_Object, Lisp_Object)); int partial; Lisp_Object shadow; Lisp_Object *seen; int nomenu; + int mention_shadow; { - Lisp_Object elt_prefix; Lisp_Object tail, definition, event; Lisp_Object tem; Lisp_Object suppress; @@ -2901,16 +3228,14 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) int first = 1; struct gcpro gcpro1, gcpro2, gcpro3; - suppress = Qnil; + /* These accumulate the values from sparse keymap bindings, + so we can sort them and handle them in order. */ + int length_needed = 0; + struct describe_map_elt *vect; + int slots_used = 0; + int i; - if (!NILP (keys) && XFASTINT (Flength (keys)) > 0) - { - /* Call Fkey_description first, to avoid GC bug for the other string. */ - tem = Fkey_description (keys); - elt_prefix = concat2 (tem, build_string (" ")); - } - else - elt_prefix = Qnil; + suppress = Qnil; if (partial) suppress = intern ("suppress-keymap"); @@ -2921,7 +3246,13 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) kludge = Fmake_vector (make_number (1), Qnil); definition = Qnil; - GCPRO3 (elt_prefix, definition, kludge); + for (tail = map; CONSP (tail); tail = XCDR (tail)) + length_needed++; + + vect = ((struct describe_map_elt *) + alloca (sizeof (struct describe_map_elt) * length_needed)); + + GCPRO3 (prefix, definition, kludge); for (tail = map; CONSP (tail); tail = XCDR (tail)) { @@ -2930,13 +3261,15 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) if (VECTORP (XCAR (tail)) || CHAR_TABLE_P (XCAR (tail))) describe_vector (XCAR (tail), - elt_prefix, Qnil, elt_describer, partial, shadow, map, - (int *)0, 0); + prefix, Qnil, elt_describer, partial, shadow, map, + (int *)0, 0, 1, mention_shadow); else if (CONSP (XCAR (tail))) { + int this_shadowed = 0; + event = XCAR (XCAR (tail)); - /* Ignore bindings whose "keys" are not really valid events. + /* Ignore bindings whose "prefix" are not really valid events. (We get these in the frames and buffers menu.) */ if (!(SYMBOLP (event) || INTEGERP (event))) continue; @@ -2962,29 +3295,24 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) if (!NILP (shadow)) { tem = shadow_lookup (shadow, kludge, Qt); - if (!NILP (tem)) continue; + if (!NILP (tem)) + { + /* Avoid generating duplicate entries if the + shadowed binding has the same definition. */ + if (mention_shadow && !EQ (tem, definition)) + this_shadowed = 1; + else + continue; + } } tem = Flookup_key (map, kludge, Qt); if (!EQ (tem, definition)) continue; - if (first) - { - previous_description_column = 0; - insert ("\n", 1); - first = 0; - } - - if (!NILP (elt_prefix)) - insert1 (elt_prefix); - - /* THIS gets the string to describe the character 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, Qnil); + vect[slots_used].event = event; + vect[slots_used].definition = definition; + vect[slots_used].shadowed = this_shadowed; + slots_used++; } else if (EQ (XCAR (tail), Qkeymap)) { @@ -2992,9 +3320,71 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) using an inherited keymap. So skip anything we've already encountered. */ tem = Fassq (tail, *seen); - if (CONSP (tem) && !NILP (Fequal (XCAR (tem), keys))) + if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix))) break; - *seen = Fcons (Fcons (tail, keys), *seen); + *seen = Fcons (Fcons (tail, prefix), *seen); + } + } + + /* If we found some sparse map events, sort them. */ + + qsort (vect, slots_used, sizeof (struct describe_map_elt), + describe_map_compare); + + /* Now output them in sorted order. */ + + for (i = 0; i < slots_used; i++) + { + Lisp_Object start, end; + + if (first) + { + previous_description_column = 0; + insert ("\n", 1); + first = 0; + } + + ASET (kludge, 0, vect[i].event); + start = vect[i].event; + end = start; + + definition = vect[i].definition; + + /* Find consecutive chars that are identically defined. */ + if (INTEGERP (vect[i].event)) + { + while (i + 1 < slots_used + && EQ (vect[i+1].event, make_number (XINT (vect[i].event) + 1)) + && !NILP (Fequal (vect[i + 1].definition, definition)) + && vect[i].shadowed == vect[i + 1].shadowed) + i++; + end = vect[i].event; + } + + /* Now START .. END is the range to describe next. */ + + /* Insert the string to describe the event START. */ + insert1 (Fkey_description (kludge, prefix)); + + if (!EQ (start, end)) + { + insert (" .. ", 4); + + ASET (kludge, 0, end); + /* Insert the string to describe the character END. */ + insert1 (Fkey_description (kludge, prefix)); + } + + /* Print a description of the definition of this character. + elt_describer will take care of spacing out far enough + for alignment purposes. */ + (*elt_describer) (vect[i].definition, Qnil); + + if (vect[i].shadowed) + { + SET_PT (PT - 1); + insert_string ("\n (that binding is currently shadowed by another mode)"); + SET_PT (PT + 1); } } @@ -3012,17 +3402,18 @@ describe_vector_princ (elt, fun) 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. */) +This is text showing the elements of vector matched against indices. +DESCRIBER is the output function used; nil means use `princ'. */) (vector, describer) Lisp_Object vector, describer; { - int count = specpdl_ptr - specpdl; + int count = SPECPDL_INDEX (); if (NILP (describer)) describer = intern ("princ"); specbind (Qstandard_output, Fcurrent_buffer ()); CHECK_VECTOR_OR_CHAR_TABLE (vector); describe_vector (vector, Qnil, describer, describe_vector_princ, 0, - Qnil, Qnil, (int *)0, 0); + Qnil, Qnil, (int *)0, 0, 0, 0); return unbind_to (count, Qnil); } @@ -3057,28 +3448,34 @@ This is text showing the elements of vector matched against indices. */) indices at higher levels in this char-table, and CHAR_TABLE_DEPTH says how many levels down we have gone. + KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-. + ARGS is simply passed as the second argument to ELT_DESCRIBER. */ -void -describe_vector (vector, elt_prefix, args, elt_describer, +static void +describe_vector (vector, prefix, args, elt_describer, partial, shadow, entire_map, - indices, char_table_depth) + indices, char_table_depth, keymap_p, + mention_shadow) register Lisp_Object vector; - Lisp_Object elt_prefix, args; + Lisp_Object prefix, args; void (*elt_describer) P_ ((Lisp_Object, Lisp_Object)); int partial; Lisp_Object shadow; Lisp_Object entire_map; int *indices; int char_table_depth; + int keymap_p; + int mention_shadow; { Lisp_Object definition; Lisp_Object tem2; + Lisp_Object elt_prefix = Qnil; 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 @@ -3094,11 +3491,23 @@ describe_vector (vector, elt_prefix, args, elt_describer, definition = Qnil; + if (!keymap_p) + { + /* Call Fkey_description first, to avoid GC bug for the other string. */ + if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0) + { + Lisp_Object tem; + tem = Fkey_description (prefix, Qnil); + elt_prefix = concat2 (tem, build_string (" ")); + } + prefix = 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, definition, kludge); + GCPRO4 (elt_prefix, prefix, definition, kludge); if (partial) suppress = intern ("suppress-keymap"); @@ -3141,6 +3550,7 @@ describe_vector (vector, elt_prefix, args, elt_describer, for (i = from; i < to; i++) { + int this_shadowed = 0; QUIT; if (CHAR_TABLE_P (vector)) @@ -3191,15 +3601,22 @@ describe_vector (vector, elt_prefix, args, elt_describer, else character = i; + ASET (kludge, 0, make_number (character)); + /* If this binding is shadowed by some other map, ignore it. */ if (!NILP (shadow) && complete_char) { Lisp_Object tem; - - ASET (kludge, 0, make_number (character)); + tem = shadow_lookup (shadow, kludge, Qt); - if (!NILP (tem)) continue; + if (!NILP (tem)) + { + if (mention_shadow) + this_shadowed = 1; + else + continue; + } } /* Ignore this definition if it is shadowed by an earlier @@ -3208,7 +3625,6 @@ describe_vector (vector, elt_prefix, args, elt_describer, { Lisp_Object tem; - ASET (kludge, 0, make_number (character)); tem = Flookup_key (entire_map, kludge, Qt); if (!EQ (tem, definition)) @@ -3249,15 +3665,15 @@ describe_vector (vector, elt_prefix, args, elt_describer, else if (CHAR_TABLE_P (vector)) { if (complete_char) - insert1 (Fsingle_key_description (make_number (character), Qnil)); + insert1 (Fkey_description (kludge, prefix)); 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); + insert_from_string (tem2, 0, 0, SCHARS (tem2), + SBYTES (tem2), 0); else insert ("?", 1); insert (">", 1); @@ -3265,7 +3681,7 @@ describe_vector (vector, elt_prefix, args, elt_describer, } else { - insert1 (Fsingle_key_description (make_number (character), Qnil)); + insert1 (Fkey_description (kludge, prefix)); } /* If we find a sub char-table within a char-table, @@ -3274,9 +3690,10 @@ describe_vector (vector, elt_prefix, args, elt_describer, if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition)) { insert ("\n", 1); - describe_vector (definition, elt_prefix, args, elt_describer, + describe_vector (definition, prefix, args, elt_describer, partial, shadow, entire_map, - indices, char_table_depth + 1); + indices, char_table_depth + 1, keymap_p, + mention_shadow); continue; } @@ -3305,7 +3722,7 @@ describe_vector (vector, elt_prefix, args, elt_describer, !NILP (tem2)) && !NILP (Fequal (tem2, definition))) i++; - + /* If we have a range of more than one character, print where the range reaches to. */ @@ -3314,6 +3731,8 @@ describe_vector (vector, elt_prefix, args, elt_describer, { insert (" .. ", 4); + ASET (kludge, 0, make_number (i)); + if (!NILP (elt_prefix)) insert1 (elt_prefix); @@ -3321,7 +3740,7 @@ describe_vector (vector, elt_prefix, args, elt_describer, { if (char_table_depth == 0) { - insert1 (Fsingle_key_description (make_number (i), Qnil)); + insert1 (Fkey_description (kludge, prefix)); } else if (complete_char) { @@ -3340,7 +3759,7 @@ describe_vector (vector, elt_prefix, args, elt_describer, } else { - insert1 (Fsingle_key_description (make_number (i), Qnil)); + insert1 (Fkey_description (kludge, prefix)); } } @@ -3348,6 +3767,13 @@ describe_vector (vector, elt_prefix, args, elt_describer, elt_describer will take care of spacing out far enough for alignment purposes. */ (*elt_describer) (definition, args); + + if (this_shadowed) + { + SET_PT (PT - 1); + insert_string (" (binding currently shadowed)"); + SET_PT (PT + 1); + } } /* For (sub) char-table, print `defalt' slot at last. */ @@ -3362,8 +3788,8 @@ describe_vector (vector, elt_prefix, args, elt_describer, } /* Apropos - finding all symbols whose names match a regexp. */ -Lisp_Object apropos_predicate; -Lisp_Object apropos_accumulate; +static Lisp_Object apropos_predicate; +static Lisp_Object apropos_accumulate; static void apropos_accum (symbol, string) @@ -3378,7 +3804,7 @@ apropos_accum (symbol, string) apropos_accumulate = Fcons (symbol, apropos_accumulate); } -DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0, +DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0, 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. @@ -3386,15 +3812,15 @@ Return list of symbols found. */) (regexp, predicate) Lisp_Object regexp, predicate; { - struct gcpro gcpro1, gcpro2; + Lisp_Object tem; CHECK_STRING (regexp); apropos_predicate = predicate; - GCPRO2 (apropos_predicate, apropos_accumulate); apropos_accumulate = Qnil; map_obarray (Vobarray, apropos_accum, regexp); - apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp); - UNGCPRO; - return apropos_accumulate; + tem = Fsort (apropos_accumulate, Qstring_lessp); + apropos_accumulate = Qnil; + apropos_predicate = Qnil; + return tem; } void @@ -3402,6 +3828,10 @@ syms_of_keymap () { Qkeymap = intern ("keymap"); staticpro (&Qkeymap); + staticpro (&apropos_predicate); + staticpro (&apropos_accumulate); + apropos_predicate = Qnil; + apropos_accumulate = Qnil; /* Now we are ready to set up this property, so we can create char tables. */ @@ -3455,12 +3885,27 @@ don't alter it yourself. */); Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil); Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map); + DEFVAR_LISP ("minibuffer-local-filename-completion-map", + &Vminibuffer_local_filename_completion_map, + doc: /* Local keymap for minibuffer input with completion for filenames. */); + Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil); + Fset_keymap_parent (Vminibuffer_local_filename_completion_map, + Vminibuffer_local_completion_map); + + DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map, 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 ("minibuffer-local-must-match-filename-map", + &Vminibuffer_local_must_match_filename_map, + doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */); + Vminibuffer_local_must_match_filename_map = Fmake_sparse_keymap (Qnil); + Fset_keymap_parent (Vminibuffer_local_must_match_filename_map, + Vminibuffer_local_must_match_map); + DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist, doc: /* Alist of keymaps to use for minor modes. Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read @@ -3471,15 +3916,25 @@ in the list takes precedence. */); DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist, 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 +This variable is an 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 ("emulation-mode-map-alists", &Vemulation_mode_map_alists, + doc: /* List of keymap alists to use for emulations modes. +It is intended for modes or packages using multiple minor-mode keymaps. +Each element is a keymap alist just like `minor-mode-map-alist', or a +symbol with a variable binding which is a keymap alist, and it is used +the same way. The "active" keymaps in each alist are used before +`minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */); + Vemulation_mode_map_alists = Qnil; + + DEFVAR_LISP ("function-key-map", &Vfunction_key_map, - 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. + doc: /* Keymap that translates key sequences to key sequences during input. +This is used mainly for mapping ASCII function key sequences into +real Emacs function key events (symbols). The `read-key-sequence' function replaces any subsequence bound by `function-key-map' with its binding. More precisely, when the active @@ -3488,6 +3943,9 @@ keymaps have no binding for the current key sequence but `read-key-sequence' replaces the matching suffix with its binding, and continues with the new sequence. +If the binding is a function, it is called with one argument (the prompt) +and its return value (a key sequence) is used. + The events that come from bindings in `function-key-map' are not themselves looked up in `function-key-map'. @@ -3500,9 +3958,22 @@ key, typing `ESC O P x' would return [f1 x]. */); DEFVAR_LISP ("key-translation-map", &Vkey_translation_map, 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. */); +and its non-prefix bindings override ordinary bindings. */); Vkey_translation_map = Qnil; + staticpro (&Vmouse_events); + Vmouse_events = Fcons (intern ("menu-bar"), + Fcons (intern ("tool-bar"), + Fcons (intern ("header-line"), + Fcons (intern ("mode-line"), + Fcons (intern ("mouse-1"), + Fcons (intern ("mouse-2"), + Fcons (intern ("mouse-3"), + Fcons (intern ("mouse-4"), + Fcons (intern ("mouse-5"), + Qnil))))))))); + + Qsingle_key_description = intern ("single-key-description"); staticpro (&Qsingle_key_description); @@ -3518,6 +3989,12 @@ and applies even for keys that have ordinary bindings. */); Qmenu_item = intern ("menu-item"); staticpro (&Qmenu_item); + Qremap = intern ("remap"); + staticpro (&Qremap); + + command_remapping_vector = Fmake_vector (make_number (2), Qremap); + staticpro (&command_remapping_vector); + where_is_cache_keymaps = Qt; where_is_cache = Qnil; staticpro (&where_is_cache); @@ -3529,7 +4006,9 @@ and applies even for keys that have ordinary bindings. */); defsubr (&Sset_keymap_parent); defsubr (&Smake_keymap); defsubr (&Smake_sparse_keymap); + defsubr (&Smap_keymap); defsubr (&Scopy_keymap); + defsubr (&Scommand_remapping); defsubr (&Skey_binding); defsubr (&Slocal_key_binding); defsubr (&Sglobal_key_binding); @@ -3559,3 +4038,6 @@ keys_of_keymap () initial_define_key (global_map, 033, "ESC-prefix"); initial_define_key (global_map, Ctl('X'), "Control-X-prefix"); } + +/* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463 + (do not change this comment) */