X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/2b6748c0ac9944fc6cbef6b31e6cc73ba0ee3a66..f2e45864d10657552bbc5cda8f10a5dcf1bfe511:/src/keymap.c diff --git a/src/keymap.c b/src/keymap.c index 50f27273c7..0e68c38d67 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1,5 +1,5 @@ /* Manipulation of keymaps - Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 2001 + Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 01, 2004 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -27,6 +27,7 @@ Boston, MA 02111-1307, USA. */ #include "buffer.h" #include "charset.h" #include "keyboard.h" +#include "frame.h" #include "termhooks.h" #include "blockinput.h" #include "puresize.h" @@ -55,7 +56,7 @@ Lisp_Object Vminibuffer_local_map; minibuf */ /* was MinibufLocalNSMap */ -Lisp_Object Vminibuffer_local_ns_map; +Lisp_Object Vminibuffer_local_ns_map; /* The keymap used by the minibuf for local bindings when spaces are not encouraged in the minibuf */ @@ -75,6 +76,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,7 +93,13 @@ 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 @@ -107,23 +117,28 @@ static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object)); -static void describe_command P_ ((Lisp_Object)); -static void describe_translation P_ ((Lisp_Object)); +static void describe_command P_ ((Lisp_Object, Lisp_Object)); +static void describe_translation P_ ((Lisp_Object, Lisp_Object)); static void describe_map P_ ((Lisp_Object, Lisp_Object, - void (*) P_ ((Lisp_Object)), + void (*) P_ ((Lisp_Object, Lisp_Object)), int, Lisp_Object, Lisp_Object*, 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)); +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, - "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\ -The optional arg STRING supplies a menu name for the keymap\n\ -in case you use it as a menu with `x-popup-menu'.") - (string) + doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST). +CHARTABLE is a char-table that holds the bindings for the ASCII +characters. ALIST is an assoc-list which holds bindings for function keys, +mouse events, and any other things that appear in the input stream. +All entries in it are initially nil, meaning "command undefined". + +The optional arg STRING supplies a menu name for the keymap +in case you use it as a menu with `x-popup-menu'. */) + (string) Lisp_Object string; { Lisp_Object tail; @@ -136,14 +151,15 @@ in case you use it as a menu with `x-popup-menu'.") } DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0, - "Construct and return a new sparse keymap.\n\ -Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\ -which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\ -which binds the function key or mouse event SYMBOL to DEFINITION.\n\ -Initially the alist is nil.\n\n\ -The optional arg STRING supplies a menu name for the keymap\n\ -in case you use it as a menu with `x-popup-menu'.") - (string) + doc: /* Construct and return a new sparse keymap. +Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION), +which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION), +which binds the function key or mouse event SYMBOL to DEFINITION. +Initially the alist is nil. + +The optional arg STRING supplies a menu name for the keymap +in case you use it as a menu with `x-popup-menu'. */) + (string) Lisp_Object string; { if (!NILP (string)) @@ -177,24 +193,24 @@ initial_define_lispy_key (keymap, keyname, defname) } DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0, - "Return t if OBJECT is a keymap.\n\ -\n\ -A keymap is a list (keymap . ALIST),\n\ -or a symbol whose function definition is itself a keymap.\n\ -ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\ -a vector of densely packed bindings for small character codes\n\ -is also allowed as an element.") - (object) + doc: /* Return t if OBJECT is a keymap. + +A keymap is a list (keymap . ALIST), +or a symbol whose function definition is itself a keymap. +ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN); +a vector of densely packed bindings for small character codes +is also allowed as an element. */) + (object) Lisp_Object object; { return (KEYMAPP (object) ? Qt : Qnil); } DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0, - "Return the prompt-string of a keymap MAP.\n\ -If non-nil, the prompt is shown in the echo-area\n\ -when reading a key-sequence to be looked-up in this keymap.") - (map) + doc: /* Return the prompt-string of a keymap MAP. +If non-nil, the prompt is shown in the echo-area +when reading a key-sequence to be looked-up in this keymap. */) + (map) Lisp_Object map; { while (CONSP (map)) @@ -261,11 +277,11 @@ get_keymap (object, error, autoload) if (autoload) { struct gcpro gcpro1, gcpro2; - + GCPRO2 (tem, object); do_autoload (tem, object); UNGCPRO; - + goto autoload_retry; } else @@ -280,17 +296,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, - "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); @@ -301,9 +317,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 @@ -312,20 +335,20 @@ 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)); } /* Set the parent keymap of MAP to PARENT. */ DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0, - "Modify KEYMAP to set its parent map to PARENT.\n\ -PARENT should be nil or another keymap.") - (keymap, parent) + doc: /* Modify KEYMAP to set its parent map to PARENT. +PARENT should be nil or another keymap. */) + (keymap, parent) Lisp_Object keymap, parent; { Lisp_Object list, prev; - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2; int i; /* Force a keymap flush for the next call to where-is. @@ -337,9 +360,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); @@ -363,7 +386,7 @@ PARENT should be nil or another keymap.") if (EQ (XCDR (prev), parent)) RETURN_UNGCPRO (parent); - XCDR (prev) = parent; + XSETCDR (prev, parent); break; } prev = list; @@ -393,7 +416,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); } } @@ -420,7 +444,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); @@ -440,7 +464,7 @@ fix_submap_inheritance (map, event, submap) { Lisp_Object tem; - tem = Fkeymap_parent (submap_parent); + tem = keymap_parent (submap_parent, 0); if (KEYMAPP (tem)) { @@ -458,11 +482,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. @@ -476,9 +500,11 @@ access_keymap (map, idx, t_ok, noinherit, autoload) int noinherit; int autoload; { - int noprefix = 0; Lisp_Object val; + /* Qunbound in VAL means we have found no binding yet. */ + val = Qunbound; + /* If idx is a list (some sort of mouse click, perhaps?), the index we want to use is the car of the list, which ought to be a symbol. */ @@ -498,10 +524,13 @@ 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); + meta_map = get_keymap (access_keymap (map, meta_prefix_char, + t_ok, noinherit, autoload), + 0, autoload); + UNGCPRO; if (CONSP (meta_map)) { map = meta_map; @@ -515,14 +544,21 @@ 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; - Lisp_Object generic_binding; + Lisp_Object t_binding = Qnil; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + + 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. + Otherwise, neither are. */ + t_ok = t_ok ? 2 : 0; - t_binding = Qnil; - generic_binding = Qnil; - for (tail = XCDR (map); (CONSP (tail) || (tail = get_keymap (tail, 0, autoload), CONSP (tail))); @@ -536,23 +572,16 @@ 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)) - noprefix = 1; + RETURN_UNGCPRO (Qnil); } else if (CONSP (binding)) { Lisp_Object key = XCAR (binding); - int c1, c2, charset; - + if (EQ (key, idx)) - { - val = XCDR (binding); - if (noprefix && KEYMAPP (val)) - return Qnil; - if (CONSP (val)) - fix_submap_inheritance (map, idx, val); - return get_keyelt (val, autoload); - } - else if (INTEGERP (idx) + val = XCDR (binding); + else if (t_ok + && INTEGERP (idx) && (XINT (idx) & CHAR_MODIFIER_MASK) == 0 && INTEGERP (key) && (XINT (key) & CHAR_MODIFIER_MASK) == 0 @@ -566,50 +595,152 @@ access_keymap (map, idx, t_ok, noinherit, autoload) /* KEY is the generic character of the charset of IDX. Use KEY's binding if there isn't a binding for IDX itself. */ - generic_binding = XCDR (binding); + t_binding = XCDR (binding); + t_ok = 0; + } + else if (t_ok > 1 && EQ (key, Qt)) + { + t_binding = XCDR (binding); + t_ok = 1; } - else if (t_ok && EQ (XCAR (binding), Qt)) - t_binding = XCDR (binding); } else if (VECTORP (binding)) { - if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (binding)->size) - { - val = XVECTOR (binding)->contents[XFASTINT (idx)]; - if (noprefix && KEYMAPP (val)) - return Qnil; - if (CONSP (val)) - fix_submap_inheritance (map, idx, val); - return get_keyelt (val, autoload); - } + if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding)) + val = AREF (binding, XFASTINT (idx)); } else if (CHAR_TABLE_P (binding)) { /* Character codes with modifiers are not included in a char-table. All character codes without modifiers are included. */ - if (NATNUMP (idx) - && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0) + if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0) { val = Faref (binding, idx); - if (noprefix && KEYMAPP (val)) - return Qnil; - if (CONSP (val)) - fix_submap_inheritance (map, idx, val); - return get_keyelt (val, autoload); + /* `nil' has a special meaning for char-tables, so + we use something else to record an explicitly + unbound entry. */ + if (NILP (val)) + val = Qunbound; } } + /* If we found a binding, clean it up and return it. */ + if (!EQ (val, Qunbound)) + { + if (EQ (val, Qt)) + /* A Qt binding is just like an explicit nil binding + (i.e. it shadows any parent binding but not bindings in + keymaps of lower precedence). */ + val = Qnil; + val = get_keyelt (val, autoload); + if (KEYMAPP (val)) + fix_submap_inheritance (map, idx, val); + RETURN_UNGCPRO (val); + } QUIT; } - - if (!NILP (generic_binding)) - return get_keyelt (generic_binding, autoload); - + 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; + + 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, 2, 0, + doc: /* Call FUNCTION for every binding in KEYMAP. +FUNCTION is called with two arguments: the event and its binding. */) + (function, keymap) + Lisp_Object function, keymap; +{ + if (INTEGERP (function)) + /* We have to stop integers early since map_keymap gives them special + significance. */ + Fsignal (Qinvalid_function, Fcons (function, Qnil)); + 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 @@ -624,7 +755,7 @@ access_keymap (map, idx, t_ok, noinherit, autoload) Lisp_Object get_keyelt (object, autoload) - register Lisp_Object object; + Lisp_Object object; int autoload; { while (1) @@ -666,7 +797,7 @@ get_keyelt (object, autoload) } } else - /* Invalid keymap */ + /* Invalid keymap. */ return object; } @@ -693,8 +824,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)); } @@ -766,12 +900,13 @@ store_in_keymap (keymap, idx, def) /* Character codes with modifiers are not included in a char-table. All character codes without modifiers are included. */ - if (NATNUMP (idx) - && ! (XFASTINT (idx) - & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER - | CHAR_SHIFT | CHAR_CTL | CHAR_META))) + if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK)) { - Faset (elt, idx, def); + Faset (elt, idx, + /* `nil' has a special meaning for char-tables, so + we use something else to record an explicitly + unbound entry. */ + NILP (def) ? Qt : def); return def; } insertion_point = tail; @@ -780,7 +915,7 @@ store_in_keymap (keymap, idx, def) { if (EQ (idx, XCAR (elt))) { - XCDR (elt) = def; + XSETCDR (elt, def); return def; } } @@ -797,139 +932,134 @@ 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. */ - XCDR (insertion_point) - = Fcons (Fcons (idx, def), XCDR (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, - "Return a copy of the keymap KEYMAP.\n\ -The copy starts out with the same definitions of KEYMAP,\n\ -but changing either the copy or KEYMAP does not affect the other.\n\ -Any key definitions that are subkeymaps are recursively copied.\n\ -However, a key definition which is a symbol whose definition is a keymap\n\ -is not copied.") - (keymap) + doc: /* Return a copy of the keymap KEYMAP. +The copy starts out with the same definitions of KEYMAP, +but changing either the copy or KEYMAP does not affect the other. +Any key definitions that are subkeymaps are recursively copied. +However, a key definition which is a symbol whose definition is a keymap +is not copied. */) + (keymap) Lisp_Object keymap; { - /* FIXME: This doesn't properly copy menu-items in vectors. */ - /* FIXME: This also copies the parent keymap. */ - register Lisp_Object copy, tail; + 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); - XCAR (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); - XCAR (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. */ - XCDR (elt) - = Fcons (XCAR (tem), XCDR (tem)); - elt = XCDR (elt); - tem = XCDR (elt); - if (CONSP (tem)) - { - /* Copy cell with menu-item name. */ - XCDR (elt) - = Fcons (XCAR (tem), XCDR (tem)); - elt = XCDR (elt); - tem = XCDR (elt); - }; - if (CONSP (tem)) - { - /* Copy cell with binding and if the binding is a keymap, - copy that. */ - XCDR (elt) - = Fcons (XCAR (tem), XCDR (tem)); - elt = XCDR (elt); - tem = XCAR (elt); - if (CONSP (tem) && EQ (XCAR (tem), Qkeymap)) - XCAR (elt) = Fcopy_keymap (tem); - tem = XCDR (elt); - if (CONSP (tem) && CONSP (XCAR (tem))) - /* Delete cache for key equivalences. */ - XCDR (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. */ - XCDR (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))) - { - XCDR (elt) - = Fcons (XCAR (tem), XCDR (tem)); - elt = XCDR (elt); - tem = XCDR (elt); - } - /* There may also be a list that caches key equivalences. - Just delete it for the new keymap. */ - if (CONSP (tem) - && CONSP (XCAR (tem)) - && (NILP (XCAR (XCAR (tem))) - || VECTORP (XCAR (XCAR (tem))))) - XCDR (elt) = XCDR (tem); - } - if (CONSP (elt) - && CONSP (XCDR (elt)) - && EQ (XCAR (XCDR (elt)), Qkeymap)) - XCDR (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; } @@ -938,26 +1068,31 @@ is not copied.") /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0, - "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\ -KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\ -meaning a sequence of keystrokes and events.\n\ -Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\ -can be included if you use a vector.\n\ -DEF is anything that can be a key's definition:\n\ - nil (means key is undefined in this keymap),\n\ - a command (a Lisp function suitable for interactive calling)\n\ - a string (treated as a keyboard macro),\n\ - a keymap (to define a prefix key),\n\ - a symbol. When the key is looked up, the symbol will stand for its\n\ - function definition, which should at that time be one of the above,\n\ - or another symbol whose function definition is used, etc.\n\ - a cons (STRING . DEFN), meaning that DEFN is the definition\n\ - (DEFN should be a valid definition in its own right),\n\ - or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\ -\n\ -If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\ -the front of KEYMAP.") - (keymap, key, def) + doc: /* 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 string (treated as a keyboard macro), + a keymap (to define a prefix key), + a symbol. When the key is looked up, the symbol will stand for its + function definition, which should at that time be one of the above, + or another symbol whose function definition is used, etc. + a cons (STRING . DEFN), meaning that DEFN is the definition + (DEFN should be a valid definition in its own right), + or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP. + +If KEYMAP is a sparse keymap 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; Lisp_Object def; @@ -970,6 +1105,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)) @@ -977,17 +1113,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) @@ -997,6 +1128,9 @@ the front of KEYMAP.") if (CONSP (c) && lucid_event_type_list_p (c)) c = Fevent_convert_list (c); + if (SYMBOLP (c)) + silly_event_symbol_error (c); + if (INTEGERP (c) && (XINT (c) & meta_bit) && !metized) @@ -1014,7 +1148,7 @@ the front of KEYMAP.") } if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c)) - error ("Key sequence contains invalid events"); + error ("Key sequence contains invalid event"); if (idx == length) RETURN_UNGCPRO (store_in_keymap (keymap, c, def)); @@ -1030,30 +1164,45 @@ the front of 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); + SDATA (Fkey_description (key, Qnil))); } } -/* Value is number if KEY is too long; NIL if valid but has no definition. */ +/* 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. */ DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, - "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\ -nil means undefined. See doc of `define-key' for kinds of definitions.\n\ -\n\ -A number as value means KEY is \"too long\";\n\ -that is, characters or symbols in it except for the last one\n\ -fail to be a valid sequence of prefix characters in KEYMAP.\n\ -The number is how many characters at the front of KEY\n\ -it takes to reach a non-prefix command.\n\ -\n\ -Normally, `lookup-key' ignores bindings for t, which act as default\n\ -bindings, used when nothing else in the keymap applies; this makes it\n\ -usable as a general function for probing keymaps. However, if the\n\ -third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\ -recognize the default bindings, just as `read-key-sequence' does.") - (keymap, key, accept_default) - register Lisp_Object keymap; + doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition. +nil means undefined. See doc of `define-key' for kinds of definitions. + +A number as value means KEY is "too long"; +that is, characters or symbols in it except for the last one +fail to be a valid sequence of prefix characters in KEYMAP. +The number is how many characters at the front of KEY +it takes to reach a non-prefix command. + +Normally, `lookup-key' ignores bindings for t, which act as default +bindings, used when nothing else in the keymap applies; this makes it +usable as a general function for probing keymaps. However, if the +third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will +recognize the default bindings, just as `read-key-sequence' does. */) + (keymap, key, accept_default) + Lisp_Object keymap; Lisp_Object key; Lisp_Object accept_default; { @@ -1062,8 +1211,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)) @@ -1071,9 +1221,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) @@ -1087,6 +1235,11 @@ recognize the default bindings, just as `read-key-sequence' does.") if (XINT (c) & 0x80 && STRINGP (key)) XSETINT (c, (XINT (c) | meta_modifier) & ~0x80); + /* 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); if (idx == length) RETURN_UNGCPRO (cmd); @@ -1133,14 +1286,60 @@ append_key (key_sequence, key) return Fvconcat (2, args); } +/* Given a event type C which is a symbol, + signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */ + +static void +silly_event_symbol_error (c) + Lisp_Object c; +{ + Lisp_Object parsed, base, name, assoc; + int modifiers; + + parsed = parse_modifiers (c); + modifiers = (int) XUINT (XCAR (XCDR (parsed))); + base = XCAR (parsed); + name = Fsymbol_name (base); + /* This alist includes elements such as ("RET" . "\\r"). */ + assoc = Fassoc (name, exclude_keys); + + if (! NILP (assoc)) + { + char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")]; + char *p = new_mods; + Lisp_Object keystring; + if (modifiers & alt_modifier) + { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; } + if (modifiers & ctrl_modifier) + { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; } + if (modifiers & hyper_modifier) + { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; } + if (modifiers & meta_modifier) + { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; } + if (modifiers & shift_modifier) + { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; } + if (modifiers & super_modifier) + { *p++ = '\\'; *p++ = 's'; *p++ = '-'; } + *p = 0; + + 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]"), + SDATA (SYMBOL_NAME (c)), SDATA (keystring), + SDATA (SYMBOL_NAME (c))); + } +} /* Global, local, and minor mode keymap stuff. */ /* 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; +static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL; +static int cmm_size = 0; /* Error handler used in current_minor_maps. */ static Lisp_Object @@ -1172,81 +1371,95 @@ 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)) + { + if (CONSP (emulation_alists)) { - Lisp_Object temp; + 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 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; - } + 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; - 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)) + continue; + } - /* 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 (i >= cmm_size) + { + int newsize, allocsize; + Lisp_Object *newmodes, *newmaps; - if (newmodes) - cmm_modes = newmodes; - if (newmaps) - cmm_maps = newmaps; - - if (newmodes == NULL || newmaps == NULL) - break; - } + newsize = cmm_size == 0 ? 30 : cmm_size * 2; + allocsize = newsize * sizeof *newmodes; - /* 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++; - } - } + /* 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 = 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++; + } + } + } if (modeptr) *modeptr = cmm_modes; if (mapptr) *mapptr = cmm_maps; @@ -1254,10 +1467,10 @@ current_minor_maps (modeptr, mapptr) } DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps, - 0, 1, 0, - "Return a list of the currently active keymaps.\n\ -OLP if non-nil indicates that we should obey `overriding-local-map' and\n\ -`overriding-terminal-local-map'.") + 0, 1, 0, + doc: /* Return a list of the currently active keymaps. +OLP if non-nil indicates that we should obey `overriding-local-map' and +`overriding-terminal-local-map'. */) (olp) Lisp_Object olp; { @@ -1280,34 +1493,39 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and\n\ if (!NILP (local)) keymaps = Fcons (local, keymaps); - local = get_local_map (PT, current_buffer, Qkeymap); - if (!NILP (local)) - keymaps = Fcons (local, keymaps); - nmaps = current_minor_maps (0, &maps); for (i = --nmaps; i >= 0; i--) if (!NILP (maps[i])) keymaps = Fcons (maps[i], keymaps); + + 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, - "Return the binding for command KEY in current keymaps.\n\ -KEY is a string or vector, a sequence of keystrokes.\n\ -The binding is probably a symbol with a function definition.\n\ -\n\ -Normally, `key-binding' ignores bindings for t, which act as default\n\ -bindings, used when nothing else in the keymap applies; this makes it\n\ -usable as a general function for probing keymaps. However, if the\n\ -optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\ -recognize the default bindings, just as `read-key-sequence' does.") - (key, accept_default) - Lisp_Object key, accept_default; +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. + +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. + +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; @@ -1320,18 +1538,26 @@ 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); + if (! NILP (local)) + { + value = Flookup_key (local, key, accept_default); + if (! NILP (value) && !INTEGERP (value)) + goto done; + } + nmaps = current_minor_maps (0, &maps); /* Note that all these maps are GCPRO'd in the places where we found them. */ @@ -1341,45 +1567,48 @@ 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, Qkeymap); - if (! NILP (local)) - { - value = Flookup_key (local, key, accept_default); - if (! NILP (value) && !INTEGERP (value)) - RETURN_UNGCPRO (value); - } - local = get_local_map (PT, current_buffer, Qlocal_map); - if (! NILP (local)) { 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, - "Return the binding for command KEYS in current local keymap only.\n\ -KEYS is a string, a sequence of keystrokes.\n\ -The binding is probably a symbol with a function definition.\n\ -\n\ -If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\ -bindings; see the description of `lookup-key' for more details about this.") - (keys, accept_default) + doc: /* Return the binding for command KEYS in current local keymap only. +KEYS is a string, a sequence of keystrokes. +The binding is probably a symbol with a function definition. + +If optional argument ACCEPT-DEFAULT is non-nil, recognize default +bindings; see the description of `lookup-key' for more details about this. */) + (keys, accept_default) Lisp_Object keys, accept_default; { register Lisp_Object map; @@ -1392,15 +1621,15 @@ bindings; see the description of `lookup-key' for more details about this.") /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0, - "Return the binding for command KEYS in current global keymap only.\n\ -KEYS is a string, a sequence of keystrokes.\n\ -The binding is probably a symbol with a function definition.\n\ -This function's return values are the same as those of lookup-key\n\ -\(which see).\n\ -\n\ -If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\ -bindings; see the description of `lookup-key' for more details about this.") - (keys, accept_default) + doc: /* Return the binding for command KEYS in current global keymap only. +KEYS is a string, a sequence of keystrokes. +The binding is probably a symbol with a function definition. +This function's return values are the same as those of lookup-key +\(which see). + +If optional argument ACCEPT-DEFAULT is non-nil, recognize default +bindings; see the description of `lookup-key' for more details about this. */) + (keys, accept_default) Lisp_Object keys, accept_default; { return Flookup_key (current_global_map, keys, accept_default); @@ -1409,18 +1638,18 @@ bindings; see the description of `lookup-key' for more details about this.") /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0, - "Find the visible minor mode bindings of KEY.\n\ -Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\ -the symbol which names the minor mode binding KEY, and BINDING is\n\ -KEY's definition in that mode. In particular, if KEY has no\n\ -minor-mode bindings, return nil. If the first binding is a\n\ -non-prefix, all subsequent bindings will be omitted, since they would\n\ -be ignored. Similarly, the list doesn't include non-prefix bindings\n\ -that come after prefix bindings.\n\ -\n\ -If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\ -bindings; see the description of `lookup-key' for more details about this.") - (key, accept_default) + doc: /* Find the visible minor mode bindings of KEY. +Return an alist of pairs (MODENAME . BINDING), where MODENAME is the +the symbol which names the minor mode binding KEY, and BINDING is +KEY's definition in that mode. In particular, if KEY has no +minor-mode bindings, return nil. If the first binding is a +non-prefix, all subsequent bindings will be omitted, since they would +be ignored. Similarly, the list doesn't include non-prefix bindings +that come after prefix bindings. + +If optional argument ACCEPT-DEFAULT is non-nil, recognize default +bindings; see the description of `lookup-key' for more details about this. */) + (key, accept_default) Lisp_Object key, accept_default; { Lisp_Object *modes, *maps; @@ -1452,14 +1681,14 @@ bindings; see the description of `lookup-key' for more details about this.") } 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.\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) + doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol. +A new sparse keymap is stored as COMMAND's function definition and its value. +If a second optional argument MAPVAR is given, the map is stored as +its value instead of as COMMAND's value; but COMMAND is still defined +as a function. +The third optional argument NAME, if given, supplies a menu name +string for the map. This is required to use the keymap as a menu. */) + (command, mapvar, name) Lisp_Object command, mapvar, name; { Lisp_Object map; @@ -1473,8 +1702,8 @@ string for the map. This is required to use the keymap as a menu.") } DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0, - "Select KEYMAP as the global keymap.") - (keymap) + doc: /* Select KEYMAP as the global keymap. */) + (keymap) Lisp_Object keymap; { keymap = get_keymap (keymap, 1, 1); @@ -1484,9 +1713,9 @@ DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0, } DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0, - "Select KEYMAP as the local keymap.\n\ -If KEYMAP is nil, that means no local keymap.") - (keymap) + doc: /* Select KEYMAP as the local keymap. +If KEYMAP is nil, that means no local keymap. */) + (keymap) Lisp_Object keymap; { if (!NILP (keymap)) @@ -1498,22 +1727,22 @@ If KEYMAP is nil, that means no local keymap.") } DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0, - "Return current buffer's local keymap, or nil if it has none.") - () + doc: /* Return current buffer's local keymap, or nil if it has none. */) + () { return current_buffer->keymap; } DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0, - "Return the current global keymap.") - () + doc: /* Return the current global keymap. */) + () { return current_global_map; } DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0, - "Return a list of keymaps for the minor modes of the current buffer.") - () + doc: /* Return a list of keymaps for the minor modes of the current buffer. */) + () { Lisp_Object *maps; int nmaps = current_minor_maps (0, &maps); @@ -1531,43 +1760,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. */ - XCDR (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)); } } @@ -1585,17 +1825,17 @@ accessible_keymaps_char_table (args, index, cmd) /* This function cannot GC. */ DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, - 1, 2, 0, - "Find all keymaps accessible via prefix characters from KEYMAP.\n\ -Returns a list of elements of the form (KEYS . MAP), where the sequence\n\ -KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\ -so that the KEYS increase in length. The first element is ([] . KEYMAP).\n\ -An optional argument PREFIX, if non-nil, should be a key sequence;\n\ -then the value includes only maps for prefixes that start with PREFIX.") - (keymap, prefix) + 1, 2, 0, + doc: /* Find all keymaps accessible via prefix characters from KEYMAP. +Returns a list of elements of the form (KEYS . MAP), where the sequence +KEYS starting from KEYMAP gets you to MAP. These elements are ordered +so that the KEYS increase in length. The first element is ([] . KEYMAP). +An optional argument PREFIX, if non-nil, should be a key sequence; +then the value includes only maps for prefixes that start with PREFIX. */) + (keymap, prefix) Lisp_Object keymap, prefix; { - Lisp_Object maps, good_maps, tail; + Lisp_Object maps, tail; int prefixlen = 0; /* no need for gcpro because we don't autoload any keymaps. */ @@ -1622,8 +1862,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; @@ -1678,7 +1918,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); @@ -1691,123 +1931,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, - "Return a pretty description of key-sequence KEYS.\n\ -Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\ -spaces are put between sequence elements, etc.") - (keys) - Lisp_Object keys; +DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0, + doc: /* Return a pretty description of key-sequence KEYS. +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, prefix) + Lisp_Object keys, prefix; { int len = 0; int i, i_byte; - Lisp_Object sep; - Lisp_Object *args = NULL; + Lisp_Object *args; + int size = Flength (keys); + Lisp_Object list; + Lisp_Object sep = build_string (" "); + Lisp_Object key; + int add_meta = 0; + + if (!NILP (prefix)) + size += 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)); - if (STRINGP (keys)) + /* In effect, this computes + (mapconcat 'single-key-description keys " ") + but we shouldn't use mapconcat because it can do GC. */ + + 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 = 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)) { - args[i * 2] = Fsingle_key_description (AREF (keys, i), Qnil); - args[i * 2 + 1] = sep; + 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)) + { + 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) + { + 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)) { - args[i * 2] = Fsingle_key_description (XCAR (keys), Qnil); - args[i * 2 + 1] = sep; - keys = XCDR (keys); + 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; @@ -1815,7 +2058,7 @@ push_key_description (c, p, force_multibyte) int force_multibyte; { unsigned c2; - + /* Clear all the meaningless bits above the meta bit. */ c &= meta_modifier | ~ - meta_modifier; c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier @@ -1909,7 +2152,7 @@ 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 (SINGLE_BYTE_CHAR_P (c)) @@ -1932,18 +2175,18 @@ push_key_description (c, p, force_multibyte) p += CHAR_STRING (c, p); } - return p; + return p; } /* This function cannot GC. */ DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 2, 0, - "Return a pretty description of command character KEY.\n\ -Control characters turn into C-whatever, etc.\n\ -Optional argument NO-ANGLES non-nil means don't put angle brackets\n\ -around function keys and event symbols.") - (key, no_angles) + doc: /* Return a pretty description of command character KEY. +Control characters turn into C-whatever, etc. +Optional argument NO-ANGLES non-nil means don't put angle brackets +around function keys and event symbols. */) + (key, no_angles) Lisp_Object key, no_angles; { if (CONSP (key) && lucid_event_type_list_p (key)) @@ -1969,7 +2212,7 @@ around function keys and event symbols.") /* Handle a generic character. */ Lisp_Object name; name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX); - CHECK_STRING (name, 0); + CHECK_STRING (name); return concat2 (build_string ("Character set "), name); } else @@ -1996,8 +2239,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 @@ -2033,22 +2276,22 @@ push_text_char_description (c, p) } else *p++ = c; - return p; + return p; } /* This function cannot GC. */ DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0, - "Return a pretty description of file-character CHARACTER.\n\ -Control characters turn into \"^char\", etc.") - (character) + doc: /* Return a pretty description of file-character CHARACTER. +Control characters turn into "^char", etc. */) + (character) Lisp_Object character; { /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */ unsigned char str[6]; int c; - CHECK_NUMBER (character, 0); + CHECK_NUMBER (character); c = XINT (character); if (!SINGLE_BYTE_CHAR_P (c)) @@ -2090,6 +2333,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 (); @@ -2111,12 +2355,14 @@ shadow_lookup (shadow, key, flag) 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; @@ -2124,6 +2370,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)) { @@ -2132,7 +2387,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; @@ -2140,7 +2395,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 @@ -2156,12 +2411,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)) @@ -2210,7 +2466,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)); } @@ -2229,11 +2485,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. @@ -2247,6 +2528,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect) if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition)) continue; + record_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))) @@ -2260,6 +2542,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; + } } } } @@ -2273,29 +2562,33 @@ 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, - "Return list of keys that invoke DEFINITION.\n\ -If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\ -If KEYMAP is nil, search all the currently active keymaps.\n\ -If KEYMAP is a list of keymaps, search only those keymaps.\n\ -\n\ -If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\ -rather than a list of all possible key sequences.\n\ -If FIRSTONLY is the symbol `non-ascii', return the first binding found,\n\ -no matter what it is.\n\ -If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,\n\ -and entirely reject menu bindings.\n\ -\n\ -If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\ -to other keymaps or slots. This makes it possible to search for an\n\ -indirect definition itself.") - (definition, keymap, firstonly, noindirect) +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 nil, search all the currently active keymaps. +If KEYMAP is a list of keymaps, search only those keymaps. + +If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found, +rather than a list of all possible key sequences. +If FIRSTONLY is the symbol `non-ascii', return the first binding found, +no matter what it is. +If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters, +and entirely reject menu bindings. + +If optional 4th arg NOINDIRECT is non-nil, don't follow indirections +to other keymaps or slots. This makes it possible to search for an +indirect definition itself. + +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. */ @@ -2316,8 +2609,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; @@ -2328,10 +2621,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; @@ -2345,7 +2638,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); @@ -2368,7 +2661,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; @@ -2407,7 +2700,7 @@ where_is_internal_2 (args, key, binding) this, last, nomenus, last_is_meta); if (!NILP (sequence)) - XCDR (XCAR (args)) = Fcons (sequence, result); + XSETCDR (XCAR (args), Fcons (sequence, result)); UNGCPRO; } @@ -2458,14 +2751,14 @@ where_is_internal_1 (binding, key, definition, noindirect, this, last, /* describe-bindings - summarizing all the bindings in a set of keymaps. */ DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0, - "Insert the list of all defined keys and their definitions.\n\ -The list is inserted in the current buffer, while the bindings are\n\ -looked up in BUFFER.\n\ -The optional argument PREFIX, if non-nil, should be a key sequence;\n\ -then we display only bindings that start with that prefix.\n\ -The optional argument MENUS, if non-nil, says to mention menu bindings.\n\ -\(Ordinarily these are omitted from the output.)") - (buffer, prefix, menus) + doc: /* Insert the list of all defined keys and their definitions. +The list is inserted in the current buffer, while the bindings are +looked up in BUFFER. +The optional argument PREFIX, if non-nil, should be a key sequence; +then we display only bindings that start with that prefix. +The optional argument MENUS, if non-nil, says to mention menu bindings. +\(Ordinarily these are omitted from the output.) */) + (buffer, prefix, menus) Lisp_Object buffer, prefix, menus; { Lisp_Object outbuf, shadow; @@ -2482,14 +2775,14 @@ You type Translation\n\ shadow = Qnil; GCPRO1 (shadow); - outbuf = Fcurrent_buffer(); + outbuf = Fcurrent_buffer (); /* Report on alternates for keys. */ 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) @@ -2519,64 +2812,85 @@ You type Translation\n\ describe_map_tree (Vkey_translation_map, 0, Qnil, prefix, "Key translations", nomenu, 1, 0); - { - int i, nmaps; - Lisp_Object *modes, *maps; - - /* Temporarily switch to `buffer', so that we can get that buffer's - minor modes correctly. */ - Fset_buffer (buffer); - - if (!NILP (current_kboard->Voverriding_terminal_local_map) - || !NILP (Voverriding_local_map)) - nmaps = 0; - else - nmaps = current_minor_maps (&modes, &maps); - Fset_buffer (outbuf); - - /* Print the minor mode maps. */ - for (i = 0; i < nmaps; i++) - { - /* The title for a minor mode keymap - is constructed at run time. - We let describe_map_tree do the actual insertion - because it takes care of other features when doing so. */ - char *title, *p; - - if (!SYMBOLP (modes[i])) - abort(); - - p = title = (char *) alloca (42 + XSYMBOL (modes[i])->name->size); - *p++ = '\f'; - *p++ = '\n'; - *p++ = '`'; - bcopy (XSYMBOL (modes[i])->name->data, p, - XSYMBOL (modes[i])->name->size); - p += XSYMBOL (modes[i])->name->size; - *p++ = '\''; - bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1); - p += sizeof (" Minor Mode Bindings") - 1; - *p = 0; - - describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0); - shadow = Fcons (maps[i], shadow); - } - } /* Print the (major mode) local map. */ + start1 = Qnil; if (!NILP (current_kboard->Voverriding_terminal_local_map)) start1 = current_kboard->Voverriding_terminal_local_map; else if (!NILP (Voverriding_local_map)) start1 = Voverriding_local_map; - else - start1 = XBUFFER (buffer)->keymap; if (!NILP (start1)) { describe_map_tree (start1, 1, shadow, prefix, - "\f\nMajor Mode Bindings", nomenu, 0, 0); + "\f\nOverriding Bindings", nomenu, 0, 0); shadow = Fcons (start1, shadow); } + else + { + /* Print the minor mode and major mode keymaps. */ + int i, nmaps; + Lisp_Object *modes, *maps; + + /* Temporarily switch to `buffer', so that we can get that buffer's + minor modes correctly. */ + Fset_buffer (buffer); + + nmaps = current_minor_maps (&modes, &maps); + Fset_buffer (outbuf); + + start1 = get_local_map (BUF_PT (XBUFFER (buffer)), + XBUFFER (buffer), Qkeymap); + if (!NILP (start1)) + { + describe_map_tree (start1, 1, shadow, prefix, + "\f\n`keymap' Property Bindings", nomenu, 0, 0); + shadow = Fcons (start1, shadow); + } + + /* Print the minor mode maps. */ + for (i = 0; i < nmaps; i++) + { + /* The title for a minor mode keymap + is constructed at run time. + We let describe_map_tree do the actual insertion + because it takes care of other features when doing so. */ + char *title, *p; + + if (!SYMBOLP (modes[i])) + abort(); + + p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i]))); + *p++ = '\f'; + *p++ = '\n'; + *p++ = '`'; + 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); + shadow = Fcons (maps[i], shadow); + } + + start1 = get_local_map (BUF_PT (XBUFFER (buffer)), + XBUFFER (buffer), Qlocal_map); + if (!NILP (start1)) + { + if (EQ (start1, XBUFFER (buffer)->keymap)) + describe_map_tree (start1, 1, shadow, prefix, + "\f\nMajor Mode Bindings", nomenu, 0, 0); + else + describe_map_tree (start1, 1, shadow, prefix, + "\f\n`local-map' Property Bindings", + nomenu, 0, 0); + + shadow = Fcons (start1, shadow); + } + } describe_map_tree (current_global_map, 1, shadow, prefix, "\f\nGlobal Bindings", nomenu, 0, 1); @@ -2658,7 +2972,7 @@ key binding\n\ if (!NILP (prefix)) { insert_string (" Starting With "); - insert1 (Fkey_description (prefix)); + insert1 (Fkey_description (prefix, Qnil)); } insert_string (":\n"); } @@ -2683,7 +2997,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 @@ -2731,11 +3045,11 @@ key binding\n\ static int previous_description_column; static void -describe_command (definition) - Lisp_Object definition; +describe_command (definition, args) + Lisp_Object definition, args; { register Lisp_Object tem1; - int column = current_column (); + int column = (int) current_column (); /* iftc */ int description_column; /* If column 16 is no good, go to col 32; @@ -2755,7 +3069,7 @@ describe_command (definition) if (SYMBOLP (definition)) { - XSETSTRING (tem1, XSYMBOL (definition)->name); + tem1 = SYMBOL_NAME (definition); insert1 (tem1); insert_string ("\n"); } @@ -2768,8 +3082,8 @@ describe_command (definition) } static void -describe_translation (definition) - Lisp_Object definition; +describe_translation (definition, args) + Lisp_Object definition, args; { register Lisp_Object tem1; @@ -2777,13 +3091,13 @@ describe_translation (definition) 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)) @@ -2793,20 +3107,19 @@ describe_translation (definition) } /* Describe the contents of map MAP, assuming that this map itself is - reached by the sequence of prefix keys KEYS (a string or vector). + 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) register Lisp_Object map; - Lisp_Object keys; - void (*elt_describer) P_ ((Lisp_Object)); + Lisp_Object prefix; + void (*elt_describer) P_ ((Lisp_Object, Lisp_Object)); int partial; Lisp_Object shadow; Lisp_Object *seen; int nomenu; { - Lisp_Object elt_prefix; Lisp_Object tail, definition, event; Lisp_Object tem; Lisp_Object suppress; @@ -2816,15 +3129,6 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) suppress = Qnil; - if (!NILP (keys) && XFASTINT (Flength (keys)) > 0) - { - /* Call Fkey_description first, to avoid GC bug for the other string. */ - tem = Fkey_description (keys); - elt_prefix = concat2 (tem, build_string (" ")); - } - else - elt_prefix = Qnil; - if (partial) suppress = intern ("suppress-keymap"); @@ -2834,7 +3138,7 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) kludge = Fmake_vector (make_number (1), Qnil); definition = Qnil; - GCPRO3 (elt_prefix, definition, kludge); + GCPRO3 (prefix, definition, kludge); for (tail = map; CONSP (tail); tail = XCDR (tail)) { @@ -2843,13 +3147,13 @@ 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, elt_describer, partial, shadow, map, - (int *)0, 0); + prefix, Qnil, elt_describer, partial, shadow, map, + (int *)0, 0, 1); else if (CONSP (XCAR (tail))) { 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; @@ -2888,16 +3192,13 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) first = 0; } - if (!NILP (elt_prefix)) - insert1 (elt_prefix); - /* THIS gets the string to describe the character EVENT. */ - insert1 (Fsingle_key_description (event, Qnil)); + 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) (definition); + (*elt_describer) (definition, Qnil); } else if (EQ (XCAR (tail), Qkeymap)) { @@ -2905,9 +3206,9 @@ 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); } } @@ -2915,26 +3216,27 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) } static void -describe_vector_princ (elt) - Lisp_Object elt; +describe_vector_princ (elt, fun) + Lisp_Object elt, fun; { Findent_to (make_number (16), make_number (1)); - Fprinc (elt, Qnil); + call1 (fun, elt); Fterpri (Qnil); } -DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0, - "Insert a description of contents of VECTOR.\n\ -This is text showing the elements of vector matched against indices.") - (vector) - Lisp_Object vector; +DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0, + doc: /* Insert a description of contents of VECTOR. +This is text showing the elements of vector matched against indices. */) + (vector, describer) + Lisp_Object vector, describer; { - int count = specpdl_ptr - specpdl; - + int count = SPECPDL_INDEX (); + if (NILP (describer)) + describer = intern ("princ"); specbind (Qstandard_output, Fcurrent_buffer ()); - CHECK_VECTOR_OR_CHAR_TABLE (vector, 0); - describe_vector (vector, Qnil, describe_vector_princ, 0, - Qnil, Qnil, (int *)0, 0); + CHECK_VECTOR_OR_CHAR_TABLE (vector); + describe_vector (vector, Qnil, describer, describe_vector_princ, 0, + Qnil, Qnil, (int *)0, 0, 0); return unbind_to (count, Qnil); } @@ -2967,28 +3269,34 @@ This is text showing the elements of vector matched against indices.") When describing a sub-char-table, INDICES is a list of indices at higher levels in this char-table, - and CHAR_TABLE_DEPTH says how many levels down we have gone. */ + and CHAR_TABLE_DEPTH says how many levels down we have gone. -void -describe_vector (vector, elt_prefix, elt_describer, + 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. */ + +static void +describe_vector (vector, prefix, args, elt_describer, partial, shadow, entire_map, - indices, char_table_depth) + indices, char_table_depth, keymap_p) register Lisp_Object vector; - Lisp_Object elt_prefix; - void (*elt_describer) P_ ((Lisp_Object)); + 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; { 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 @@ -3004,11 +3312,23 @@ describe_vector (vector, elt_prefix, 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"); @@ -3068,7 +3388,7 @@ describe_vector (vector, elt_prefix, elt_describer, else definition = get_keyelt (AREF (vector, i), 0); - if (NILP (definition)) continue; + if (NILP (definition)) continue; /* Don't mention suppressed commands. */ if (SYMBOLP (definition) && partial) @@ -3101,12 +3421,13 @@ describe_vector (vector, elt_prefix, 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; @@ -3118,7 +3439,6 @@ describe_vector (vector, elt_prefix, elt_describer, { Lisp_Object tem; - ASET (kludge, 0, make_number (character)); tem = Flookup_key (entire_map, kludge, Qt); if (!EQ (tem, definition)) @@ -3159,15 +3479,15 @@ describe_vector (vector, elt_prefix, 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); @@ -3175,7 +3495,7 @@ describe_vector (vector, elt_prefix, 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, @@ -3184,9 +3504,9 @@ describe_vector (vector, elt_prefix, elt_describer, if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition)) { insert ("\n", 1); - describe_vector (definition, elt_prefix, elt_describer, + describe_vector (definition, prefix, args, elt_describer, partial, shadow, entire_map, - indices, char_table_depth + 1); + indices, char_table_depth + 1, keymap_p); continue; } @@ -3215,7 +3535,7 @@ describe_vector (vector, elt_prefix, 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. */ @@ -3224,6 +3544,8 @@ describe_vector (vector, elt_prefix, elt_describer, { insert (" .. ", 4); + ASET (kludge, 0, make_number (i)); + if (!NILP (elt_prefix)) insert1 (elt_prefix); @@ -3231,7 +3553,7 @@ describe_vector (vector, elt_prefix, elt_describer, { if (char_table_depth == 0) { - insert1 (Fsingle_key_description (make_number (i), Qnil)); + insert1 (Fkey_description (kludge, prefix)); } else if (complete_char) { @@ -3250,14 +3572,14 @@ describe_vector (vector, elt_prefix, elt_describer, } else { - insert1 (Fsingle_key_description (make_number (i), Qnil)); + 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) (definition); + (*elt_describer) (definition, args); } /* For (sub) char-table, print `defalt' slot at last. */ @@ -3265,15 +3587,15 @@ describe_vector (vector, elt_prefix, elt_describer, { insert (" ", char_table_depth * 2); insert_string ("<>"); - (*elt_describer) (XCHAR_TABLE (vector)->defalt); + (*elt_describer) (XCHAR_TABLE (vector)->defalt, args); } UNGCPRO; } /* 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) @@ -3288,23 +3610,23 @@ apropos_accum (symbol, string) apropos_accumulate = Fcons (symbol, apropos_accumulate); } -DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0, - "Show all symbols whose names contain match for REGEXP.\n\ -If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\ -for each symbol and a symbol is mentioned only if that returns non-nil.\n\ -Return list of symbols found.") - (regexp, predicate) +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. +Return list of symbols found. */) + (regexp, predicate) Lisp_Object regexp, predicate; { - struct gcpro gcpro1, gcpro2; - CHECK_STRING (regexp, 0); + 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 @@ -3312,6 +3634,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. */ @@ -3336,74 +3662,106 @@ syms_of_keymap () Fset (intern ("ctl-x-map"), control_x_map); Ffset (intern ("Control-X-prefix"), control_x_map); + exclude_keys + = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")), + Fcons (Fcons (build_string ("TAB"), build_string ("\\t")), + Fcons (Fcons (build_string ("RET"), build_string ("\\r")), + Fcons (Fcons (build_string ("ESC"), build_string ("\\e")), + Fcons (Fcons (build_string ("SPC"), build_string (" ")), + Qnil))))); + staticpro (&exclude_keys); + DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands, - "List of commands given new key bindings recently.\n\ -This is used for internal purposes during Emacs startup;\n\ -don't alter it yourself."); + doc: /* List of commands given new key bindings recently. +This is used for internal purposes during Emacs startup; +don't alter it yourself. */); Vdefine_key_rebound_commands = Qt; DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map, - "Default keymap to use when reading from the minibuffer."); + doc: /* Default keymap to use when reading from the minibuffer. */); Vminibuffer_local_map = Fmake_sparse_keymap (Qnil); DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map, - "Local keymap for the minibuffer when spaces are not allowed."); + doc: /* Local keymap for the minibuffer when spaces are not allowed. */); Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil); Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map); DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map, - "Local keymap for minibuffer input with completion."); + doc: /* Local keymap for minibuffer input with completion. */); Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil); Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map); DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map, - "Local keymap for minibuffer input with completion, for exact match."); + doc: /* Local keymap for minibuffer input with completion, for exact match. */); Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil); Fset_keymap_parent (Vminibuffer_local_must_match_map, Vminibuffer_local_completion_map); DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist, - "Alist of keymaps to use for minor modes.\n\ -Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\ -key sequences and look up bindings iff VARIABLE's value is non-nil.\n\ -If two active keymaps bind the same key, the keymap appearing earlier\n\ -in the list takes precedence."); + doc: /* Alist of keymaps to use for minor modes. +Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read +key sequences and look up bindings iff VARIABLE's value is non-nil. +If two active keymaps bind the same key, the keymap appearing earlier +in the list takes precedence. */); Vminor_mode_map_alist = Qnil; DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist, - "Alist of keymaps to use for minor modes, in current major mode.\n\ -This variable is a alist just like `minor-mode-map-alist', and it is\n\ -used the same way (and before `minor-mode-map-alist'); however,\n\ -it is provided for major modes to bind locally."); + doc: /* Alist of keymaps to use for minor modes, in current major mode. +This variable is 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, - "Keymap mapping ASCII function key sequences onto their preferred forms.\n\ -This allows Emacs to recognize function keys sent from ASCII\n\ -terminals at any point in a key sequence.\n\ -\n\ -The `read-key-sequence' function replaces any subsequence bound by\n\ -`function-key-map' with its binding. More precisely, when the active\n\ -keymaps have no binding for the current key sequence but\n\ -`function-key-map' binds a suffix of the sequence to a vector or string,\n\ -`read-key-sequence' replaces the matching suffix with its binding, and\n\ -continues with the new sequence.\n\ -\n\ -The events that come from bindings in `function-key-map' are not\n\ -themselves looked up in `function-key-map'.\n\ -\n\ -For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\ -Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\ -`C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\ -key, typing `ESC O P x' would return [f1 x]."); + doc: /* Keymap mapping ASCII function key sequences onto their preferred forms. +This allows Emacs to recognize function keys sent from ASCII +terminals at any point in a key sequence. + +The `read-key-sequence' function replaces any subsequence bound by +`function-key-map' with its binding. More precisely, when the active +keymaps have no binding for the current key sequence but +`function-key-map' binds a suffix of the sequence to a vector or string, +`read-key-sequence' replaces the matching suffix with its binding, and +continues with the new sequence. + +The events that come from bindings in `function-key-map' are not +themselves looked up in `function-key-map'. + +For example, suppose `function-key-map' binds `ESC O P' to [f1]. +Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing +`C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix +key, typing `ESC O P x' would return [f1 x]. */); Vfunction_key_map = Fmake_sparse_keymap (Qnil); DEFVAR_LISP ("key-translation-map", &Vkey_translation_map, - "Keymap of key translations that can override keymaps.\n\ -This keymap works like `function-key-map', but comes after that,\n\ -and applies even for keys that have ordinary bindings."); + doc: /* Keymap of key translations that can override keymaps. +This keymap works like `function-key-map', but comes after that, +and applies even for keys that have ordinary bindings. */); Vkey_translation_map = Qnil; + 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); @@ -3419,6 +3777,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); @@ -3430,7 +3794,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); @@ -3460,3 +3826,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) */