diff src/keymap.c @ 54925:f0a7441d22f6

(Fkey_description): Add optional PREFIX arg. Combine prefix with KEYS to make up the full key sequence to describe. Correlate meta_prefix_char and following (simple) key to describe as meta modifier. All callers changed. (describe_map): Rename arg `keys' to `prefix'. Remove local `elt_prefix' var. Use Fkey_description with prefix instead of elt_prefix combined with Fsingle_key_description. (describe_vector): Declare static. Replace arg `elt_prefix' with `prefix'. Add KEYMAP_P arg. Add local var `elt_prefix'; use it if !KEYMAP_P. Use Fkey_description with prefix instead of Fsingle_key_description.

--- a/src/keymap.c	Fri Apr 16 21:16:06 2004 +0000
+++ b/src/keymap.c	Fri Apr 16 21:16:33 2004 +0000
@@ -121,6 +121,9 @@
 static void describe_map P_ ((Lisp_Object, Lisp_Object,
 			      void (*) P_ ((Lisp_Object, Lisp_Object)),
 			      int, Lisp_Object, Lisp_Object*, int));
+static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
+				 void (*) (Lisp_Object, Lisp_Object), int,
+				 Lisp_Object, Lisp_Object, int *, int, int));
 static void silly_event_symbol_error P_ ((Lisp_Object));
 
 /* Keymap object support - constructors and predicates.			*/
@@ -687,7 +690,7 @@
        tail = XCDR (tail))
     {
       Lisp_Object binding = XCAR (tail);
-      
+
       if (CONSP (binding))
 	map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
       else if (VECTORP (binding))
@@ -1160,7 +1163,7 @@
 	/* We must use Fkey_description rather than just passing key to
 	   error; key might be a vector, not a string.  */
 	error ("Key sequence %s uses invalid prefix characters",
-	       SDATA (Fkey_description (key)));
+	       SDATA (Fkey_description (key, Qnil)));
     }
 }
 
@@ -1791,9 +1794,9 @@
       int meta_bit = meta_modifier;
       Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
       tem = Fcopy_sequence (thisseq);
-      
+
       Faset (tem, last, make_number (XINT (key) | meta_bit));
-      
+
       /* This new sequence is the same length as
 	 thisseq, so stick it in the list right
 	 after this one.  */
@@ -1944,78 +1947,109 @@
 
 /* This function cannot GC.  */
 
-DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
+DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
        doc: /* Return a pretty description of key-sequence KEYS.
+Optional arg PREFIX is the sequence of keys leading up to KEYS.
 Control characters turn into "C-foo" sequences, meta into "M-foo"
 spaces are put between sequence elements, etc.  */)
