X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c85d524cf71baa606ac7f08cda970c8a2132708b..36ad23ecb54ed700756a4ebbe95f4e3fe01ae244:/src/keymap.c diff --git a/src/keymap.c b/src/keymap.c index 775125d6f2..ba31430108 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1,6 +1,6 @@ /* Manipulation of keymaps - Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 2001 - Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1998, 1999, 2000, + 2001, 2004, 2005 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -97,8 +97,8 @@ 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 Fremap_command to use. */ -static Lisp_Object remap_command_vector; +/* 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 @@ -120,17 +120,22 @@ static void describe_command P_ ((Lisp_Object, Lisp_Object)); static void describe_translation P_ ((Lisp_Object, Lisp_Object)); static void describe_map P_ ((Lisp_Object, Lisp_Object, void (*) P_ ((Lisp_Object, Lisp_Object)), - int, Lisp_Object, Lisp_Object*, int)); + int, Lisp_Object, Lisp_Object*, int, int)); +static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object, + void (*) (Lisp_Object, Lisp_Object), int, + Lisp_Object, Lisp_Object, int *, + int, int, int)); static void silly_event_symbol_error P_ ((Lisp_Object)); /* Keymap object support - constructors and predicates. */ DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0, doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST). -CHARTABLE is a char-table that holds the bindings for the ASCII -characters. ALIST is an assoc-list which holds bindings for function keys, -mouse events, and any other things that appear in the input stream. -All entries in it are initially nil, meaning "command undefined". +CHARTABLE is a char-table that holds the bindings for all characters +without modifiers. All entries in it are initially nil, meaning +"command undefined". ALIST is an assoc-list which holds bindings for +function keys, mouse events, and any other things that appear in the +input stream. Initially, ALIST is nil. The optional arg STRING supplies a menu name for the keymap in case you use it as a menu with `x-popup-menu'. */) @@ -209,13 +214,13 @@ when reading a key-sequence to be looked-up in this keymap. */) (map) Lisp_Object map; { + map = get_keymap (map, 0, 0); while (CONSP (map)) { - register Lisp_Object tem; - tem = Fcar (map); + Lisp_Object tem = XCAR (map); if (STRINGP (tem)) return tem; - map = Fcdr (map); + map = XCDR (map); } return Qnil; } @@ -263,7 +268,8 @@ get_keymap (object, error, autoload) /* Should we do an autoload? Autoload forms for keymaps have Qkeymap as their fifth element. */ - if ((autoload || !error) && EQ (XCAR (tem), Qautoload)) + if ((autoload || !error) && EQ (XCAR (tem), Qautoload) + && SYMBOLP (object)) { Lisp_Object tail; @@ -339,7 +345,7 @@ keymap_memberp (map, maps) DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0, doc: /* Modify KEYMAP to set its parent map to PARENT. -PARENT should be nil or another keymap. */) +Return PARENT. PARENT should be nil or another keymap. */) (keymap, parent) Lisp_Object keymap, parent; { @@ -412,7 +418,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); } } @@ -477,11 +484,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. @@ -522,6 +529,10 @@ access_keymap (map, idx, t_ok, noinherit, autoload) struct gcpro gcpro1; Lisp_Object meta_map; GCPRO1 (map); + /* A strange value in which Meta is set would cause + infinite recursion. Protect against that. */ + if (XINT (meta_prefix_char) & CHAR_META) + meta_prefix_char = make_number (27); meta_map = get_keymap (access_keymap (map, meta_prefix_char, t_ok, noinherit, autoload), 0, autoload); @@ -572,7 +583,7 @@ access_keymap (map, idx, t_ok, noinherit, autoload) else if (CONSP (binding)) { Lisp_Object key = XCAR (binding); - + if (EQ (key, idx)) val = XCDR (binding); else if (t_ok @@ -640,6 +651,109 @@ access_keymap (map, idx, t_ok, noinherit, 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, 3, 0, + doc: /* Call FUNCTION for every binding in KEYMAP. +FUNCTION is called with two arguments: the event and its binding. +If KEYMAP has a parent, the parent's bindings are included as well. +This works recursively: if the parent has itself a parent, then the +grandparent's bindings are also included and so on. +usage: (map-keymap FUNCTION KEYMAP) */) + (function, keymap, sort_first) + Lisp_Object function, keymap, sort_first; +{ + if (INTEGERP (function)) + /* We have to stop integers early since map_keymap gives them special + significance. */ + Fsignal (Qinvalid_function, Fcons (function, Qnil)); + if (! NILP (sort_first)) + return call3 (intern ("map-keymap-internal"), function, keymap, Qt); + + map_keymap (keymap, map_keymap_call, function, NULL, 1); + return Qnil; +} + /* Given OBJECT which was found in a slot in a keymap, trace indirect definitions to get the actual definition of that slot. An indirect definition is a list of the form @@ -650,7 +764,9 @@ access_keymap (map, idx, t_ok, noinherit, autoload) remove that. Also remove a menu help string as second element. If AUTOLOAD is nonzero, load autoloadable keymaps - that are referred to with indirection. */ + that are referred to with indirection. + + This can GC because menu_item_eval_property calls Feval. */ Lisp_Object get_keyelt (object, autoload) @@ -914,7 +1030,7 @@ copy_keymap_item (elt) return res; } -void +static void copy_keymap_1 (chartable, idx, elt) Lisp_Object chartable, idx, elt; { @@ -943,7 +1059,7 @@ is not copied. */) { Lisp_Object indices[3]; elt = Fcopy_sequence (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)) { @@ -967,27 +1083,30 @@ is not copied. */) /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0, - doc: /* Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF. + doc: /* In KEYMAP, define key sequence KEY as DEF. KEYMAP is a keymap. KEY is a string or a vector of symbols and characters meaning a sequence of keystrokes and events. Non-ASCII characters with codes above 127 (such as ISO Latin-1) can be included if you use a vector. +Using [t] for KEY creates a default definition, which applies to any +event type that has no other definition in this keymap. DEF is anything that can be a key's definition: nil (means key is undefined in this keymap), - a command (a Lisp function suitable for interactive calling) + a command (a Lisp function suitable for interactive calling), a string (treated as a keyboard macro), a keymap (to define a prefix key), - a symbol. When the key is looked up, the symbol will stand for its + a symbol (when the key is looked up, the symbol will stand for its function definition, which should at that time be one of the above, - or another symbol whose function definition is used, etc. + or another symbol whose function definition is used, etc.), a cons (STRING . DEFN), meaning that DEFN is the definition (DEFN should be a valid definition in its own right), - or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP. + or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP. -If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at -the front of KEYMAP. */) +If KEYMAP is a sparse keymap with a binding for KEY, the existing +binding is altered. If there is no binding for KEY, the new pair +binding KEY to DEF is added at the front of KEYMAP. */) (keymap, key, def) Lisp_Object keymap; Lisp_Object key; @@ -1060,20 +1179,23 @@ 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))); } } /* This function may GC (it calls Fkey_binding). */ -DEFUN ("remap-command", Fremap_command, Sremap_command, 1, 1, 0, +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. */) +Returns nil if COMMAND is not remapped (or not a symbol). */) (command) Lisp_Object command; { - ASET (remap_command_vector, 1, command); - return Fkey_binding (remap_command_vector, Qnil, Qt); + 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. */ @@ -1125,7 +1247,7 @@ recognize the default bindings, just as `read-key-sequence' does. */) c = Fevent_convert_list (c); /* Turn the 8th bit of string chars into a meta modifier. */ - if (XINT (c) & 0x80 && STRINGP (key)) + if (INTEGERP (c) && XINT (c) & 0x80 && STRINGP (key)) XSETINT (c, (XINT (c) | meta_modifier) & ~0x80); /* Allow string since binding for `menu-bar-select-buffer' @@ -1188,7 +1310,7 @@ silly_event_symbol_error (c) { Lisp_Object parsed, base, name, assoc; int modifiers; - + parsed = parse_modifiers (c); modifiers = (int) XUINT (XCAR (XCDR (parsed))); base = XCAR (parsed); @@ -1217,12 +1339,12 @@ silly_event_symbol_error (c) c = reorder_modifiers (c); keystring = concat2 (build_string (new_mods), XCDR (assoc)); - + error ((modifiers & ~meta_modifier ? "To bind the key %s, use [?%s], not [%s]" : "To bind the key %s, use \"%s\", not [%s]"), - XSTRING (SYMBOL_NAME (c))->data, XSTRING (keystring)->data, - XSTRING (SYMBOL_NAME (c))->data); + SDATA (SYMBOL_NAME (c)), SDATA (keystring), + SDATA (SYMBOL_NAME (c))); } } @@ -1310,7 +1432,7 @@ current_minor_maps (modeptr, mapptr) newsize = cmm_size == 0 ? 30 : cmm_size * 2; allocsize = newsize * sizeof *newmodes; - /* Use malloc here. See the comment above this function. + /* 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); @@ -1335,7 +1457,7 @@ current_minor_maps (modeptr, mapptr) cmm_maps = newmaps; } UNBLOCK_INPUT; - + if (newmodes == NULL || newmaps == NULL) break; cmm_size = newsize; @@ -1371,10 +1493,13 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and if (!NILP (olp)) { - if (!NILP (Voverriding_local_map)) - keymaps = Fcons (Voverriding_local_map, keymaps); if (!NILP (current_kboard->Voverriding_terminal_local_map)) keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps); + /* The doc said that overriding-terminal-local-map should + override overriding-local-map. The code used them both, + but it seems clearer to use just one. rms, jan 2005. */ + else if (!NILP (Voverriding_local_map)) + keymaps = Fcons (Voverriding_local_map, keymaps); } if (NILP (XCDR (keymaps))) { @@ -1382,16 +1507,20 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and Lisp_Object *maps; int nmaps, i; + /* This usually returns the buffer's local map, + but that can be overridden by a `local-map' property. */ local = get_local_map (PT, current_buffer, Qlocal_map); if (!NILP (local)) keymaps = Fcons (local, keymaps); + /* Now put all the minor mode keymaps on the list. */ nmaps = current_minor_maps (0, &maps); for (i = --nmaps; i >= 0; i--) if (!NILP (maps[i])) keymaps = Fcons (maps[i], keymaps); + /* This returns nil unless there is a `keymap' property. */ local = get_local_map (PT, current_buffer, Qkeymap); if (!NILP (local)) keymaps = Fcons (local, keymaps); @@ -1415,7 +1544,7 @@ 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 -currrent keymaps. However, if the optional third argument NO-REMAP +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; @@ -1440,7 +1569,7 @@ is non-nil, `key-binding' returns the unmapped command. */) goto done; } else - { + { Lisp_Object local; local = get_local_map (PT, current_buffer, Qkeymap); @@ -1481,14 +1610,14 @@ is non-nil, `key-binding' returns the unmapped command. */) /* 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 = Fremap_command (value), !NILP (value1)) + if (value1 = Fcommand_remapping (value), !NILP (value1)) value = value1; } - + return value; } @@ -1496,7 +1625,7 @@ is non-nil, `key-binding' returns the unmapped command. */) DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0, doc: /* Return the binding for command KEYS in current local keymap only. -KEYS is a string, a sequence of keystrokes. +KEYS is a string or vector, a sequence of keystrokes. The binding is probably a symbol with a function definition. If optional argument ACCEPT-DEFAULT is non-nil, recognize default @@ -1515,9 +1644,9 @@ bindings; see the description of `lookup-key' for more details about this. */) DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0, doc: /* Return the binding for command KEYS in current global keymap only. -KEYS is a string, a sequence of keystrokes. +KEYS is a string or vector, a sequence of keystrokes. The binding is probably a symbol with a function definition. -This function's return values are the same as those of lookup-key +This function's return values are the same as those of `lookup-key' \(which see). If optional argument ACCEPT-DEFAULT is non-nil, recognize default @@ -1580,7 +1709,8 @@ If a second optional argument MAPVAR is given, the map is stored as its value instead of as COMMAND's value; but COMMAND is still defined as a function. The third optional argument NAME, if given, supplies a menu name -string for the map. This is required to use the keymap as a menu. */) +string for the map. This is required to use the keymap as a menu. +This function returns COMMAND. */) (command, mapvar, name) Lisp_Object command, mapvar, name; { @@ -1653,43 +1783,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); + 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)); + } - Faset (tem, last, make_number (XINT (key) | meta_bit)); + /* 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); - /* 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)); - } - } + 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)); } } @@ -1717,7 +1858,7 @@ then the value includes only maps for prefixes that start with PREFIX. */) (keymap, prefix) Lisp_Object keymap, prefix; { - Lisp_Object maps, good_maps, tail; + Lisp_Object maps, tail; int prefixlen = 0; /* no need for gcpro because we don't autoload any keymaps. */ @@ -1744,8 +1885,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; @@ -1800,7 +1941,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); @@ -1823,113 +1964,116 @@ then the value includes only maps for prefixes that start with PREFIX. */) } } - if (NILP (prefix)) - return maps; - - /* Now find just the maps whose access prefixes start with PREFIX. */ - - good_maps = Qnil; - for (; CONSP (maps); maps = XCDR (maps)) - { - Lisp_Object elt, thisseq; - elt = XCAR (maps); - thisseq = XCAR (elt); - /* The access prefix must be at least as long as PREFIX, - and the first elements must match those of PREFIX. */ - if (XINT (Flength (thisseq)) >= prefixlen) - { - int i; - for (i = 0; i < prefixlen; i++) - { - Lisp_Object i1; - XSETFASTINT (i1, i); - if (!EQ (Faref (thisseq, i1), Faref (prefix, i1))) - break; - } - if (i == prefixlen) - good_maps = Fcons (elt, good_maps); - } - } - - return Fnreverse (good_maps); + return maps; } Lisp_Object Qsingle_key_description, Qkey_description; /* This function cannot GC. */ -DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0, +DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0, doc: /* Return a pretty description of key-sequence KEYS. -Control characters turn into "C-foo" sequences, meta into "M-foo" +Optional arg PREFIX is the sequence of keys leading up to KEYS. +Control characters turn into "C-foo" sequences, meta into "M-foo", spaces are put between sequence elements, etc. */) - (keys) - Lisp_Object keys; + (keys, prefix) + Lisp_Object keys, prefix; { int len = 0; int i, i_byte; - Lisp_Object sep; - Lisp_Object *args = NULL; + Lisp_Object *args; + int size = XINT (Flength (keys)); + Lisp_Object list; + Lisp_Object sep = build_string (" "); + Lisp_Object key; + int add_meta = 0; + + if (!NILP (prefix)) + size += XINT (Flength (prefix)); + + /* This has one extra element at the end that we don't pass to Fconcat. */ + args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object)); + + /* In effect, this computes + (mapconcat 'single-key-description keys " ") + but we shouldn't use mapconcat because it can do GC. */ - if (STRINGP (keys)) + next_list: + if (!NILP (prefix)) + list = prefix, prefix = Qnil; + else if (!NILP (keys)) + list = keys, keys = Qnil; + else { - Lisp_Object vector; - vector = Fmake_vector (Flength (keys), Qnil); - for (i = 0, i_byte = 0; i < XSTRING (keys)->size; ) + if (add_meta) { - int c; - int i_before = i; - - FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte); - if (SINGLE_BYTE_CHAR_P (c) && (c & 0200)) - c ^= 0200 | meta_modifier; - XSETFASTINT (AREF (vector, i_before), c); + args[len] = Fsingle_key_description (meta_prefix_char, Qnil); + len += 2; } - keys = vector; + else if (len == 0) + return empty_string; + return Fconcat (len - 1, args); } - if (VECTORP (keys)) - { - /* In effect, this computes - (mapconcat 'single-key-description keys " ") - but we shouldn't use mapconcat because it can do GC. */ + if (STRINGP (list)) + size = SCHARS (list); + else if (VECTORP (list)) + size = XVECTOR (list)->size; + else if (CONSP (list)) + size = XINT (Flength (list)); + else + wrong_type_argument (Qarrayp, list); - len = XVECTOR (keys)->size; - sep = build_string (" "); - /* This has one extra element at the end that we don't pass to Fconcat. */ - args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object)); + i = i_byte = 0; - for (i = 0; i < len; i++) + while (i < size) + { + if (STRINGP (list)) { - 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) { - args[i * 2] = Fsingle_key_description (XCAR (keys), Qnil); - args[i * 2 + 1] = sep; - keys = XCDR (keys); + if (!INTEGERP (key) + || EQ (key, meta_prefix_char) + || (XINT (key) & meta_modifier)) + { + args[len++] = Fsingle_key_description (meta_prefix_char, Qnil); + args[len++] = sep; + if (EQ (key, meta_prefix_char)) + continue; + } + else + XSETINT (key, (XINT (key) | meta_modifier) & ~0x80); + add_meta = 0; } + else if (EQ (key, meta_prefix_char)) + { + add_meta = 1; + continue; + } + args[len++] = Fsingle_key_description (key, Qnil); + args[len++] = sep; } - else - keys = wrong_type_argument (Qarrayp, keys); - - if (len == 0) - return empty_string; - return Fconcat (len * 2 - 1, args); + goto next_list; } + char * push_key_description (c, p, force_multibyte) register unsigned int c; @@ -2118,8 +2262,8 @@ around function keys and event symbols. */) if (NILP (no_angles)) { char *buffer - = (char *) alloca (STRING_BYTES (XSTRING (SYMBOL_NAME (key))) + 5); - sprintf (buffer, "<%s>", XSTRING (SYMBOL_NAME (key))->data); + = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5); + sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key))); return build_string (buffer); } else @@ -2162,7 +2306,11 @@ push_text_char_description (c, p) DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0, doc: /* Return a pretty description of file-character CHARACTER. -Control characters turn into "^char", etc. */) +Control characters turn into "^char", etc. This differs from +`single-key-description' which turns them into "C-char". +Also, this function recognizes the 2**7 bit as the Meta character, +whereas `single-key-description' uses the 2**27 bit for Meta. +See Info node `(elisp)Describing Characters' for examples. */) (character) Lisp_Object character; { @@ -2234,6 +2382,8 @@ 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 @@ -2252,7 +2402,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) if (NILP (no_remap) && SYMBOLP (definition)) { Lisp_Object tem; - if (tem = Fremap_command (definition), !NILP (tem)) + if (tem = Fcommand_remapping (definition), !NILP (tem)) return Qnil; } @@ -2272,7 +2422,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) 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 @@ -2288,7 +2438,8 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) /* 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'. */ @@ -2342,7 +2493,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) 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)); } @@ -2405,6 +2556,19 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) continue; record_sequence: + /* Don't annoy user with strings from a menu such as + Select Paste. Change them all to "(any string)", + so that there seems to be only one menu item + to report. */ + if (! NILP (sequence)) + { + Lisp_Object tem; + tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1)); + if (STRINGP (tem)) + Faset (sequence, make_number (XVECTOR (sequence)->size - 1), + build_string ("(any string)")); + } + /* It is a true unshadowed match. Record it, unless it's already been seen (as could happen when inheriting keymaps). */ if (NILP (Fmember (sequence, found))) @@ -2444,7 +2608,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0, doc: /* Return list of keys that invoke DEFINITION. -If KEYMAP is non-nil, search only KEYMAP and the global keymap. +If KEYMAP is a keymap, search only KEYMAP and the global keymap. If KEYMAP is nil, search all the currently active keymaps. If KEYMAP is a list of keymaps, search only those keymaps. @@ -2452,8 +2616,8 @@ If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found, rather than a list of all possible key sequences. If FIRSTONLY is the symbol `non-ascii', return the first binding found, no matter what it is. -If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters, -and entirely reject menu bindings. +If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters +\(or their meta variants) and entirely reject menu bindings. If optional 4th arg NOINDIRECT is non-nil, don't follow indirections to other keymaps or slots. This makes it possible to search for an @@ -2486,7 +2650,7 @@ remapped command in the returned list. */) Lisp_Object *defns; int i, j, n; 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; @@ -2582,7 +2746,7 @@ where_is_internal_2 (args, key, binding) } -/* This function cannot GC. */ +/* This function can GC because get_keyelt can. */ static Lisp_Object where_is_internal_1 (binding, key, definition, noindirect, this, last, @@ -2657,8 +2821,8 @@ You type Translation\n\ if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix)) { int c; - unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data; - int translate_len = XSTRING (Vkeyboard_translate_table)->size; + const unsigned char *translate = SDATA (Vkeyboard_translate_table); + int translate_len = SCHARS (Vkeyboard_translate_table); for (c = 0; c < translate_len; c++) if (translate[c] != c) @@ -2686,7 +2850,7 @@ You type Translation\n\ if (!NILP (Vkey_translation_map)) describe_map_tree (Vkey_translation_map, 0, Qnil, prefix, - "Key translations", nomenu, 1, 0); + "Key translations", nomenu, 1, 0, 0); /* Print the (major mode) local map. */ @@ -2699,7 +2863,7 @@ You type Translation\n\ if (!NILP (start1)) { describe_map_tree (start1, 1, shadow, prefix, - "\f\nOverriding Bindings", nomenu, 0, 0); + "\f\nOverriding Bindings", nomenu, 0, 0, 0); shadow = Fcons (start1, shadow); } else @@ -2720,7 +2884,8 @@ You type Translation\n\ if (!NILP (start1)) { describe_map_tree (start1, 1, shadow, prefix, - "\f\n`keymap' Property Bindings", nomenu, 0, 0); + "\f\n`keymap' Property Bindings", nomenu, + 0, 0, 0); shadow = Fcons (start1, shadow); } @@ -2736,19 +2901,20 @@ You type Translation\n\ if (!SYMBOLP (modes[i])) abort(); - p = title = (char *) alloca (42 + XSTRING (SYMBOL_NAME (modes[i]))->size); + p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i]))); *p++ = '\f'; *p++ = '\n'; *p++ = '`'; - bcopy (XSTRING (SYMBOL_NAME (modes[i]))->data, p, - XSTRING (SYMBOL_NAME (modes[i]))->size); - p += XSTRING (SYMBOL_NAME (modes[i]))->size; + bcopy (SDATA (SYMBOL_NAME (modes[i])), p, + SCHARS (SYMBOL_NAME (modes[i]))); + p += SCHARS (SYMBOL_NAME (modes[i])); *p++ = '\''; bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1); p += sizeof (" Minor Mode Bindings") - 1; *p = 0; - describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0); + describe_map_tree (maps[i], 1, shadow, prefix, + title, nomenu, 0, 0, 0); shadow = Fcons (maps[i], shadow); } @@ -2758,23 +2924,23 @@ You type Translation\n\ { if (EQ (start1, XBUFFER (buffer)->keymap)) describe_map_tree (start1, 1, shadow, prefix, - "\f\nMajor Mode Bindings", nomenu, 0, 0); + "\f\nMajor Mode Bindings", nomenu, 0, 0, 0); else describe_map_tree (start1, 1, shadow, prefix, "\f\n`local-map' Property Bindings", - nomenu, 0, 0); + nomenu, 0, 0, 0); shadow = Fcons (start1, shadow); } } describe_map_tree (current_global_map, 1, shadow, prefix, - "\f\nGlobal Bindings", nomenu, 0, 1); + "\f\nGlobal Bindings", nomenu, 0, 1, 0); /* Print the function-key-map translations under this prefix. */ if (!NILP (Vfunction_key_map)) describe_map_tree (Vfunction_key_map, 0, Qnil, prefix, - "\f\nFunction key map translations", nomenu, 1, 0); + "\f\nFunction key map translations", nomenu, 1, 0, 0); UNGCPRO; return Qnil; @@ -2795,17 +2961,21 @@ You type Translation\n\ so print strings and vectors differently. If ALWAYS_TITLE is nonzero, print the title even if there are no maps - to look through. */ + to look through. + + If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW, + don't omit it; instead, mention it but say it is shadowed. */ void describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl, - always_title) + always_title, mention_shadow) Lisp_Object startmap, shadow, prefix; int partial; char *title; int nomenu; int transl; int always_title; + int mention_shadow; { Lisp_Object maps, orig_maps, seen, sub_shadows; struct gcpro gcpro1, gcpro2, gcpro3; @@ -2848,7 +3018,7 @@ key binding\n\ if (!NILP (prefix)) { insert_string (" Starting With "); - insert1 (Fkey_description (prefix)); + insert1 (Fkey_description (prefix, Qnil)); } insert_string (":\n"); } @@ -2873,7 +3043,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 @@ -2907,7 +3077,7 @@ key binding\n\ describe_map (Fcdr (elt), prefix, transl ? describe_translation : describe_command, - partial, sub_shadows, &seen, nomenu); + partial, sub_shadows, &seen, nomenu, mention_shadow); skip: ; } @@ -2925,7 +3095,7 @@ describe_command (definition, args) Lisp_Object definition, args; { register Lisp_Object tem1; - int column = current_column (); + int column = (int) current_column (); /* iftc */ int description_column; /* If column 16 is no good, go to col 32; @@ -2973,7 +3143,7 @@ describe_translation (definition, args) } else if (STRINGP (definition) || VECTORP (definition)) { - insert1 (Fkey_description (definition)); + insert1 (Fkey_description (definition, Qnil)); insert_string ("\n"); } else if (KEYMAPP (definition)) @@ -2983,20 +3153,21 @@ describe_translation (definition, args) } /* Describe the contents of map MAP, assuming that this map itself is - reached by the sequence of prefix keys KEYS (a string or vector). + reached by the sequence of prefix keys PREFIX (a string or vector). PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */ static void -describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) +describe_map (map, prefix, elt_describer, partial, shadow, + seen, nomenu, mention_shadow) register Lisp_Object map; - Lisp_Object keys; + Lisp_Object prefix; void (*elt_describer) P_ ((Lisp_Object, Lisp_Object)); int partial; Lisp_Object shadow; Lisp_Object *seen; int nomenu; + int mention_shadow; { - Lisp_Object elt_prefix; Lisp_Object tail, definition, event; Lisp_Object tem; Lisp_Object suppress; @@ -3006,15 +3177,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"); @@ -3024,7 +3186,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)) { @@ -3033,13 +3195,14 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) if (VECTORP (XCAR (tail)) || CHAR_TABLE_P (XCAR (tail))) describe_vector (XCAR (tail), - elt_prefix, Qnil, elt_describer, partial, shadow, map, - (int *)0, 0); + prefix, Qnil, elt_describer, partial, shadow, map, + (int *)0, 0, 1, mention_shadow); else if (CONSP (XCAR (tail))) { + int this_shadowed = 0; event = XCAR (XCAR (tail)); - /* Ignore bindings whose "keys" are not really valid events. + /* Ignore bindings whose "prefix" are not really valid events. (We get these in the frames and buffers menu.) */ if (!(SYMBOLP (event) || INTEGERP (event))) continue; @@ -3065,7 +3228,13 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) if (!NILP (shadow)) { tem = shadow_lookup (shadow, kludge, Qt); - if (!NILP (tem)) continue; + if (!NILP (tem)) + { + if (mention_shadow) + this_shadowed = 1; + else + continue; + } } tem = Flookup_key (map, kludge, Qt); @@ -3078,16 +3247,20 @@ 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, Qnil); + + if (this_shadowed) + { + SET_PT (PT - 1); + insert_string (" (binding currently shadowed)"); + SET_PT (PT + 1); + } } else if (EQ (XCAR (tail), Qkeymap)) { @@ -3095,9 +3268,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); } } @@ -3115,17 +3288,18 @@ describe_vector_princ (elt, fun) DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0, doc: /* Insert a description of contents of VECTOR. -This is text showing the elements of vector matched against indices. */) +This is text showing the elements of vector matched against indices. +DESCRIBER is the output function used; nil means use `princ'. */) (vector, describer) Lisp_Object vector, describer; { - int count = specpdl_ptr - specpdl; + int count = SPECPDL_INDEX (); if (NILP (describer)) describer = intern ("princ"); specbind (Qstandard_output, Fcurrent_buffer ()); CHECK_VECTOR_OR_CHAR_TABLE (vector); describe_vector (vector, Qnil, describer, describe_vector_princ, 0, - Qnil, Qnil, (int *)0, 0); + Qnil, Qnil, (int *)0, 0, 0, 0); return unbind_to (count, Qnil); } @@ -3160,28 +3334,34 @@ This is text showing the elements of vector matched against indices. */) indices at higher levels in this char-table, and CHAR_TABLE_DEPTH says how many levels down we have gone. + KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-. + ARGS is simply passed as the second argument to ELT_DESCRIBER. */ -void -describe_vector (vector, elt_prefix, args, elt_describer, +static void +describe_vector (vector, prefix, args, elt_describer, partial, shadow, entire_map, - indices, char_table_depth) + indices, char_table_depth, keymap_p, + mention_shadow) register Lisp_Object vector; - Lisp_Object elt_prefix, args; + Lisp_Object prefix, args; void (*elt_describer) P_ ((Lisp_Object, Lisp_Object)); int partial; Lisp_Object shadow; Lisp_Object entire_map; int *indices; int char_table_depth; + int keymap_p; + int mention_shadow; { Lisp_Object definition; Lisp_Object tem2; + Lisp_Object elt_prefix = Qnil; register int i; Lisp_Object suppress; Lisp_Object kludge; int first = 1; - struct gcpro gcpro1, gcpro2, gcpro3; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; /* Range of elements to be handled. */ int from, to; /* A flag to tell if a leaf in this level of char-table is not a @@ -3197,11 +3377,23 @@ describe_vector (vector, elt_prefix, args, elt_describer, definition = Qnil; + if (!keymap_p) + { + /* Call Fkey_description first, to avoid GC bug for the other string. */ + if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0) + { + Lisp_Object tem; + tem = Fkey_description (prefix, Qnil); + elt_prefix = concat2 (tem, build_string (" ")); + } + prefix = Qnil; + } + /* This vector gets used to present single keys to Flookup_key. Since that is done once per vector element, we don't want to cons up a fresh vector every time. */ kludge = Fmake_vector (make_number (1), Qnil); - GCPRO3 (elt_prefix, definition, kludge); + GCPRO4 (elt_prefix, prefix, definition, kludge); if (partial) suppress = intern ("suppress-keymap"); @@ -3244,6 +3436,7 @@ describe_vector (vector, elt_prefix, args, elt_describer, for (i = from; i < to; i++) { + int this_shadowed = 0; QUIT; if (CHAR_TABLE_P (vector)) @@ -3294,15 +3487,22 @@ describe_vector (vector, elt_prefix, args, elt_describer, else character = i; + ASET (kludge, 0, make_number (character)); + /* If this binding is shadowed by some other map, ignore it. */ if (!NILP (shadow) && complete_char) { Lisp_Object tem; - ASET (kludge, 0, make_number (character)); tem = shadow_lookup (shadow, kludge, Qt); - if (!NILP (tem)) continue; + if (!NILP (tem)) + { + if (mention_shadow) + this_shadowed = 1; + else + continue; + } } /* Ignore this definition if it is shadowed by an earlier @@ -3311,7 +3511,6 @@ describe_vector (vector, elt_prefix, args, elt_describer, { Lisp_Object tem; - ASET (kludge, 0, make_number (character)); tem = Flookup_key (entire_map, kludge, Qt); if (!EQ (tem, definition)) @@ -3352,15 +3551,15 @@ describe_vector (vector, elt_prefix, args, elt_describer, else if (CHAR_TABLE_P (vector)) { if (complete_char) - insert1 (Fsingle_key_description (make_number (character), Qnil)); + insert1 (Fkey_description (kludge, prefix)); else { /* Print the information for this character set. */ insert_string ("<"); tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX); if (STRINGP (tem2)) - insert_from_string (tem2, 0, 0, XSTRING (tem2)->size, - STRING_BYTES (XSTRING (tem2)), 0); + insert_from_string (tem2, 0, 0, SCHARS (tem2), + SBYTES (tem2), 0); else insert ("?", 1); insert (">", 1); @@ -3368,7 +3567,7 @@ describe_vector (vector, elt_prefix, args, elt_describer, } else { - insert1 (Fsingle_key_description (make_number (character), Qnil)); + insert1 (Fkey_description (kludge, prefix)); } /* If we find a sub char-table within a char-table, @@ -3377,9 +3576,10 @@ describe_vector (vector, elt_prefix, args, elt_describer, if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition)) { insert ("\n", 1); - describe_vector (definition, elt_prefix, args, elt_describer, + describe_vector (definition, prefix, args, elt_describer, partial, shadow, entire_map, - indices, char_table_depth + 1); + indices, char_table_depth + 1, keymap_p, + mention_shadow); continue; } @@ -3417,6 +3617,8 @@ describe_vector (vector, elt_prefix, args, elt_describer, { insert (" .. ", 4); + ASET (kludge, 0, make_number (i)); + if (!NILP (elt_prefix)) insert1 (elt_prefix); @@ -3424,7 +3626,7 @@ describe_vector (vector, elt_prefix, args, elt_describer, { if (char_table_depth == 0) { - insert1 (Fsingle_key_description (make_number (i), Qnil)); + insert1 (Fkey_description (kludge, prefix)); } else if (complete_char) { @@ -3443,7 +3645,7 @@ describe_vector (vector, elt_prefix, args, elt_describer, } else { - insert1 (Fsingle_key_description (make_number (i), Qnil)); + insert1 (Fkey_description (kludge, prefix)); } } @@ -3451,6 +3653,13 @@ describe_vector (vector, elt_prefix, args, elt_describer, elt_describer will take care of spacing out far enough for alignment purposes. */ (*elt_describer) (definition, args); + + if (this_shadowed) + { + SET_PT (PT - 1); + insert_string (" (binding currently shadowed)"); + SET_PT (PT + 1); + } } /* For (sub) char-table, print `defalt' slot at last. */ @@ -3465,8 +3674,8 @@ describe_vector (vector, elt_prefix, args, elt_describer, } /* Apropos - finding all symbols whose names match a regexp. */ -Lisp_Object apropos_predicate; -Lisp_Object apropos_accumulate; +static Lisp_Object apropos_predicate; +static Lisp_Object apropos_accumulate; static void apropos_accum (symbol, string) @@ -3481,7 +3690,7 @@ apropos_accum (symbol, string) apropos_accumulate = Fcons (symbol, apropos_accumulate); } -DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0, +DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0, doc: /* Show all symbols whose names contain match for REGEXP. If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done for each symbol and a symbol is mentioned only if that returns non-nil. @@ -3489,15 +3698,15 @@ Return list of symbols found. */) (regexp, predicate) Lisp_Object regexp, predicate; { - struct gcpro gcpro1, gcpro2; + Lisp_Object tem; CHECK_STRING (regexp); apropos_predicate = predicate; - GCPRO2 (apropos_predicate, apropos_accumulate); apropos_accumulate = Qnil; map_obarray (Vobarray, apropos_accum, regexp); - apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp); - UNGCPRO; - return apropos_accumulate; + tem = Fsort (apropos_accumulate, Qstring_lessp); + apropos_accumulate = Qnil; + apropos_predicate = Qnil; + return tem; } void @@ -3505,6 +3714,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. */ @@ -3574,7 +3787,7 @@ in the list takes precedence. */); DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist, doc: /* Alist of keymaps to use for minor modes, in current major mode. -This variable is a alist just like `minor-mode-map-alist', and it is +This variable is an alist just like `minor-mode-map-alist', and it is used the same way (and before `minor-mode-map-alist'); however, it is provided for major modes to bind locally. */); Vminor_mode_overriding_map_alist = Qnil; @@ -3585,7 +3798,7 @@ 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'. */); +`minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */); Vemulation_mode_map_alists = Qnil; @@ -3613,9 +3826,22 @@ key, typing `ESC O P x' would return [f1 x]. */); DEFVAR_LISP ("key-translation-map", &Vkey_translation_map, doc: /* Keymap of key translations that can override keymaps. This keymap works like `function-key-map', but comes after that, -and applies even for keys that have ordinary bindings. */); +and its non-prefix bindings override ordinary bindings. */); Vkey_translation_map = Qnil; + staticpro (&Vmouse_events); + Vmouse_events = Fcons (intern ("menu-bar"), + Fcons (intern ("tool-bar"), + Fcons (intern ("header-line"), + Fcons (intern ("mode-line"), + Fcons (intern ("mouse-1"), + Fcons (intern ("mouse-2"), + Fcons (intern ("mouse-3"), + Fcons (intern ("mouse-4"), + Fcons (intern ("mouse-5"), + Qnil))))))))); + + Qsingle_key_description = intern ("single-key-description"); staticpro (&Qsingle_key_description); @@ -3634,8 +3860,8 @@ and applies even for keys that have ordinary bindings. */); Qremap = intern ("remap"); staticpro (&Qremap); - remap_command_vector = Fmake_vector (make_number (2), Qremap); - staticpro (&remap_command_vector); + command_remapping_vector = Fmake_vector (make_number (2), Qremap); + staticpro (&command_remapping_vector); where_is_cache_keymaps = Qt; where_is_cache = Qnil; @@ -3648,8 +3874,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 (&Sremap_command); + defsubr (&Scommand_remapping); defsubr (&Skey_binding); defsubr (&Slocal_key_binding); defsubr (&Sglobal_key_binding); @@ -3679,3 +3906,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) */