# HG changeset patch # User Stefan Monnier # Date 1252599592 0 # Node ID cd8d62c35d5741982dee81b0521cf9c977556084 # Parent 2d6dc187388c3bf20ac801848da8a20632e09fa6 * keymap.c (where_is_internal_data): Make noindirect a boolean. (where_is_internal): Strip it down to only traverse the keymaps. Move the cache handling from Fwhere_is_internal to here. (Fwhere_is_internal): Move the handling of remapping and the choice of the best binding from where_is_internal to here. Unify the cached/noncached paths, so remapping is also handled correctly when the cache is used, and so the cache can be used to speed up remap-handling when applicable. Give preference to non-remapped bindings. * doc.c (Fsubstitute_command_keys): Let Fwhere_is_internal's prefer non-remapped bindings. * keyboard.c (parse_menu_item): Let Fwhere_is_internal handle command remapping. diff -r 2d6dc187388c -r cd8d62c35d57 src/ChangeLog --- a/src/ChangeLog Thu Sep 10 06:27:04 2009 +0000 +++ b/src/ChangeLog Thu Sep 10 16:19:52 2009 +0000 @@ -1,5 +1,19 @@ 2009-09-10 Stefan Monnier + * keymap.c (where_is_internal_data): Make noindirect a boolean. + (where_is_internal): Strip it down to only traverse the keymaps. + Move the cache handling from Fwhere_is_internal to here. + (Fwhere_is_internal): Move the handling of remapping and the choice of + the best binding from where_is_internal to here. + Unify the cached/noncached paths, so remapping is also handled + correctly when the cache is used, and so the cache can be used to + speed up remap-handling when applicable. + Give preference to non-remapped bindings. + * doc.c (Fsubstitute_command_keys): Let Fwhere_is_internal's prefer + non-remapped bindings. + * keyboard.c (parse_menu_item): Let Fwhere_is_internal handle + command remapping. + * xdisp.c (display_mode_element): Move list length limit from 50 to 5000 (see thread starting with ). diff -r 2d6dc187388c -r cd8d62c35d57 src/doc.c --- a/src/doc.c Thu Sep 10 06:27:04 2009 +0000 +++ b/src/doc.c Thu Sep 10 16:19:52 2009 +0000 @@ -802,10 +802,7 @@ name = Fintern (make_string (start, length_byte), Qnil); do_remap: - /* Ignore remappings unless there are no ordinary bindings. */ - tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qt); - if (NILP (tem)) - tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil); + tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil); if (VECTORP (tem) && XVECTOR (tem)->size > 1 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1)) diff -r 2d6dc187388c -r cd8d62c35d57 src/keyboard.c --- a/src/keyboard.c Thu Sep 10 06:27:04 2009 +0000 +++ b/src/keyboard.c Thu Sep 10 16:19:52 2009 +0000 @@ -8158,11 +8158,7 @@ && SYMBOLP (XSYMBOL (def)->function) && ! NILP (Fget (def, Qmenu_alias))) def = XSYMBOL (def)->function; - tem = Fwhere_is_internal (def, Qnil, Qt, Qnil, Qt); - - /* Don't display remap bindings.*/ - if (VECTORP (tem) && ASIZE (tem) > 0 && EQ (AREF (tem, 0), Qremap)) - tem = Qnil; + tem = Fwhere_is_internal (def, Qnil, Qt, Qnil, Qnil); XSETCAR (cachelist, tem); if (NILP (tem)) diff -r 2d6dc187388c -r cd8d62c35d57 src/keymap.c --- a/src/keymap.c Thu Sep 10 06:27:04 2009 +0000 +++ b/src/keymap.c Thu Sep 10 16:19:52 2009 +0000 @@ -2640,7 +2640,6 @@ /* where-is - finding a command in a set of keymaps. */ -static Lisp_Object where_is_internal (); static void where_is_internal_1 P_ ((Lisp_Object key, Lisp_Object binding, Lisp_Object args, void *data)); @@ -2672,23 +2671,49 @@ static Lisp_Object Vmouse_events; struct where_is_internal_data { - Lisp_Object definition, noindirect, this, last; - int last_is_meta; + Lisp_Object definition, this, last; + int last_is_meta, noindirect; Lisp_Object sequences; }; -/* This function can GC if Flookup_key autoloads any keymaps. */ +/* This function can't GC, AFAIK. */ +/* Return the list of bindings found. This list is ordered "longest + to shortest". It may include bindings that are actually shadowed + by others, as well as duplicate bindings and remapping bindings. + The list returned is potentially shared with where_is_cache, so + be careful not to modify it via side-effects. */ static Lisp_Object -where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) - Lisp_Object definition, keymaps; - Lisp_Object firstonly, noindirect, no_remap; +where_is_internal (Lisp_Object definition, Lisp_Object keymaps, + int noindirect, int nomenus) { Lisp_Object maps = Qnil; - Lisp_Object found, sequences; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - /* 1 means ignore all menu bindings entirely. */ - int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii); + Lisp_Object found; + struct where_is_internal_data data; + + /* Only important use of caching is for the menubar + (i.e. where-is-internal called with (def nil t nil nil)). */ + if (nomenus && !noindirect) + { + /* Check heuristic-consistency of the cache. */ + if (NILP (Fequal (keymaps, where_is_cache_keymaps))) + where_is_cache = Qnil; + + if (NILP (where_is_cache)) + { + /* We need to create the cache. */ + Lisp_Object args[2]; + where_is_cache = Fmake_hash_table (0, args); + where_is_cache_keymaps = Qt; + } + else + /* We can reuse the cache. */ + return Fgethash (definition, where_is_cache, Qnil); + } + else + /* Kill the cache so that where_is_internal_1 doesn't think + we're filling it up. */ + where_is_cache = Qnil; found = keymaps; while (CONSP (found)) @@ -2699,22 +2724,11 @@ found = XCDR (found); } - GCPRO5 (definition, keymaps, maps, found, sequences); - found = Qnil; - sequences = Qnil; - - /* If this command is remapped, then it has no key bindings - of its own. */ - if (NILP (no_remap) - && SYMBOLP (definition) - && !NILP (Fcommand_remapping (definition, Qnil, keymaps))) - RETURN_UNGCPRO (Qnil); - + data.sequences = Qnil; for (; CONSP (maps); maps = XCDR (maps)) { /* Key sequence to reach map, and the map that it reaches */ register Lisp_Object this, map, tem; - struct where_is_internal_data data; /* In order to fold [META-PREFIX-CHAR CHAR] sequences into [M-CHAR] sequences, check if last character of the sequence @@ -2744,105 +2758,24 @@ data.this = this; data.last = last; data.last_is_meta = last_is_meta; - data.sequences = Qnil; if (CONSP (map)) map_keymap (map, where_is_internal_1, Qnil, &data, 0); - - sequences = data.sequences; - - while (CONSP (sequences)) - { - Lisp_Object sequence, remapped, function; - - sequence = XCAR (sequences); - sequences = XCDR (sequences); - - /* Verify that this key binding is not shadowed by another - binding for the same key, before we say it exists. - - Mechanism: look for local definition of this key and if - it is defined and does not match what we found then - ignore this key. - - Either nil or number as value from Flookup_key - means undefined. */ - if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition)) - continue; - - /* If the current sequence is a command remapping with - format [remap COMMAND], find the key sequences - which run COMMAND, and use those sequences instead. */ - if (NILP (no_remap) - && VECTORP (sequence) && XVECTOR (sequence)->size == 2 - && EQ (AREF (sequence, 0), Qremap) - && (function = AREF (sequence, 1), SYMBOLP (function))) - remapped = where_is_internal (function, keymaps, firstonly, - noindirect, Qt); - else - remapped = Fcons (sequence, Qnil); - - for (; CONSP (remapped); - sequence = XCAR (remapped), remapped = XCDR (remapped)) - { - /* Don't annoy user with strings from a menu such as the - entries from the "Edit => Paste from Kill Menu". - 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 (ASIZE (sequence) - 1)); - if (STRINGP (tem)) - Faset (sequence, make_number (ASIZE (sequence) - 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))) - found = Fcons (sequence, found); - - /* If firstonly is Qnon_ascii, then we can return the first - binding we find. If firstonly is not Qnon_ascii but not - nil, then we should return the first ascii-only binding - we find. */ - if (EQ (firstonly, Qnon_ascii)) - RETURN_UNGCPRO (sequence); - else if (!NILP (firstonly) - && 2 == preferred_sequence_p (sequence)) - RETURN_UNGCPRO (sequence); - - } - } } - UNGCPRO; - - found = Fnreverse (found); - - /* firstonly may have been t, but we may have gone all the way through - the keymaps without finding an all-ASCII key sequence. So just - return the best we could find. */ - if (NILP (firstonly)) - return found; - else if (where_is_preferred_modifier == 0) - return Fcar (found); - else - { /* Maybe we did not find a preferred_modifier binding, but we did find - some ASCII binding. */ - Lisp_Object bindings = found; - while (CONSP (bindings)) - if (preferred_sequence_p (XCAR (bindings))) - return XCAR (bindings); - else - bindings = XCDR (bindings); - return Fcar (found); - } + if (nomenus && !noindirect) + /* Remember for which keymaps this cache was built. + We do it here (late) because we want to keep where_is_cache_keymaps + set to t while the cache isn't fully filled. */ + where_is_cache_keymaps = keymaps; + + return data.sequences; } static Lisp_Object Vwhere_is_preferred_modifier; +/* This function can GC if Flookup_key autoloads any keymaps. */ + DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0, doc: /* Return list of keys that invoke DEFINITION. If KEYMAP is a keymap, search only KEYMAP and the global keymap. @@ -2868,10 +2801,23 @@ Lisp_Object definition, keymap; Lisp_Object firstonly, noindirect, no_remap; { - Lisp_Object sequences, keymaps; + /* The keymaps in which to search. */ + Lisp_Object keymaps; + /* Potentially relevant bindings in "shortest to longest" order. */ + Lisp_Object sequences = Qnil, + /* Actually relevant bindings. */ + Lisp_Object found = Qnil; /* 1 means ignore all menu bindings entirely. */ int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii); - Lisp_Object result; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + /* List of sequences found via remapping. Keep them in a separate + variable, so as to push them later, since we prefer + non-remapped binding. */ + Lisp_Object remapped_sequences = Qnil; + /* Whether or not we're handling remapped sequences. This is needed + because remapping is not done recursively by Fcommand_remapping: you + can't remap and remapped command. */ + int remapped = 0; /* Refresh the C version of the modifier preference. */ where_is_preferred_modifier @@ -2885,74 +2831,114 @@ else keymaps = Fcurrent_active_maps (Qnil, Qnil); - /* Only use caching for the menubar (i.e. called with (def nil t nil). - We don't really need to check `keymap'. */ - if (nomenus && NILP (noindirect) && NILP (keymap)) + GCPRO5 (definition, keymaps, found, sequences, remapped_sequences); + + /* If this command is remapped, then it has no key bindings of its own. + FIXME: Actually, this is not quite right: if A is remapped to + `definition', then bindings to A will actually bind the key to + `definition' despite the remapping from `definition' to something else. + Another corner case is if `definition' is remapped to itself. */ + if (NILP (no_remap) + && SYMBOLP (definition) + && !NILP (Fcommand_remapping (definition, Qnil, keymaps))) + RETURN_UNGCPRO (Qnil); + + sequences = Freverse (where_is_internal (definition, keymaps, + !NILP (noindirect), nomenus)); + + while (CONSP (sequences)) { - Lisp_Object *defns; - int i, 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; - - if (NILP (where_is_cache)) + Lisp_Object sequence, function; + + sequence = XCAR (sequences); + sequences = XCDR (sequences); + + if (NILP (sequences) && !remapped) { - /* We need to create the cache. */ - Lisp_Object args[2]; - where_is_cache = Fmake_hash_table (0, args); - where_is_cache_keymaps = Qt; - - /* Fill in the cache. */ - GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap); - where_is_internal (definition, keymaps, firstonly, noindirect, no_remap); - UNGCPRO; - - where_is_cache_keymaps = keymaps; + sequences = remapped_sequences; + remapped = 1; } - /* We want to process definitions from the last to the first. - Instead of consing, copy definitions to a vector and step - over that vector. */ - sequences = Fgethash (definition, where_is_cache, Qnil); - n = XINT (Flength (sequences)); - defns = (Lisp_Object *) alloca (n * sizeof *defns); - for (i = 0; CONSP (sequences); sequences = XCDR (sequences)) - defns[i++] = XCAR (sequences); - - /* Verify that the key bindings are not shadowed. Note that - the following can GC. */ - GCPRO2 (definition, keymaps); - result = Qnil; - { - int best_pref = -1; - int j = -1; - for (i = n - 1; i >= 0; --i) - { - int pref = preferred_sequence_p (defns[i]); - if (pref > best_pref - && EQ (shadow_lookup (keymaps, defns[i], Qnil), definition)) - { - j = i; - best_pref = pref; - if (best_pref == 2) - break; - } - } - result = j >= 0 ? defns[j] : Qnil; - } - UNGCPRO; + /* Verify that this key binding is not shadowed by another + binding for the same key, before we say it exists. + + Mechanism: look for local definition of this key and if + it is defined and does not match what we found then + ignore this key. + + Either nil or number as value from Flookup_key + means undefined. */ + if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition)) + continue; + + /* If the current sequence is a command remapping with + format [remap COMMAND], find the key sequences + which run COMMAND, and use those sequences instead. */ + if (NILP (no_remap) && !remapped + && VECTORP (sequence) && ASIZE (sequence) == 2 + && EQ (AREF (sequence, 0), Qremap) + && (function = AREF (sequence, 1), SYMBOLP (function))) + { + Lisp_Object seqs = where_is_internal (function, keymaps, + !NILP (noindirect), nomenus); + Lisp_Object args[2]; + args[0] = Freverse (seqs); + args[1] = remapped_sequences; + remapped_sequences = Fnconc (2, args); + continue; + } + + /* Don't annoy user with strings from a menu such as the + entries from the "Edit => Paste from Kill Menu". + 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 (ASIZE (sequence) - 1)); + if (STRINGP (tem)) + Faset (sequence, make_number (ASIZE (sequence) - 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))) + found = Fcons (sequence, found); + + /* If firstonly is Qnon_ascii, then we can return the first + binding we find. If firstonly is not Qnon_ascii but not + nil, then we should return the first ascii-only binding + we find. */ + if (EQ (firstonly, Qnon_ascii)) + RETURN_UNGCPRO (sequence); + else if (!NILP (firstonly) + && 2 == preferred_sequence_p (sequence)) + RETURN_UNGCPRO (sequence); } + + UNGCPRO; + + found = Fnreverse (found); + + /* firstonly may have been t, but we may have gone all the way through + the keymaps without finding an all-ASCII key sequence. So just + return the best we could find. */ + if (NILP (firstonly)) + return found; + else if (where_is_preferred_modifier == 0) + return Fcar (found); else - { - /* Kill the cache so that where_is_internal_1 doesn't think - we're filling it up. */ - where_is_cache = Qnil; - result = where_is_internal (definition, keymaps, firstonly, noindirect, no_remap); + { /* Maybe we did not find a preferred_modifier binding, but we did find + some ASCII binding. */ + Lisp_Object bindings = found; + while (CONSP (bindings)) + if (preferred_sequence_p (XCAR (bindings))) + return XCAR (bindings); + else + bindings = XCDR (bindings); + return Fcar (found); } - - return result; } /* This function can GC because get_keyelt can. */ @@ -2964,14 +2950,14 @@ { struct where_is_internal_data *d = data; /* Cast! */ Lisp_Object definition = d->definition; - Lisp_Object noindirect = d->noindirect; + int noindirect = d->noindirect; Lisp_Object this = d->this; Lisp_Object last = d->last; int last_is_meta = d->last_is_meta; Lisp_Object sequence; /* Search through indirections unless that's not wanted. */ - if (NILP (noindirect)) + if (noindirect) binding = get_keyelt (binding, 0); /* End this iteration if this element does not match