-     (keys)
-     Lisp_Object keys;
+  (keys, prefix)
+     Lisp_Object keys, prefix;
 {
   int len = 0;
   int i, i_byte;
-  Lisp_Object sep;
-  Lisp_Object *args = NULL;
-
-  if (STRINGP (keys))
+  Lisp_Object *args;
+  int size = Flength (keys);
+  Lisp_Object list;
+  Lisp_Object sep = build_string (" ");
+  Lisp_Object key;
+  int add_meta = 0;
+
+  if (!NILP (prefix))
+    size += Flength (prefix);
+
+  /* This has one extra element at the end that we don't pass to Fconcat.  */
+  args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
+
+  /* In effect, this computes
+     (mapconcat 'single-key-description keys " ")
+     but we shouldn't use mapconcat because it can do GC.  */
+
+ next_list:
+  if (!NILP (prefix))
+    list = prefix, prefix = Qnil;
+  else if (!NILP (keys))
+    list = keys, keys = Qnil;
+  else
     {
-      Lisp_Object vector;
-      vector = Fmake_vector (Flength (keys), Qnil);
-      for (i = 0, i_byte = 0; i < SCHARS (keys); )
+      if (add_meta)
+	{
+	  args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
+	  len += 2;
+	}
+      else if (len == 0)
+	return empty_string;
+      return Fconcat (len - 1, args);
+    }
+
+  if (STRINGP (list))
+    size = SCHARS (list);
+  else if (VECTORP (list))
+    size = XVECTOR (list)->size;
+  else if (CONSP (list))
+    size = Flength (list);
+  else
+    wrong_type_argument (Qarrayp, list);
+
+  i = i_byte = 0;
+
+  while (i < size)
+    {
+      if (STRINGP (list))
 	{
 	  int c;
-	  int i_before = i;
-
-	  FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte);
+	  FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
 	  if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
 	    c ^= 0200 | meta_modifier;
-	  XSETFASTINT (AREF (vector, i_before), c);
+	  XSETFASTINT (key, c);
+	}
+      else if (VECTORP (list))
+	{
+	  key = AREF (list, i++);
+	}
+      else
+	{
+	  key = XCAR (list);
+	  list = XCDR (list);
+	  i++;
 	}
-      keys = vector;
-    }
-
-  if (VECTORP (keys))
-    {
-      /* In effect, this computes
-	 (mapconcat 'single-key-description keys " ")
-	 but we shouldn't use mapconcat because it can do GC.  */
-
-      len = XVECTOR (keys)->size;
-      sep = build_string (" ");
-      /* This has one extra element at the end that we don't pass to Fconcat.  */
-      args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
-
-      for (i = 0; i < len; i++)
+
+      if (add_meta)
 	{
-	  args[i * 2] = Fsingle_key_description (AREF (keys, i), Qnil);
-	  args[i * 2 + 1] = sep;
+	  if (!INTEGERP (key)
+	      || EQ (key, meta_prefix_char)
+	      || (XINT (key) & meta_modifier))
+	    {
+	      args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
+	      args[len++] = sep;
+	      if (EQ (key, meta_prefix_char))
+		continue;
+	    }
+	  else
+	    XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
+	  add_meta = 0;
 	}
+      else if (EQ (key, meta_prefix_char))
+	{
+	  add_meta = 1;
+	  continue;
+	}
+      args[len++] = Fsingle_key_description (key, Qnil);
+      args[len++] = sep;
     }
-  else if (CONSP (keys))
-    {
-      /* In effect, this computes
-	 (mapconcat 'single-key-description keys " ")
-	 but we shouldn't use mapconcat because it can do GC.  */
-
-      len = XFASTINT (Flength (keys));
-      sep = build_string (" ");
-      /* This has one extra element at the end that we don't pass to Fconcat.  */
-      args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
-
-      for (i = 0; i < len; i++)
-	{
-	  args[i * 2] = Fsingle_key_description (XCAR (keys), Qnil);
-	  args[i * 2 + 1] = sep;
-	  keys = XCDR (keys);
-	}
-    }
-  else
-    keys = wrong_type_argument (Qarrayp, keys);
-
-  if (len == 0)
-    return empty_string;
-  return Fconcat (len * 2 - 1, args);
+  goto next_list;
 }
 
+
 char *
 push_key_description (c, p, force_multibyte)
      register unsigned int c;
@@ -2937,7 +2971,7 @@
 	  if (!NILP (prefix))
 	    {
 	      insert_string (" Starting With ");
-	      insert1 (Fkey_description (prefix));
+	      insert1 (Fkey_description (prefix, Qnil));
 	    }
 	  insert_string (":\n");
 	}
@@ -3062,7 +3096,7 @@
     }
   else if (STRINGP (definition) || VECTORP (definition))
     {
-      insert1 (Fkey_description (definition));
+      insert1 (Fkey_description (definition, Qnil));
       insert_string ("\n");
     }
   else if (KEYMAPP (definition))
@@ -3072,20 +3106,19 @@
 }
 
 /* Describe the contents of map MAP, assuming that this map itself is
-   reached by the sequence of prefix keys KEYS (a string or vector).
+   reached by the sequence of prefix keys PREFIX (a string or vector).
    PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above.  */
 
 static void
-describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
+describe_map (map, prefix, elt_describer, partial, shadow, seen, nomenu)
      register Lisp_Object map;
-     Lisp_Object keys;
+     Lisp_Object prefix;
      void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
      int partial;
      Lisp_Object shadow;
      Lisp_Object *seen;
      int nomenu;
 {
-  Lisp_Object elt_prefix;
   Lisp_Object tail, definition, event;
   Lisp_Object tem;
   Lisp_Object suppress;
@@ -3095,15 +3128,6 @@
 
   suppress = Qnil;
 
-  if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
-    {
-      /* Call Fkey_description first, to avoid GC bug for the other string.  */
-      tem = Fkey_description (keys);
-      elt_prefix = concat2 (tem, build_string (" "));
-    }
-  else
-    elt_prefix = Qnil;
-
   if (partial)
     suppress = intern ("suppress-keymap");
 
@@ -3113,7 +3137,7 @@
   kludge = Fmake_vector (make_number (1), Qnil);
   definition = Qnil;
 
-  GCPRO3 (elt_prefix, definition, kludge);
+  GCPRO3 (prefix, definition, kludge);
 
   for (tail = map; CONSP (tail); tail = XCDR (tail))
     {
@@ -3122,13 +3146,13 @@
       if (VECTORP (XCAR (tail))
 	  || CHAR_TABLE_P (XCAR (tail)))
 	describe_vector (XCAR (tail),
-			 elt_prefix, Qnil, elt_describer, partial, shadow, map,
-			 (int *)0, 0);
+			 prefix, Qnil, elt_describer, partial, shadow, map,
+			 (int *)0, 0, 1);
       else if (CONSP (XCAR (tail)))
 	{
 	  event = XCAR (XCAR (tail));
 
-	  /* Ignore bindings whose "keys" are not really valid events.
+	  /* Ignore bindings whose "prefix" are not really valid events.
 	     (We get these in the frames and buffers menu.)  */
 	  if (!(SYMBOLP (event) || INTEGERP (event)))
 	    continue;
@@ -3167,11 +3191,8 @@
 	      first = 0;
 	    }
 
-	  if (!NILP (elt_prefix))
-	    insert1 (elt_prefix);
-
 	  /* THIS gets the string to describe the character EVENT.  */
-	  insert1 (Fsingle_key_description (event, Qnil));
+	  insert1 (Fkey_description (kludge, prefix));
 
 	  /* Print a description of the definition of this character.
 	     elt_describer will take care of spacing out far enough
@@ -3184,9 +3205,9 @@
 	     using an inherited keymap.  So skip anything we've already
 	     encountered.  */
 	  tem = Fassq (tail, *seen);
-	  if (CONSP (tem) && !NILP (Fequal (XCAR (tem), keys)))
+	  if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
 	    break;
-	  *seen = Fcons (Fcons (tail, keys), *seen);
+	  *seen = Fcons (Fcons (tail, prefix), *seen);
 	}
     }
 
@@ -3214,7 +3235,7 @@
   specbind (Qstandard_output, Fcurrent_buffer ());
   CHECK_VECTOR_OR_CHAR_TABLE (vector);
   describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
-		   Qnil, Qnil, (int *)0, 0);
+		   Qnil, Qnil, (int *)0, 0, 0);
 
   return unbind_to (count, Qnil);
 }
@@ -3249,28 +3270,32 @@
    indices at higher levels in this char-table,
    and CHAR_TABLE_DEPTH says how many levels down we have gone.
 
+   KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
+
    ARGS is simply passed as the second argument to ELT_DESCRIBER.  */
 
-void
-describe_vector (vector, elt_prefix, args, elt_describer,
+static void
+describe_vector (vector, prefix, args, elt_describer,
 		 partial, shadow, entire_map,
-		 indices, char_table_depth)
+		 indices, char_table_depth, keymap_p)
      register Lisp_Object vector;
