1 files changed, 133 insertions, 94 deletions

diff --git a/src/keymap.c b/src/keymap.c
index 4cea62c10fb..0e68c38d677 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -122,6 +122,9 @@ static void describe_translation P_ ((Lisp_Object, Lisp_Object));
 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.                 */
@@ -688,7 +691,7 @@ map_keymap (map, fun, args, data, autoload)
        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))
@@ -1161,7 +1164,7 @@ binding KEY to DEF is added at the front of KEYMAP.  */)
         /* 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)));
     }
 }
 
@@ -1792,9 +1795,9 @@ accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized)
       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.  */
@@ -1945,78 +1948,109 @@ Lisp_Object Qsingle_key_description, Qkey_description;
 
 /* 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;
+  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.  */
 
-  if (STRINGP (keys))
+ 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)
         {
-          int c;
-          int i_before = i;
-
-          FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte);
-          if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
-            c ^= 0200 | meta_modifier;
-          XSETFASTINT (AREF (vector, i_before), c);
+          args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
+          len += 2;
         }
-      keys = vector;
+      else if (len == 0)
+        return empty_string;
+      return Fconcat (len - 1, args);
     }
 
-  if (VECTORP (keys))
-    {
-      /* In effect, this computes
-         (mapconcat 'single-key-description keys " ")
-         but we shouldn't use mapconcat because it can do GC.  */
+  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);
 
-      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));
+  i = i_byte = 0;
 
-      for (i = 0; i < len; i++)
+  while (i < size)
+    {
+      if (STRINGP (list))
         {
-          args[i * 2] = Fsingle_key_description (AREF (keys, i), Qnil);
-          args[i * 2 + 1] = sep;
+          int c;
+          FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
+          if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
+            c ^= 0200 | meta_modifier;
+          XSETFASTINT (key, c);
+        }
+      else if (VECTORP (list))
+        {
+          key = AREF (list, i++);
+        }
+      else
+        {
+          key = XCAR (list);
+          list = XCDR (list);
+          i++;
         }
-    }
-  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++)
+      if (add_meta)
+        {
+          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))
         {
-          args[i * 2] = Fsingle_key_description (XCAR (keys), Qnil);
-          args[i * 2 + 1] = sep;
-          keys = XCDR (keys);
+          add_meta = 1;
+          continue;
         }
+      args[len++] = Fsingle_key_description (key, Qnil);
+      args[len++] = sep;
     }
-  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;
@@ -2938,7 +2972,7 @@ key             binding\n\
           if (!NILP (prefix))
             {
               insert_string (" Starting With ");
-              insert1 (Fkey_description (prefix));
+              insert1 (Fkey_description (prefix, Qnil));
             }
           insert_string (":\n");
         }
@@ -3063,7 +3097,7 @@ describe_translation (definition, args)
     }
   else if (STRINGP (definition) || VECTORP (definition))
     {
-      insert1 (Fkey_description (definition));
+      insert1 (Fkey_description (definition, Qnil));
       insert_string ("\n");
     }
   else if (KEYMAPP (definition))
@@ -3073,20 +3107,19 @@ describe_translation (definition, args)
 }
 
 /* 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;
@@ -3096,15 +3129,6 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
 
   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");
 
@@ -3114,7 +3138,7 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
   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))
     {
@@ -3123,13 +3147,13 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
       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;
@@ -3168,11 +3192,8 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
               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
@@ -3185,9 +3206,9 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
              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);
         }
     }
 
@@ -3215,7 +3236,7 @@ This is text showing the elements of vector matched against indices.  */)
   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);
 }
@@ -3250,28 +3271,32 @@ This is text showing the elements of vector matched against indices.  */)
    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
@@ -3287,11 +3312,23 @@ describe_vector (vector, elt_prefix, args, elt_describer,
 
   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");
@@ -3384,12 +3421,13 @@ describe_vector (vector, elt_prefix, args, elt_describer,
       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;
@@ -3401,7 +3439,6 @@ describe_vector (vector, elt_prefix, args, elt_describer,
         {
           Lisp_Object tem;
 
-          ASET (kludge, 0, make_number (character));
           tem = Flookup_key (entire_map, kludge, Qt);
 
           if (!EQ (tem, definition))
@@ -3442,7 +3479,7 @@ describe_vector (vector, elt_prefix, args, elt_describer,
       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.  */
@@ -3458,7 +3495,7 @@ describe_vector (vector, elt_prefix, args, elt_describer,
         }
       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,
@@ -3467,9 +3504,9 @@ describe_vector (vector, elt_prefix, args, elt_describer,
       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;
         }
 
@@ -3507,6 +3544,8 @@ describe_vector (vector, elt_prefix, args, elt_describer,
         {
           insert (" .. ", 4);
 
+          ASET (kludge, 0, make_number (i));
+
           if (!NILP (elt_prefix))
             insert1 (elt_prefix);
 
@@ -3514,7 +3553,7 @@ describe_vector (vector, elt_prefix, args, elt_describer,
             {
               if (char_table_depth == 0)
                 {
-                  insert1 (Fsingle_key_description (make_number (i), Qnil));
+                  insert1 (Fkey_description (kludge, prefix));
                 }
               else if (complete_char)
                 {
@@ -3533,7 +3572,7 @@ describe_vector (vector, elt_prefix, args, elt_describer,
             }
           else
             {
-              insert1 (Fsingle_key_description (make_number (i), Qnil));
+              insert1 (Fkey_description (kludge, prefix));
             }
         }