changeset 90983:8cdd8b5fa891

Fix up failed merge from the trunk: (Faccessible_keymaps, where_is_internal): Use map_keymap. (where_is_internal_2): Remove. (where_is_internal_1): Update interface for its new use.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Mon, 16 Jul 2007 19:26:14 +0000
parents a66921565bcb
children a1be62cbd32a
files src/ChangeLog.unicode src/keymap.c
diffstat 2 files changed, 106 insertions(+), 250 deletions(-) [+]
line wrap: on
line diff
--- a/src/ChangeLog.unicode	Sun Jul 15 04:47:46 2007 +0000
+++ b/src/ChangeLog.unicode	Mon Jul 16 19:26:14 2007 +0000
@@ -42,7 +42,7 @@
 
 	* chartab.c (map_sub_char_table): Make it work for the top-level
 	char-table.  Fix handling of parent char-table.
-	(map_char_table):  Adjusted for the above change.
+	(map_char_table):  Adjust for the above change.
 
 2007-06-24  Jason Rumney  <jasonr@gnu.org>
 
--- a/src/keymap.c	Sun Jul 15 04:47:46 2007 +0000
+++ b/src/keymap.c	Mon Jul 16 19:26:14 2007 +0000
@@ -2219,54 +2219,26 @@
 
   for (tail = maps; CONSP (tail); tail = XCDR (tail))
     {
-      register Lisp_Object thisseq, thismap;
+      struct accessible_keymaps_data data;
+      register Lisp_Object thismap = Fcdr (XCAR (tail));
       Lisp_Object last;
+
+      data.thisseq = Fcar (XCAR (tail));
+      data.maps = maps;
+      data.tail = tail;
+      last = make_number (XINT (Flength (data.thisseq)) - 1);
       /* Does the current sequence end in the meta-prefix-char?  */
-      int is_metized;
-
-      thisseq = Fcar (Fcar (tail));
-      thismap = Fcdr (Fcar (tail));
-      last = make_number (XINT (Flength (thisseq)) - 1);
-      is_metized = (XINT (last) >= 0
+      data.is_metized = (XINT (last) >= 0
 		    /* Don't metize the last char of PREFIX.  */
 		    && XINT (last) >= prefixlen
-		    && EQ (Faref (thisseq, last), meta_prefix_char));
-
-      for (; CONSP (thismap); thismap = XCDR (thismap))
-	{
-	  Lisp_Object elt;
-
-	  elt = XCAR (thismap);
-
-	  QUIT;
-
-	  if (CHAR_TABLE_P (elt))
-	    {
-	      map_char_table (accessible_keymaps_char_table, Qnil,
-			      elt, Fcons (Fcons (maps, make_number (is_metized)),
-					  Fcons (tail, thisseq)));
-	    }
-	  else if (VECTORP (elt))
-	    {
-	      register int i;
-
-	      /* Vector keymap.  Scan all the elements.  */
-	      for (i = 0; i < ASIZE (elt); i++)
-		accessible_keymaps_1 (make_number (i), AREF (elt, i),
-				      maps, tail, thisseq, is_metized);
-
-	    }
-	  else if (CONSP (elt))
-	    accessible_keymaps_1 (XCAR (elt), XCDR (elt),
-				  maps, tail, thisseq,
-				  is_metized && INTEGERP (XCAR (elt)));
-
-	}
+		    && EQ (Faref (data.thisseq, last), meta_prefix_char));
+
+      /* Since we can't run lisp code, we can't scan autoloaded maps.  */
+      if (CONSP (thismap))
+	map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0);
     }
-
   return maps;
 }
-
 Lisp_Object Qsingle_key_description, Qkey_description;
 
 /* This function cannot GC.  */
@@ -2717,146 +2689,94 @@
 
       QUIT;
 