-     Lisp_Object elt_prefix, args;
+     Lisp_Object prefix, args;
      void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
      int partial;
      Lisp_Object shadow;
      Lisp_Object entire_map;
      int *indices;
      int char_table_depth;
+     int keymap_p;
 {
   Lisp_Object definition;
   Lisp_Object tem2;
+  Lisp_Object elt_prefix = Qnil;
   register int i;
   Lisp_Object suppress;
   Lisp_Object kludge;
   int first = 1;
-  struct gcpro gcpro1, gcpro2, gcpro3;
+  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
   /* Range of elements to be handled.  */
   int from, to;
   /* A flag to tell if a leaf in this level of char-table is not a
@@ -3286,11 +3311,23 @@
 
   definition = Qnil;
 
+  if (!keymap_p)
+    {
+      /* Call Fkey_description first, to avoid GC bug for the other string.  */
+      if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
+	{
+	  Lisp_Object tem;
+	  tem = Fkey_description (prefix, Qnil);
+	  elt_prefix = concat2 (tem, build_string (" "));
+	}
+      prefix = Qnil;
+    }
+
   /* This vector gets used to present single keys to Flookup_key.  Since
      that is done once per vector element, we don't want to cons up a
      fresh vector every time.  */
   kludge = Fmake_vector (make_number (1), Qnil);
-  GCPRO3 (elt_prefix, definition, kludge);
+  GCPRO4 (elt_prefix, prefix, definition, kludge);
 
   if (partial)
     suppress = intern ("suppress-keymap");
@@ -3383,12 +3420,13 @@
       else
 	character = i;
 
+      ASET (kludge, 0, make_number (character));
+
       /* If this binding is shadowed by some other map, ignore it.  */
       if (!NILP (shadow) && complete_char)
 	{
 	  Lisp_Object tem;
 
-	  ASET (kludge, 0, make_number (character));
 	  tem = shadow_lookup (shadow, kludge, Qt);
 
 	  if (!NILP (tem)) continue;
@@ -3400,7 +3438,6 @@
 	{
 	  Lisp_Object tem;
 
-	  ASET (kludge, 0, make_number (character));
 	  tem = Flookup_key (entire_map, kludge, Qt);
 
 	  if (!EQ (tem, definition))
@@ -3441,7 +3478,7 @@
       else if (CHAR_TABLE_P (vector))
 	{
 	  if (complete_char)
-	    insert1 (Fsingle_key_description (make_number (character), Qnil));
+	    insert1 (Fkey_description (kludge, prefix));
 	  else
 	    {
 	      /* Print the information for this character set.  */
@@ -3457,7 +3494,7 @@
 	}
       else
 	{
-	  insert1 (Fsingle_key_description (make_number (character), Qnil));
+	  insert1 (Fkey_description (kludge, prefix));
 	}
 
       /* If we find a sub char-table within a char-table,
@@ -3466,9 +3503,9 @@
       if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
 	{
 	  insert ("\n", 1);
-	  describe_vector (definition, elt_prefix, args, elt_describer,
+	  describe_vector (definition, prefix, args, elt_describer,
 			   partial, shadow, entire_map,
-			   indices, char_table_depth + 1);
+			   indices, char_table_depth + 1, keymap_p);
 	  continue;
 	}
 
@@ -3506,6 +3543,8 @@
 	{
 	  insert (" .. ", 4);
 
+	  ASET (kludge, 0, make_number (i));
+
 	  if (!NILP (elt_prefix))
 	    insert1 (elt_prefix);
 
@@ -3513,7 +3552,7 @@
 	    {
 	      if (char_table_depth == 0)
 		{
-		  insert1 (Fsingle_key_description (make_number (i), Qnil));
+		  insert1 (Fkey_description (kludge, prefix));
 		}
 	      else if (complete_char)
 		{
@@ -3532,7 +3571,7 @@
 	    }
 	  else
 	    {
-	      insert1 (Fsingle_key_description (make_number (i), Qnil));
+	      insert1 (Fkey_description (kludge, prefix));
 	    }
 	}