Merged in changes from CVS trunk.
[bpt/emacs.git] / src / keymap.c
index 75de7e9..0e68c38 100644 (file)
@@ -1,5 +1,5 @@
 /* Manipulation of keymaps
-   Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 2001
+   Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 01, 2004
    Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -27,6 +27,7 @@ Boston, MA 02111-1307, USA.  */
 #include "buffer.h"
 #include "charset.h"
 #include "keyboard.h"
+#include "frame.h"
 #include "termhooks.h"
 #include "blockinput.h"
 #include "puresize.h"
@@ -121,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));
 \f
 /* Keymap object support - constructors and predicates.                        */
@@ -412,7 +416,8 @@ PARENT should be nil or another keymap.  */)
        {
          Lisp_Object indices[3];
 
-         map_char_table (fix_submap_inheritance, Qnil, XCAR (list),
+         map_char_table (fix_submap_inheritance, Qnil,
+                         XCAR (list), XCAR (list),
                          keymap, 0, indices);
        }
     }
@@ -640,6 +645,102 @@ access_keymap (map, idx, t_ok, noinherit, autoload)
   }
 }
 
+static void
+map_keymap_item (fun, args, key, val, data)
+     map_keymap_function_t fun;
+     Lisp_Object args, key, val;
+     void *data;
+{
+  /* We should maybe try to detect bindings shadowed by previous
+     ones and things like that.  */
+  if (EQ (val, Qt))
+    val = Qnil;
+  (*fun) (key, val, args, data);
+}
+
+static void
+map_keymap_char_table_item (args, key, val)
+     Lisp_Object args, key, val;
+{
+  if (!NILP (val))
+    {
+      map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer;
+      args = XCDR (args);
+      map_keymap_item (fun, XCDR (args), key, val,
+                      XSAVE_VALUE (XCAR (args))->pointer);
+    }
+}
+
+/* Call FUN for every binding in MAP.
+   FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
+   AUTOLOAD if non-zero means that we can autoload keymaps if necessary.  */
+void
+map_keymap (map, fun, args, data, autoload)
+     map_keymap_function_t fun;
+     Lisp_Object map, args;
+     void *data;
+     int autoload;
+{
+  struct gcpro gcpro1, gcpro2, gcpro3;
+  Lisp_Object tail;
+
+  GCPRO3 (map, args, tail);
+  map = get_keymap (map, 1, autoload);
+  for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
+       CONSP (tail) || (tail = get_keymap (tail, 0, autoload), CONSP (tail));
+       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))
+       {
+         /* Loop over the char values represented in the vector.  */
+         int len = ASIZE (binding);
+         int c;
+         for (c = 0; c < len; c++)
+           {
+             Lisp_Object character;
+             XSETFASTINT (character, c);
+             map_keymap_item (fun, args, character, AREF (binding, c), data);
+           }
+       }
+      else if (CHAR_TABLE_P (binding))
+       {
+         Lisp_Object indices[3];
+         map_char_table (map_keymap_char_table_item, Qnil, binding, binding,
+                         Fcons (make_save_value (fun, 0),
+                                Fcons (make_save_value (data, 0),
+                                       args)),
+                         0, indices);
+       }
+    }
+  UNGCPRO;
+}
+
+static void
+map_keymap_call (key, val, fun, dummy)
+     Lisp_Object key, val, fun;
+     void *dummy;
+{
+  call2 (fun, key, val);
+}
+
+DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 2, 0,
+       doc: /* Call FUNCTION for every binding in KEYMAP.
+FUNCTION is called with two arguments: the event and its binding.  */)
+     (function, keymap)
+     Lisp_Object function, keymap;
+{
+  if (INTEGERP (function))
+    /* We have to stop integers early since map_keymap gives them special
+       significance.  */
+    Fsignal (Qinvalid_function, Fcons (function, Qnil));
+  map_keymap (keymap, map_keymap_call, function, NULL, 1);
+  return Qnil;
+}
+
 /* Given OBJECT which was found in a slot in a keymap,
    trace indirect definitions to get the actual definition of that slot.
    An indirect definition is a list of the form
@@ -914,7 +1015,7 @@ copy_keymap_item (elt)
   return res;
 }
 
-void
+static void
 copy_keymap_1 (chartable, idx, elt)
      Lisp_Object chartable, idx, elt;
 {
@@ -943,7 +1044,7 @@ is not copied.  */)
        {
          Lisp_Object indices[3];
          elt = Fcopy_sequence (elt);
-         map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices);
+         map_char_table (copy_keymap_1, Qnil, elt, elt, elt, 0, indices);
        }
       else if (VECTORP (elt))
        {
@@ -1063,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)));
     }
 }
 
