From 1e7d1ab059a1cab5f042f9a3fe6cb99dfdcb36c9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 25 Oct 2000 23:35:21 +0000 Subject: [PATCH] (where_is_cache, where_is_cache_keymaps): New vars. (Fset_keymap_parent, store_in_keymap): Flush the where-is cache. (where_is_internal): Renamed from Fwhere_is_internal. Don't DEFUN any more. Arg `xkeymap' replaced by `keymaps'. (Fwhere_is_internal): New function wrapping where_is_internal. (where_is_internal_1): Handle the case where we're filling the cache. (syms_of_keymap): Init and gcpro the where_is_cache(|_keymaps). --- src/keymap.c | 169 ++++++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 122 insertions(+), 47 deletions(-) diff --git a/src/keymap.c b/src/keymap.c index cd8f1146d37..0f61304a8e5 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -100,6 +100,11 @@ extern Lisp_Object meta_prefix_char; extern Lisp_Object Voverriding_local_map; +/* Hash table used to cache a reverse-map to speed up calls to where-is. */ +static Lisp_Object where_is_cache; +/* Which keymaps are reverse-stored in the cache. */ +static Lisp_Object where_is_cache_keymaps; + 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)); @@ -313,6 +318,15 @@ PARENT should be nil or another keymap.") struct gcpro gcpro1; int i; + /* Force a keymap flush for the next call to where-is. + Since this can be called from within where-is, we don't set where_is_cache + directly but only where_is_cache_keymaps, since where_is_cache shouldn't + be changed during where-is, while where_is_cache_keymaps is only used at + the very beginning of where-is and can thus be changed here without any + adverse effect. + This is a very minor correctness (rather than safety) issue. */ + where_is_cache_keymaps = Qt; + keymap = get_keymap_1 (keymap, 1, 1); GCPRO1 (keymap); @@ -665,6 +679,10 @@ store_in_keymap (keymap, idx, def) register Lisp_Object idx; register Lisp_Object def; { + /* Flush any reverse-map cache. */ + where_is_cache = Qnil; + where_is_cache_keymaps = Qt; + /* If we are preparing to dump, and DEF is a menu element with a menu item indicator, copy it to ensure it is not pure. */ if (CONSP (def) && PURE_P (def) @@ -2054,46 +2072,17 @@ shadow_lookup (shadow, key, flag) /* This function can GC if Flookup_key autoloads any keymaps. */ -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, xkeymap, firstonly, noindirect) - Lisp_Object definition, xkeymap; +static Lisp_Object +where_is_internal (definition, keymaps, firstonly, noindirect) + Lisp_Object definition, keymaps; Lisp_Object firstonly, noindirect; { Lisp_Object maps = Qnil; Lisp_Object found, sequences; - Lisp_Object keymaps; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; /* 1 means ignore all menu bindings entirely. */ int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii); - /* Find keymaps accessible from `xkeymap' or the current context. */ - if (CONSP (xkeymap) && KEYMAPP (XCAR (xkeymap))) - keymaps = xkeymap; - else if (! NILP (xkeymap)) - keymaps = Fcons (xkeymap, Fcons (current_global_map, Qnil)); - else - keymaps = - Fdelq (Qnil, - nconc2 (Fcurrent_minor_mode_maps (), - Fcons (get_local_map (PT, current_buffer, keymap), - Fcons (get_local_map (PT, current_buffer, local_map), - Fcons (current_global_map, Qnil))))); - found = keymaps; while (CONSP (found)) { @@ -2213,8 +2202,7 @@ indirect definition itself.") Either nil or number as value from Flookup_key means undefined. */ - binding = shadow_lookup (keymaps, sequence, Qnil); - if (!EQ (binding, definition)) + if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition)) continue; /* It is a true unshadowed match. Record it, unless it's already @@ -2247,6 +2235,87 @@ indirect definition itself.") 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, xkeymap, firstonly, noindirect) + Lisp_Object definition, xkeymap; + Lisp_Object firstonly, noindirect; +{ + Lisp_Object sequences, keymaps; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + /* 1 means ignore all menu bindings entirely. */ + int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii); + + /* Find the relevant keymaps. */ + if (CONSP (xkeymap) && KEYMAPP (XCAR (xkeymap))) + keymaps = xkeymap; + else if (! NILP (xkeymap)) + keymaps = Fcons (xkeymap, Fcons (current_global_map, Qnil)); + else + keymaps = + Fdelq (Qnil, + nconc2 (Fcurrent_minor_mode_maps (), + Fcons (get_local_map (PT, current_buffer, keymap), + Fcons (get_local_map (PT, current_buffer, local_map), + Fcons (current_global_map, Qnil))))); + + /* Only use caching for the menubar (i.e. called with (def nil t nil). + We don't really need to check `xkeymap'. */ + if (nomenus && NILP (noindirect) && NILP (xkeymap)) + { + /* 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; + + /* Fill in the cache. */ + GCPRO4 (definition, keymaps, firstonly, noindirect); + where_is_internal (definition, keymaps, firstonly, noindirect); + UNGCPRO; + + where_is_cache_keymaps = keymaps; + } + + sequences = Fgethash (definition, where_is_cache, Qnil); + /* Verify that the key bindings are not shadowed. */ + /* key-binding can GC. */ + GCPRO3 (definition, sequences, keymaps); + for (sequences = Fnreverse (sequences); + CONSP (sequences); + sequences = XCDR (sequences)) + if (EQ (shadow_lookup (keymaps, XCAR (sequences), Qnil), definition)) + RETURN_UNGCPRO (XCAR (sequences)); + RETURN_UNGCPRO (Qnil); + } + else + { + /* Kill the cache so that where_is_internal_1 doesn't think + we're filling it up. */ + where_is_cache = Qnil; + return where_is_internal (definition, keymaps, firstonly, noindirect); + } +} + /* This is the function that Fwhere_is_internal calls using map_char_table. ARGS has the form (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT)) @@ -2307,19 +2376,13 @@ where_is_internal_1 (binding, key, definition, noindirect, this, last, /* End this iteration if this element does not match the target. */ - if (CONSP (definition)) - { - Lisp_Object tem; - tem = Fequal (binding, definition); - if (NILP (tem)) - return Qnil; - } - else - if (!EQ (binding, definition)) - return Qnil; + if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */ + || EQ (binding, definition) + || (CONSP (definition) && !NILP (Fequal (binding, definition))))) + /* Doesn't match. */ + return Qnil; - /* We have found a match. - Construct the key sequence where we found it. */ + /* We have found a match. Construct the key sequence where we found it. */ if (INTEGERP (key) && last_is_meta) { sequence = Fcopy_sequence (this); @@ -2328,7 +2391,14 @@ where_is_internal_1 (binding, key, definition, noindirect, this, last, else sequence = append_key (this, key); - return sequence; + if (!NILP (where_is_cache)) + { + Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil); + Fputhash (binding, Fcons (sequence, sequences), where_is_cache); + return Qnil; + } + else + return sequence; } /* describe-bindings - summarizing all the bindings in a set of keymaps. */ @@ -3321,6 +3391,11 @@ and applies even for keys that have ordinary bindings."); Qmenu_item = intern ("menu-item"); staticpro (&Qmenu_item); + where_is_cache_keymaps = Qt; + where_is_cache = Qnil; + staticpro (&where_is_cache); + staticpro (&where_is_cache_keymaps); + defsubr (&Skeymapp); defsubr (&Skeymap_parent); defsubr (&Sset_keymap_parent); -- 2.11.4.GIT