]> git.eshelyaron.com Git - emacs.git/commitdiff
* keymap.c (where_is_internal_data): Make noindirect a boolean.
authorStefan Monnier <monnier@iro.umontreal.ca>
Thu, 10 Sep 2009 16:19:52 +0000 (16:19 +0000)
committerStefan Monnier <monnier@iro.umontreal.ca>
Thu, 10 Sep 2009 16:19:52 +0000 (16:19 +0000)
(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.

src/ChangeLog
src/doc.c
src/keyboard.c
src/keymap.c

index 09967b68d3f9b49b142598b37c02720f2440c4ba..c530325ed69df7e19aca3696f562b4eada9235ae 100644 (file)
@@ -1,5 +1,19 @@
 2009-09-10  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+       * 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 <xbaik5174uqu.fsf@cam.ac.uk>).
 
index 6d5862ce292c7444b34292e516319e2ab8ef8b2d..71308e6904f48e5a067a08bb9fa601591494d8e9 100644 (file)
--- a/src/doc.c
+++ b/src/doc.c
@@ -802,10 +802,7 @@ a new string, without any text properties, is returned.  */)
          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))
index dfb625675a47e10d9f814f749677dd79f6ff5021..04af3585897c92ec67ebff8b497132c003a0dc5d 100644 (file)
@@ -8158,11 +8158,7 @@ parse_menu_item (item, notreal, inmenubar)
              && 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))
index dcf8e19900cec52f8e87e8c184fa4bf9e224322a..111352c7f8ac455e77db9d74779f974b2ba2c152 100644 (file)
@@ -2640,7 +2640,6 @@ preferred_sequence_p (seq)
 \f
 /* 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 @@ shadow_lookup (shadow, key, flag)
 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 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
       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 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
       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);
+  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;
 
-  /* 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);
-    }
+  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 @@ remapped command in the returned list.  */)
      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 @@ remapped command in the returned list.  */)
   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))
-    {
-      Lisp_Object *defns;
-      int i, n;
-      struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+  GCPRO5 (definition, keymaps, found, sequences, remapped_sequences);
 
-      /* Check heuristic-consistency of the cache.  */
-      if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
-       where_is_cache = Qnil;
+  /* 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);
 
-      if (NILP (where_is_cache))
+  sequences = Freverse (where_is_internal (definition, keymaps,
+                                          !NILP (noindirect), nomenus));
+
+  while (CONSP (sequences))
+    {
+      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;
+         sequences = remapped_sequences;
+         remapped = 1;
+       }
 
-         /* Fill in the cache.  */
-         GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
-         where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
-         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;
 
-         where_is_cache_keymaps = keymaps;
+      /* 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;
        }
 
-      /* 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;
+      /* 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 @@ where_is_internal_1 (key, binding, args, data)
 {
   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