@@ -1659,43 +1760,54 @@ accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized)
 {
   Lisp_Object tem;
 
-  cmd = get_keyelt (cmd, 0);
+  cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
   if (NILP (cmd))
     return;
 
-  tem = get_keymap (cmd, 0, 0);
-  if (CONSP (tem))
+  /* Look for and break cycles.  */
+  while (!NILP (tem = Frassq (cmd, maps)))
     {
-      cmd = tem;
-      /* Ignore keymaps that are already added to maps.  */
-      tem = Frassq (cmd, maps);
-      if (NILP (tem))
-       {
-         /* If the last key in thisseq is meta-prefix-char,
-            turn it into a meta-ized keystroke.  We know
-            that the event we're about to append is an
-            ascii keystroke since we're processing a
-            keymap table.  */
-         if (is_metized)
-           {
-             int meta_bit = meta_modifier;
-             Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
-             tem = Fcopy_sequence (thisseq);
+      Lisp_Object prefix = XCAR (tem);
+      int lim = XINT (Flength (XCAR (tem)));
+      if (lim <= XINT (Flength (thisseq)))
+       { /* This keymap was already seen with a smaller prefix.  */
+         int i = 0;
+         while (i < lim && EQ (Faref (prefix, make_number (i)),
+                               Faref (thisseq, make_number (i))))
+           i++;
+         if (i >= lim)
+           /* `prefix' is a prefix of `thisseq' => there's a cycle.  */
+           return;
+       }
+      /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
+        but maybe `cmd' occurs again further down in `maps', so keep
+        looking.  */
+      maps = XCDR (Fmemq (tem, maps));
+    }
 
-             Faset (tem, last, make_number (XINT (key) | meta_bit));
+  /* If the last key in thisseq is meta-prefix-char,
+     turn it into a meta-ized keystroke.  We know
+     that the event we're about to append is an
+     ascii keystroke since we're processing a
+     keymap table.  */
+  if (is_metized)
+    {
+      int meta_bit = meta_modifier;
+      Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
+      tem = Fcopy_sequence (thisseq);
 
-             /* This new sequence is the same length as
-                thisseq, so stick it in the list right
-                after this one.  */
-             XSETCDR (tail,
-                      Fcons (Fcons (tem, cmd), XCDR (tail)));
-           }
-         else
-           {
-             tem = append_key (thisseq, key);
-             nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
-           }
-       }
+      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.  */
+      XSETCDR (tail,
+              Fcons (Fcons (tem, cmd), XCDR (tail)));
+    }
+  else
+    {
+      tem = append_key (thisseq, key);
+      nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
     }
 }
 
@@ -1723,7 +1835,7 @@ then the value includes only maps for prefixes that start with PREFIX.  */)
      (keymap, prefix)
      Lisp_Object keymap, prefix;
 {
-  Lisp_Object maps, good_maps, tail;
+  Lisp_Object maps, tail;
   int prefixlen = 0;
 
   /* no need for gcpro because we don't autoload any keymaps.  */
@@ -1806,7 +1918,7 @@ then the value includes only maps for prefixes that start with PREFIX.  */)
            {
              Lisp_Object indices[3];
 
-             map_char_table (accessible_keymaps_char_table, Qnil,
+             map_char_table (accessible_keymaps_char_table, Qnil, elt,
                              elt, Fcons (Fcons (maps, make_number (is_metized)),
                                          Fcons (tail, thisseq)),
                              0, indices);
@@ -1829,113 +1941,116 @@ then the value includes only maps for prefixes that start with PREFIX.  */)
        }
     }
 
-  if (NILP (prefix))
-    return maps;
-
-  /* Now find just the maps whose access prefixes start with PREFIX.  */
-
-  good_maps = Qnil;
-  for (; CONSP (maps); maps = XCDR (maps))
-    {
-      Lisp_Object elt, thisseq;
-      elt = XCAR (maps);
-      thisseq = XCAR (elt);
-      /* The access prefix must be at least as long as PREFIX,
-        and the first elements must match those of PREFIX.  */
-      if (XINT (Flength (thisseq)) >= prefixlen)
-       {
-         int i;
-         for (i = 0; i < prefixlen; i++)
-           {
-             Lisp_Object i1;
-             XSETFASTINT (i1, i);
-             if (!EQ (Faref (thisseq, i1), Faref (prefix, i1)))
-               break;
-           }
-         if (i == prefixlen)
-           good_maps = Fcons (elt, good_maps);
-       }
-    }
-
-  return Fnreverse (good_maps);
+  return maps;
 }
 \f
 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));
 