-      while (CONSP (map))
+      data.definition = definition;
+      data.noindirect = noindirect;
+      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))
 	{
-	  /* Because the code we want to run on each binding is rather
-	     large, we don't want to have two separate loop bodies for
-	     sparse keymap bindings and tables; we want to iterate one
-	     loop body over both keymap and vector bindings.
-
-	     For this reason, if Fcar (map) is a vector, we don't
-	     advance map to the next element until i indicates that we
-	     have finished off the vector.  */
-	  Lisp_Object elt, key, binding;
-	  elt = XCAR (map);
-	  map = XCDR (map);
-
-	  sequences = Qnil;
-
-	  QUIT;
-
-	  /* Set key and binding to the current key and binding, and
-	     advance map and i to the next binding.  */
-	  if (VECTORP (elt))
+	  Lisp_Object sequence, remapped, function;
+	  
+	  sequence = XCAR (sequences);
+	  sequences = XCDR (sequences);
+
+	  /* If the current sequence is a command remapping with
+	     format [remap COMMAND], find the key sequences
+	     which run COMMAND, and use those sequences instead.  */
+	  remapped = Qnil;
+	  if (NILP (no_remap)
+	      && VECTORP (sequence) && XVECTOR (sequence)->size == 2
+	      && EQ (AREF (sequence, 0), Qremap)
+	      && (function = AREF (sequence, 1), SYMBOLP (function)))
 	    {
-	      Lisp_Object sequence;
-	      int i;
-	      /* In a vector, look at each element.  */
-	      for (i = 0; i < XVECTOR (elt)->size; i++)
+	      Lisp_Object remapped1;
+	      
+	      remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
+	      if (CONSP (remapped1))
 		{
-		  binding = AREF (elt, i);
-		  XSETFASTINT (key, i);
-		  sequence = where_is_internal_1 (binding, key, definition,
-						  noindirect, this,
-						  last, nomenus, last_is_meta);
-		  if (!NILP (sequence))
-		    sequences = Fcons (sequence, sequences);
+		  /* Verify that this key binding actually maps to the
+		     remapped command (see below).  */
+		  if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
+		    continue;
+		  sequence = XCAR (remapped1);
+		  remapped = XCDR (remapped1);
+		  goto record_sequence;
 		}
 	    }
-	  else if (CHAR_TABLE_P (elt))
-	    {
-	      Lisp_Object args;
-
-	      args = Fcons (Fcons (Fcons (definition, noindirect),
-				   Qnil), /* Result accumulator.  */
-			    Fcons (Fcons (this, last),
-				   Fcons (make_number (nomenus),
-					  make_number (last_is_meta))));
-	      map_char_table (where_is_internal_2, Qnil, elt, args);
-	      sequences = XCDR (XCAR (args));
-	    }
-	  else if (CONSP (elt))
-	    {
-	      Lisp_Object sequence;
-
-	      key = XCAR (elt);
-	      binding = XCDR (elt);
-
-	      sequence = where_is_internal_1 (binding, key, definition,
-					      noindirect, this,
-					      last, nomenus, last_is_meta);
-	      if (!NILP (sequence))
-		sequences = Fcons (sequence, sequences);
-	    }
-
-
-	  while (!NILP (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;
+
+	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 sequence, remapped, function;
-
-	      sequence = XCAR (sequences);
-	      sequences = XCDR (sequences);
-
-	      /* If the current sequence is a command remapping with
-		 format [remap COMMAND], find the key sequences
-		 which run COMMAND, and use those sequences instead.  */
-	      remapped = Qnil;
-	      if (NILP (no_remap)
-		  && VECTORP (sequence) && XVECTOR (sequence)->size == 2
-		  && EQ (AREF (sequence, 0), Qremap)
-		  && (function = AREF (sequence, 1), SYMBOLP (function)))
-		{
-		  Lisp_Object remapped1;
-
-		  remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
-		  if (CONSP (remapped1))
-		    {
-		      /* Verify that this key binding actually maps to the
-			 remapped command (see below).  */
-		      if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
-			continue;
-		      sequence = XCAR (remapped1);
-		      remapped = XCDR (remapped1);
-		      goto record_sequence;
-		    }
-		}
-
-	      /* 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;
-
-	    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)))
-		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) && ascii_sequence_p (sequence))
-		RETURN_UNGCPRO (sequence);
-
-	      if (CONSP (remapped))
-		{
-		  sequence = XCAR (remapped);
-		  remapped = XCDR (remapped);
-		  goto record_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)))
+	    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) && ascii_sequence_p (sequence))
+	    RETURN_UNGCPRO (sequence);
+
+	  if (CONSP (remapped))
+	    {
+	      sequence = XCAR (remapped);
+	      remapped = XCDR (remapped);
+	      goto record_sequence;
 	    }
 	}
     }
@@ -2975,83 +2895,19 @@
   return result;
 }
 
-/* This is the function that Fwhere_is_internal calls using map_char_table.
-   ARGS has the form
-   (((DEFINITION . NOINDIRECT) . RESULT)
-    .
-    ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
-   Since map_char_table doesn't really use the return value from this function,
-   we the result append to RESULT, the slot in ARGS.
-
-   KEY may be a cons (FROM . TO) where both FROM and TO are integers
-   (i.e. character events).
-
-   This function can GC because it calls where_is_internal_1 which can
-   GC.  */
+/* This function can GC because get_keyelt can.  */
 
 static void
-where_is_internal_2 (args, key, binding)
-     Lisp_Object args, key, binding;
+where_is_internal_1 (key, binding, args, data)
+     Lisp_Object key, binding, args;
+     void *data;
 {
-  Lisp_Object definition, noindirect, this, last;
-  Lisp_Object result, sequence;
-  int nomenus, last_is_meta;
-  struct gcpro gcpro1, gcpro2, gcpro3;
-
-  GCPRO3 (args, key, binding);
-  definition = XCAR (XCAR (XCAR (args)));
-  noindirect = XCDR (XCAR (XCAR (args)));
-  this = XCAR (XCAR (XCDR (args)));
-  last = XCDR (XCAR (XCDR (args)));
-  nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
-  last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));
-
-  result = Qnil;
-  if (CONSP (key) && INTEGERP (XCAR (key)) && INTEGERP (XCDR (key)))
-    {
-      /* Try all ASCII characters.  Try also non-ASCII characters but
-	 only the first and last one because trying all of them is
-	 extremely memory and time consuming.
-
-	 Fixme: Perhaps it should be allowed to store a cons directly
-	 in RESULT.  -- handa@m17n.org   */
-      int from = XINT (XCAR (key)), to = XINT (XCDR (key));
-      Lisp_Object k;
-
-      for (; from <= to; to--)
-	{
-	  k = make_number (to);
-	  sequence = where_is_internal_1 (binding, k, definition, noindirect,
-					  this, last, nomenus, last_is_meta);
-	  if (!NILP (sequence))
-	    result = Fcons (sequence, result);
-	  if (to > 129)
-	    to = 129;
-	}
-    }
-  else
-    {
-      sequence = where_is_internal_1 (binding, key, definition, noindirect,
-				      this, last, nomenus, last_is_meta);
-      if (!NILP (sequence))
-	result = Fcons (sequence, Qnil);
-    }
-
-  if (! NILP (result))
-    nconc2 (XCAR (args), result);
-
-  UNGCPRO;
-}
-
-
-/* This function can GC because get_keyelt can.  */
-
-static Lisp_Object
-where_is_internal_1 (binding, key, definition, noindirect, this, last,
-		     nomenus, last_is_meta)
-     Lisp_Object binding, key, definition, noindirect, this, last;
-     int nomenus, last_is_meta;
-{
+  struct where_is_internal_data *d = data; /* Cast! */
+  Lisp_Object definition = d->definition;
+  Lisp_Object 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.  */