changeset 104918:cd8d62c35d57

* 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.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Thu, 10 Sep 2009 16:19:52 +0000
parents 2d6dc187388c
children ad7987e70109
files src/ChangeLog src/doc.c src/keyboard.c src/keymap.c
diffstat 4 files changed, 180 insertions(+), 187 deletions(-) [+]
line wrap: on
line diff
--- 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  <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>).
 
--- 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))
--- 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))
--- 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