-  if (STRINGP (keys))
+  /* 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)
        {
-         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;
@@ -2240,6 +2355,8 @@ shadow_lookup (shadow, key, flag)
   return Qnil;
 }
 
+static Lisp_Object Vmouse_events;
+
 /* This function can GC if Flookup_key autoloads any keymaps.  */
 
 static Lisp_Object
@@ -2278,7 +2395,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
   for (; !NILP (maps); maps = Fcdr (maps))
     {
       /* Key sequence to reach map, and the map that it reaches */
-      register Lisp_Object this, map;
+      register Lisp_Object this, map, tem;
 
       /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
         [M-CHAR] sequences, check if last character of the sequence
@@ -2294,7 +2411,8 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
 
       /* if (nomenus && !ascii_sequence_p (this)) */
       if (nomenus && XINT (last) >= 0
-         && !INTEGERP (Faref (this, make_number (0))))
+         && SYMBOLP (tem = Faref (this, make_number (0)))
+         && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
        /* If no menu entries should be returned, skip over the
           keymaps bound to `menu-bar' and `tool-bar' and other
           non-ascii prefixes like `C-down-mouse-2'.  */
@@ -2348,7 +2466,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
                            Fcons (Fcons (this, last),
                                   Fcons (make_number (nomenus),
                                          make_number (last_is_meta))));
-             map_char_table (where_is_internal_2, Qnil, elt, args,
+             map_char_table (where_is_internal_2, Qnil, elt, elt, args,
                              0, indices);
              sequences = XCDR (XCAR (args));
            }
@@ -2854,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");
        }
@@ -2979,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))
@@ -2989,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;
@@ -3012,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");
 
@@ -3030,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))
     {
@@ -3039,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;
@@ -3084,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
@@ -3101,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);
        }
     }
 
@@ -3131,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);
 }
@@ -3166,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
@@ -3203,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");
@@ -3300,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;
@@ -3317,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))
@@ -3358,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.  */
@@ -3374,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,
@@ -3383,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;
        }
 
@@ -3423,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);
 
@@ -3430,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)
                {
@@ -3449,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));
            }
        }
 
@@ -3496,7 +3619,6 @@ Return list of symbols found.  */)
      Lisp_Object regexp, predicate;
 {
   Lisp_Object tem;
-  struct gcpro gcpro1, gcpro2;
   CHECK_STRING (regexp);
   apropos_predicate = predicate;
   apropos_accumulate = Qnil;
@@ -3627,6 +3749,19 @@ This keymap works like `function-key-map', but comes after that,
 and applies even for keys that have ordinary bindings.  */);
   Vkey_translation_map = Qnil;
 
+  staticpro (&Vmouse_events);
+  Vmouse_events = Fcons (intern ("menu-bar"),
+                 Fcons (intern ("tool-bar"),
+                 Fcons (intern ("header-line"),
+                 Fcons (intern ("mode-line"),
+                 Fcons (intern ("mouse-1"),
+                 Fcons (intern ("mouse-2"),
+                 Fcons (intern ("mouse-3"),
+                 Fcons (intern ("mouse-4"),
+                 Fcons (intern ("mouse-5"),
+                        Qnil)))))))));
+
+
   Qsingle_key_description = intern ("single-key-description");
   staticpro (&Qsingle_key_description);
 
@@ -3659,6 +3794,7 @@ and applies even for keys that have ordinary bindings.  */);
   defsubr (&Sset_keymap_parent);
   defsubr (&Smake_keymap);
   defsubr (&Smake_sparse_keymap);
+  defsubr (&Smap_keymap);
   defsubr (&Scopy_keymap);
   defsubr (&Scommand_remapping);
   defsubr (&Skey_binding);
@@ -3690,3 +3826,6 @@ keys_of_keymap ()
   initial_define_key (global_map, 033, "ESC-prefix");
   initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
 }
+
+/* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
+   (do not change this comment) */