*** empty log message ***
[bpt/emacs.git] / src / keymap.c
index fe2368d..e1fbb1b 100644 (file)
@@ -1,5 +1,6 @@
 /* Manipulation of keymaps
-   Copyright (C) 1985, 86,87,88,93,94,95,98,99 Free Software Foundation, Inc.
+   Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000
+   Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -21,7 +22,6 @@ Boston, MA 02111-1307, USA.  */
 
 #include <config.h>
 #include <stdio.h>
-#undef NULL
 #include "lisp.h"
 #include "commands.h"
 #include "buffer.h"
@@ -33,6 +33,7 @@ Boston, MA 02111-1307, USA.  */
 #include "intervals.h"
 
 #define min(a, b) ((a) < (b) ? (a) : (b))
+#define KEYMAPP(m) (!NILP (Fkeymapp (m)))
 
 /* The number of elements in keymap vectors.  */
 #define DENSE_TABLE_SIZE (0200)
@@ -99,10 +100,16 @@ extern Lisp_Object meta_prefix_char;
 
 extern Lisp_Object Voverriding_local_map;
 
-static Lisp_Object define_as_prefix ();
-static Lisp_Object describe_buffer_bindings ();
-static void describe_command (), describe_translation ();
-static void describe_map ();
+static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
+static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
+
+static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object));
+static Lisp_Object describe_buffer_bindings P_ ((Lisp_Object));
+static void describe_command P_ ((Lisp_Object));
+static void describe_translation P_ ((Lisp_Object));
+static void describe_map P_ ((Lisp_Object, Lisp_Object,
+                             void (*) P_ ((Lisp_Object)),
+                             int, Lisp_Object, Lisp_Object*, int));
 \f
 /* Keymap object support - constructors and predicates.                        */
 
@@ -195,6 +202,7 @@ is also allowed as an element.")
   (object)
      Lisp_Object object;
 {
+  /* FIXME: Maybe this should return t for autoloaded keymaps?   -sm  */
   return (NILP (get_keymap_1 (object, 0, 0)) ? Qnil : Qt);
 }
 
@@ -212,7 +220,10 @@ is also allowed as an element.")
    Functions like Faccessible_keymaps which scan entire keymap trees
    shouldn't load every autoloaded keymap.  I'm not sure about this,
    but it seems to me that only read_key_sequence, Flookup_key, and
-   Fdefine_key should cause keymaps to be autoloaded.  */
+   Fdefine_key should cause keymaps to be autoloaded.
+
+   This function can GC when AUTOLOAD is non-zero, because it calls
+   do_autoload which can GC.  */
 
 Lisp_Object
 get_keymap_1 (object, error, autoload)
@@ -258,8 +269,7 @@ get_keymap_1 (object, error, autoload)
  end:
   if (error)
     wrong_type_argument (Qkeymapp, object);
-  else
-    return Qnil;
+  return Qnil;
 }
 
 
@@ -289,11 +299,23 @@ DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
   for (; CONSP (list); list = XCDR (list))
     {
       /* See if there is another `keymap'.  */
-      if (EQ (Qkeymap, XCAR (list)))
+      if (KEYMAPP (list))
        return list;
     }
 
-  return Qnil;
+  return get_keymap_1(list, 0, 1);
+}
+
+
+/* Check whether MAP is one of MAPS parents.  */
+int
+keymap_memberp (map, maps)
+     Lisp_Object map, maps;
+{
+  if (NILP (map)) return 0;
+  while (KEYMAPP (maps) && !EQ (map, maps))
+    maps = Fkeymap_parent (maps);
+  return (EQ (map, maps));
 }
 
 /* Set the parent keymap of MAP to PARENT.  */
@@ -305,11 +327,20 @@ PARENT should be nil or another keymap.")
      Lisp_Object keymap, parent;
 {
   Lisp_Object list, prev;
+  struct gcpro gcpro1;
   int i;
 
   keymap = get_keymap_1 (keymap, 1, 1);
+  GCPRO1 (keymap);
+  
   if (!NILP (parent))
-    parent = get_keymap_1 (parent, 1, 1);
+    {
+      parent = get_keymap_1 (parent, 1, 1);
+
+      /* Check for cycles.  */
+      if (keymap_memberp (keymap, parent))
+       error ("Cyclic keymap inheritance");
+    }
 
   /* Skip past the initial element `keymap'.  */
   prev = keymap;
@@ -318,12 +349,12 @@ PARENT should be nil or another keymap.")
       list = XCDR (prev);
       /* If there is a parent keymap here, replace it.
         If we came to the end, add the parent in PREV.  */
-      if (! CONSP (list) || EQ (Qkeymap, XCAR (list)))
+      if (! CONSP (list) || KEYMAPP (list))
        {
          /* If we already have the right parent, return now
             so that we avoid the loops below.  */
          if (EQ (XCDR (prev), parent))
-           return parent;
+           RETURN_UNGCPRO (parent);
 
          XCDR (prev) = parent;
          break;
@@ -360,14 +391,14 @@ PARENT should be nil or another keymap.")
        }
     }
 
-  return parent;
+  RETURN_UNGCPRO (parent);
 }
 
 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
    if EVENT is also a prefix in MAP's parent,
    make sure that SUBMAP inherits that definition as its own parent.  */
 
-void
+static void
 fix_submap_inheritance (map, event, submap)
      Lisp_Object map, event, submap;
 {
@@ -376,52 +407,23 @@ fix_submap_inheritance (map, event, submap)
   /* SUBMAP is a cons that we found as a key binding.
      Discard the other things found in a menu key binding.  */
 
-  if (CONSP (submap))
-    {
-      /* May be an old format menu item */
-      if (STRINGP (XCAR (submap)))
-       {
-         submap = XCDR (submap);
-         /* Also remove a menu help string, if any,
-            following the menu item name.  */
-         if (CONSP (submap) && STRINGP (XCAR (submap)))
-           submap = XCDR (submap);
-         /* Also remove the sublist that caches key equivalences, if any.  */
-         if (CONSP (submap)
-             && CONSP (XCAR (submap)))
-           {
-             Lisp_Object carcar;
-             carcar = XCAR (XCAR (submap));
-             if (NILP (carcar) || VECTORP (carcar))
-               submap = XCDR (submap);
-           }
-       }
-
-      /* Or a new format menu item */
-      else if (EQ (XCAR (submap), Qmenu_item)
-              && CONSP (XCDR (submap)))
-       {
-         submap = XCDR (XCDR (submap));
-         if (CONSP (submap))
-           submap = XCAR (submap);
-       }
-    }
+  submap = get_keymap_1 (get_keyelt (submap, 0), 0, 0);
 
   /* If it isn't a keymap now, there's no work to do.  */
-  if (! CONSP (submap)
-      || ! EQ (XCAR (submap), Qkeymap))
+  if (NILP (submap))
     return;
 
   map_parent = Fkeymap_parent (map);
   if (! NILP (map_parent))
-    parent_entry = access_keymap (map_parent, event, 0, 0);
+    parent_entry =
+      get_keymap_1 (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
   else
     parent_entry = Qnil;
 
   /* If MAP's parent has something other than a keymap,
-     our own submap shadows it completely, so use nil as SUBMAP's parent.  */
-  if (! (CONSP (parent_entry) && EQ (XCAR (parent_entry), Qkeymap)))
-    parent_entry = Qnil;
+     our own submap shadows it completely.  */
+  if (NILP (parent_entry))
+    return;
 
   if (! EQ (parent_entry, submap))
     {
@@ -430,12 +432,16 @@ fix_submap_inheritance (map, event, submap)
       while (1)
        {
          Lisp_Object tem;
+
          tem = Fkeymap_parent (submap_parent);
-         if (EQ (tem, parent_entry))
-           return;
-          if (CONSP (tem)
-             && EQ (XCAR (tem), Qkeymap))
-           submap_parent = tem;
+
+         if (KEYMAPP (tem))
+           {
+             if (keymap_memberp (tem, parent_entry))
+               /* Fset_keymap_parent could create a cycle.  */
+               return;
+             submap_parent = tem;
+           }
          else
            break;
        }
@@ -456,11 +462,12 @@ fix_submap_inheritance (map, event, submap)
    If NOINHERIT, don't accept a subkeymap found in an inherited keymap.  */
 
 Lisp_Object
-access_keymap (map, idx, t_ok, noinherit)
+access_keymap (map, idx, t_ok, noinherit, autoload)
      Lisp_Object map;
      Lisp_Object idx;
      int t_ok;
      int noinherit;
+     int autoload;
 {
   int noprefix = 0;
   Lisp_Object val;
@@ -479,12 +486,38 @@ access_keymap (map, idx, t_ok, noinherit)
        with more than 24 bits of integer.  */
     XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
 
+  /* Handle the special meta -> esc mapping. */
+  if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
+    {
+      /* See if there is a meta-map.  If there's none, there is
+         no binding for IDX, unless a default binding exists in MAP.  */
+      Lisp_Object meta_map =
+       get_keymap_1 (access_keymap (map, meta_prefix_char,
+                                    t_ok, noinherit, autoload),
+                     0, autoload);
+      if (!NILP (meta_map))
+       {
+         map = meta_map;
+         idx = make_number (XUINT (idx) & ~meta_modifier);
+       }
+      else if (t_ok)
+       /* Set IDX to t, so that we only find a default binding.  */
+       idx = Qt;
+      else
+       /* We know there is no binding.  */
+       return Qnil;
+    }
+
   {
     Lisp_Object tail;
     Lisp_Object t_binding;
 
     t_binding = Qnil;
-    for (tail = map; CONSP (tail); tail = XCDR (tail))
+    for (tail = XCDR (map);
+        (CONSP (tail)
+         || (tail = get_keymap_1 (tail, 0, autoload),
+             CONSP (tail)));
+        tail = XCDR (tail))
       {
        Lisp_Object binding;
 
@@ -493,7 +526,7 @@ access_keymap (map, idx, t_ok, noinherit)
          {
            /* If NOINHERIT, stop finding prefix definitions
               after we pass a second occurrence of the `keymap' symbol.  */
-           if (noinherit && EQ (binding, Qkeymap) && ! EQ (tail, map))
+           if (noinherit && EQ (binding, Qkeymap))
              noprefix = 1;
          }
        else if (CONSP (binding))
@@ -501,11 +534,11 @@ access_keymap (map, idx, t_ok, noinherit)
            if (EQ (XCAR (binding), idx))
              {
                val = XCDR (binding);
-               if (noprefix && CONSP (val) && EQ (XCAR (val), Qkeymap))
+               if (noprefix && KEYMAPP (val))
                  return Qnil;
                if (CONSP (val))
                  fix_submap_inheritance (map, idx, val);
-               return val;
+               return get_keyelt (val, autoload);
              }
            if (t_ok && EQ (XCAR (binding), Qt))
              t_binding = XCDR (binding);
@@ -515,11 +548,11 @@ access_keymap (map, idx, t_ok, noinherit)
            if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (binding)->size)
              {
                val = XVECTOR (binding)->contents[XFASTINT (idx)];
-               if (noprefix && CONSP (val) && EQ (XCAR (val), Qkeymap))
+               if (noprefix && KEYMAPP (val))
                  return Qnil;
                if (CONSP (val))
                  fix_submap_inheritance (map, idx, val);
-               return val;
+               return get_keyelt (val, autoload);
              }
          }
        else if (CHAR_TABLE_P (binding))
@@ -533,18 +566,18 @@ access_keymap (map, idx, t_ok, noinherit)
                         | CHAR_SHIFT | CHAR_CTL | CHAR_META)))
              {
                val = Faref (binding, idx);
-               if (noprefix && CONSP (val) && EQ (XCAR (val), Qkeymap))
+               if (noprefix && KEYMAPP (val))
                  return Qnil;
                if (CONSP (val))
                  fix_submap_inheritance (map, idx, val);
-               return val;
+               return get_keyelt (val, autoload);
              }
          }
 
        QUIT;
       }
 
-    return t_binding;
+    return get_keyelt (t_binding, autoload);
   }
 }
 
@@ -578,15 +611,34 @@ get_keyelt (object, autoload)
 
       /* If the keymap contents looks like (menu-item name . DEFN)
         or (menu-item name DEFN ...) then use DEFN.
-        This is a new format menu item.
-      */
+        This is a new format menu item.  */
       else if (EQ (XCAR (object), Qmenu_item))
        {
          if (CONSP (XCDR (object)))
            {
+             Lisp_Object tem;
+
              object = XCDR (XCDR (object));
+             tem = object;
              if (CONSP (object))
                object = XCAR (object);
+
+             /* If there's a `:filter FILTER', apply FILTER to the
+                menu-item's definition to get the real definition to
+                use.  Temporarily inhibit GC while evaluating FILTER,
+                because not functions calling get_keyelt are prepared
+                for a GC.  */
+             for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
+               if (EQ (XCAR (tem), QCfilter))
+                 {
+                   int count = inhibit_garbage_collection ();
+                   Lisp_Object filter;
+                   filter = XCAR (XCDR (tem));
+                   filter = list2 (filter, list2 (Qquote, object));
+                   object = menu_item_eval_property (filter);
+                   unbind_to (count, Qnil);
+                   break;
+                 }
            }
          else
            /* Invalid keymap */
@@ -616,31 +668,15 @@ get_keyelt (object, autoload)
       /* If the contents are (KEYMAP . ELEMENT), go indirect.  */
       else
        {
-         register Lisp_Object map;
+         Lisp_Object map;
          map = get_keymap_1 (Fcar_safe (object), 0, autoload);
-         if (NILP (map))
-           /* Invalid keymap */
-           return object;
-         else
-           {
-             Lisp_Object key;
-             key = Fcdr (object);
-             if (INTEGERP (key) && (XINT (key) & meta_modifier))
-               {
-                 object = access_keymap (map, meta_prefix_char, 0, 0);
-                 map = get_keymap_1 (object, 0, autoload);
-                 object = access_keymap (map, make_number (XINT (key)
-                                                           & ~meta_modifier),
-                                         0, 0);
-               }
-             else
-               object = access_keymap (map, key, 0, 0);
-           }
+         return (NILP (map) ? object /* Invalid keymap */
+                 : access_keymap (map, Fcdr (object), 0, 0, autoload));
        }
     }
 }
 
-Lisp_Object
+static Lisp_Object
 store_in_keymap (keymap, idx, def)
      Lisp_Object keymap;
      register Lisp_Object idx;
@@ -738,7 +774,7 @@ store_in_keymap (keymap, idx, def)
     XCDR (insertion_point)
       = Fcons (Fcons (idx, def), XCDR (insertion_point));
   }
-         
+  
   return def;
 }
 
@@ -954,7 +990,7 @@ the front of KEYMAP.")
       if (idx == length)
        RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
 
-      cmd = get_keyelt (access_keymap (keymap, c, 0, 1), 1);
+      cmd = access_keymap (keymap, c, 0, 1, 1);
 
       /* If this key is undefined, make it a prefix.  */
       if (NILP (cmd))
@@ -995,10 +1031,8 @@ recognize the default bindings, just as `read-key-sequence' does.")
   register int idx;
   register Lisp_Object cmd;
   register Lisp_Object c;
-  int metized = 0;
   int length;
   int t_ok = ! NILP (accept_default);
-  int meta_bit;
   struct gcpro gcpro1;
 
   keymap = get_keymap_1 (keymap, 1, 1);
@@ -1010,38 +1044,21 @@ recognize the default bindings, just as `read-key-sequence' does.")
   if (length == 0)
     return keymap;
 
-  if (VECTORP (key))
-    meta_bit = meta_modifier;
-  else
-    meta_bit = 0x80;
-
   GCPRO1 (key);
 
   idx = 0;
   while (1)
     {
-      c = Faref (key, make_number (idx));
+      c = Faref (key, make_number (idx++));
 
       if (CONSP (c) && lucid_event_type_list_p (c))
        c = Fevent_convert_list (c);
 
-      if (INTEGERP (c)
-         && (XINT (c) & meta_bit)
-         && !metized)
-       {
-         c = meta_prefix_char;
-         metized = 1;
-       }
-      else
-       {
-         if (INTEGERP (c))
-           XSETINT (c, XINT (c) & ~meta_bit);
-
-         metized = 0;
-         idx++;
-       }
+      /* Turn the 8th bit of string chars into a meta modifier.  */
+      if (XINT (c) & 0x80 && STRINGP (key))
+       XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
 
-      cmd = get_keyelt (access_keymap (keymap, c, t_ok, 0), 1);
+      cmd = access_keymap (keymap, c, t_ok, 0, 1);
       if (idx == length)
        RETURN_UNGCPRO (cmd);
 
@@ -1061,44 +1078,13 @@ static Lisp_Object
 define_as_prefix (keymap, c)
      Lisp_Object keymap, c;
 {
-  Lisp_Object inherit, cmd;
+  Lisp_Object cmd;
 
   cmd = Fmake_sparse_keymap (Qnil);
   /* If this key is defined as a prefix in an inherited keymap,
      make it a prefix in this map, and make its definition
      inherit the other prefix definition.  */
-  inherit = access_keymap (keymap, c, 0, 0);
-#if 0
-  /* This code is needed to do the right thing in the following case:
-     keymap A inherits from B,
-     you define KEY as a prefix in A,
-     then later you define KEY as a prefix in B.
-     We want the old prefix definition in A to inherit from that in B.
-     It is hard to do that retroactively, so this code
-     creates the prefix in B right away.
-
-     But it turns out that this code causes problems immediately
-     when the prefix in A is defined: it causes B to define KEY
-     as a prefix with no subcommands.
-
-     So I took out this code.  */
-  if (NILP (inherit))
-    {
-      /* If there's an inherited keymap
-        and it doesn't define this key,
-        make it define this key.  */
-      Lisp_Object tail;
-
-      for (tail = Fcdr (keymap); CONSP (tail); tail = XCDR (tail))
-       if (EQ (XCAR (tail), Qkeymap))
-         break;
-
-      if (!NILP (tail))
-       inherit = define_as_prefix (tail, c);
-    }
-#endif
-
-  cmd = nconc2 (cmd, inherit);
+  cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
   store_in_keymap (keymap, c, cmd);
 
   return cmd;
@@ -1204,9 +1190,9 @@ current_minor_maps (modeptr, mapptr)
                  BLOCK_INPUT;
                  cmm_size = 30;
                  newmodes
-                   = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
+                   = (Lisp_Object *) xmalloc (cmm_size * sizeof (Lisp_Object));
                  newmaps
-                   = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
+                   = (Lisp_Object *) xmalloc (cmm_size * sizeof (Lisp_Object));
                  UNBLOCK_INPUT;
                }
 
@@ -1729,10 +1715,10 @@ spaces are put between sequence elements, etc.")
   (keys)
      Lisp_Object keys;
 {
-  int len;
+  int len = 0;
   int i, i_byte;
   Lisp_Object sep;
-  Lisp_Object *args;
+  Lisp_Object *args = NULL;
 
   if (STRINGP (keys))
     {
@@ -1764,7 +1750,8 @@ spaces are put between sequence elements, etc.")
 
       for (i = 0; i < len; i++)
        {
-         args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i]);
+         args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i],
+                                                Qnil);
          args[i * 2 + 1] = sep;
        }
     }
@@ -1781,7 +1768,7 @@ spaces are put between sequence elements, etc.")
 
       for (i = 0; i < len; i++)
        {
-         args[i * 2] = Fsingle_key_description (XCAR (keys));
+         args[i * 2] = Fsingle_key_description (XCAR (keys), Qnil);
          args[i * 2 + 1] = sep;
          keys = XCDR (keys);
        }
@@ -1797,8 +1784,12 @@ push_key_description (c, p)
      register unsigned int c;
      register char *p;
 {
+  unsigned c2;
+  
   /* Clear all the meaningless bits above the meta bit.  */
   c &= meta_modifier | ~ - meta_modifier;
+  c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
+            | meta_modifier | shift_modifier | super_modifier);
 
   if (c & alt_modifier)
     {
@@ -1806,11 +1797,12 @@ push_key_description (c, p)
       *p++ = '-';
       c -= alt_modifier;
     }
-  if (c & ctrl_modifier)
+  if ((c & ctrl_modifier) != 0
+      || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
     {
       *p++ = 'C';
       *p++ = '-';
-      c -= ctrl_modifier;
+      c &= ~ctrl_modifier;
     }
   if (c & hyper_modifier)
     {
@@ -1858,8 +1850,7 @@ push_key_description (c, p)
        }
       else
        {
-         *p++ = 'C';
-         *p++ = '-';
+         /* `C-' already added above.  */
          if (c > 0 && c <= Ctl ('Z'))
            *p++ = c + 0140;
          else
@@ -1911,11 +1902,14 @@ push_key_description (c, p)
 
 /* This function cannot GC.  */
 
-DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0,
+DEFUN ("single-key-description", Fsingle_key_description,
+       Ssingle_key_description, 1, 2, 0,
   "Return a pretty description of command character KEY.\n\
-Control characters turn into C-whatever, etc.")
-  (key)
-     Lisp_Object key;
+Control characters turn into C-whatever, etc.\n\
+Optional argument NO-ANGLES non-nil means don't put angle brackets\n\
+around function keys and event symbols.")
+  (key, no_angles)
+     Lisp_Object key, no_angles;
 {
   if (CONSP (key) && lucid_event_type_list_p (key))
     key = Fevent_convert_list (key);
@@ -1953,14 +1947,21 @@ Control characters turn into C-whatever, etc.")
     }
   else if (SYMBOLP (key))      /* Function key or event-symbol */
     {
-      char *buffer = (char *) alloca (STRING_BYTES (XSYMBOL (key)->name) + 5);
-      sprintf (buffer, "<%s>", XSYMBOL (key)->name->data);
-      return build_string (buffer);
+      if (NILP (no_angles))
+       {
+         char *buffer
+           = (char *) alloca (STRING_BYTES (XSYMBOL (key)->name) + 5);
+         sprintf (buffer, "<%s>", XSYMBOL (key)->name->data);
+         return build_string (buffer);
+       }
+      else
+       return Fsymbol_name (key);
     }
   else if (STRINGP (key))      /* Buffer names in the menubar.  */
     return Fcopy_sequence (key);
   else
     error ("KEY must be an integer, cons, symbol, or string");
+  return Qnil;
 }
 
 char *
@@ -2048,6 +2049,15 @@ static void where_is_internal_2 ();
 
 /* This function can GC if Flookup_key autoloads any keymaps.  */
 
+static INLINE int
+menu_item_p (item)
+     Lisp_Object item;
+{
+  return (CONSP (item)
+         && (EQ (XCAR (item),Qmenu_item)
+             || STRINGP (XCAR (item))));
+}
+
 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
   "Return list of keys that invoke DEFINITION.\n\
 If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
@@ -2063,14 +2073,14 @@ and entirely reject menu bindings.\n\
 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
 to other keymaps or slots.  This makes it possible to search for an\n\
 indirect definition itself.")
-  (definition, keymap, firstonly, noindirect)
-     Lisp_Object definition, keymap;
+  (definition, xkeymap, firstonly, noindirect)
+     Lisp_Object definition, xkeymap;
      Lisp_Object firstonly, noindirect;
 {
   Lisp_Object maps;
   Lisp_Object found, sequences;
   Lisp_Object keymap1;
-  int keymap_specified = !NILP (keymap);
+  int keymap_specified = !NILP (xkeymap);
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
   /* 1 means ignore all menu bindings entirely.  */
   int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
@@ -2079,7 +2089,7 @@ indirect definition itself.")
      context.  But don't muck with the value of `keymap',
      because `where_is_internal_1' uses it to check for
      shadowed bindings. */
-  keymap1 = keymap;
+  keymap1 = xkeymap;
   if (! keymap_specified)
     keymap1 = get_local_map (PT, current_buffer, keymap);
     
@@ -2089,7 +2099,7 @@ indirect definition itself.")
                                        Qnil));
   else
     {
-      keymap1 = keymap;
+      keymap1 = xkeymap;
       if (! keymap_specified)
        keymap1 = get_local_map (PT, current_buffer, local_map);
     
@@ -2115,7 +2125,7 @@ indirect definition itself.")
        }
     }
 
-  GCPRO5 (definition, keymap, maps, found, sequences);
+  GCPRO5 (definition, xkeymap, maps, found, sequences);
   found = Qnil;
   sequences = Qnil;
 
@@ -2136,6 +2146,14 @@ indirect definition itself.")
       last_is_meta = (XINT (last) >= 0
                      && EQ (Faref (this, last), meta_prefix_char));
 
+      if (nomenus && XINT (last) >= 0)
+       { /* If no menu entries should be returned, skip over the
+            keymaps bound to `menu-bar' and `tool-bar'.  */
+         Lisp_Object tem = Faref (this, 0);
+         if (EQ (tem, Qmenu_bar) || EQ (tem, Qtool_bar))
+           continue;
+       }
+
       QUIT;
 
       while (CONSP (map))
@@ -2168,7 +2186,7 @@ indirect definition itself.")
                  binding = XVECTOR (elt)->contents[i];
                  XSETFASTINT (key, i);
                  sequence = where_is_internal_1 (binding, key, definition,
-                                                 noindirect, keymap, this,
+                                                 noindirect, xkeymap, this,
                                                  last, nomenus, last_is_meta);
                  if (!NILP (sequence))
                    sequences = Fcons (sequence, sequences);
@@ -2180,11 +2198,10 @@ indirect definition itself.")
              Lisp_Object args;
 
              args = Fcons (Fcons (Fcons (definition, noindirect),
-                                  Fcons (keymap, Qnil)),
+                                  Fcons (xkeymap, Qnil)),
                            Fcons (Fcons (this, last),
                                   Fcons (make_number (nomenus),
                                          make_number (last_is_meta))));
-
              map_char_table (where_is_internal_2, Qnil, elt, args,
                              0, indices);
              sequences = XCDR (XCDR (XCAR (args)));
@@ -2197,7 +2214,7 @@ indirect definition itself.")
              binding = XCDR (elt);
 
              sequence = where_is_internal_1 (binding, key, definition,
-                                             noindirect, keymap, this,
+                                             noindirect, xkeymap, this,
                                              last, nomenus, last_is_meta);
              if (!NILP (sequence))
                sequences = Fcons (sequence, sequences);
@@ -2246,7 +2263,10 @@ indirect definition itself.")
     .
     ((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.  */
+   we the result append to RESULT, the slot in ARGS.
+
+   This function can GC because it calls where_is_internal_1 which can
+   GC.  */
 
 static void
 where_is_internal_2 (args, key, binding)
@@ -2255,7 +2275,9 @@ where_is_internal_2 (args, key, binding)
   Lisp_Object definition, noindirect, keymap, this, last;
   Lisp_Object result, sequence;
   int nomenus, last_is_meta;
+  struct gcpro gcpro1, gcpro2, gcpro3;
 
+  GCPRO3 (args, key, binding);
   result = XCDR (XCDR (XCAR (args)));
   definition = XCAR (XCAR (XCAR (args)));
   noindirect = XCDR (XCAR (XCAR (args)));
@@ -2269,10 +2291,15 @@ where_is_internal_2 (args, key, binding)
                                  this, last, nomenus, last_is_meta);
 
   if (!NILP (sequence))
-    XCDR (XCDR (XCAR (args)))
-      = Fcons (sequence, result);
+    XCDR (XCDR (XCAR (args))) = Fcons (sequence, result);
+
+  UNGCPRO;
 }
 
+
+/* This function can GC.because Flookup_key calls get_keymap_1 with
+   non-zero argument AUTOLOAD.  */
+
 static Lisp_Object
 where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last,
                     nomenus, last_is_meta)
@@ -2281,32 +2308,15 @@ where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last,
 {
   Lisp_Object sequence;
   int keymap_specified = !NILP (keymap);
+  struct gcpro gcpro1, gcpro2;
 
+  /* Skip left-over menu-items.
+     These can appear in a keymap bound to a mouse click, for example.  */
+  if (nomenus && menu_item_p (binding))
+    return Qnil;
   /* Search through indirections unless that's not wanted.  */
   if (NILP (noindirect))
-    {
-      if (nomenus)
-       {
-         while (1)
-           {
-             Lisp_Object map, tem;
-             /* If the contents are (KEYMAP . ELEMENT), go indirect.  */
-             map = get_keymap_1 (Fcar_safe (definition), 0, 0);
-             tem = Fkeymapp (map);
-             if (!NILP (tem))
-               definition = access_keymap (map, Fcdr (definition), 0, 0);
-             else
-               break;
-           }
-         /* If the contents are (menu-item ...) or (STRING ...), reject.  */
-         if (CONSP (definition)
-             && (EQ (XCAR (definition),Qmenu_item)
-                 || STRINGP (XCAR (definition))))
-           return Qnil;
-       }
-      else
-       binding = get_keyelt (binding, 0);
-    }
+    binding = get_keyelt (binding, 0);
 
   /* End this iteration if this element does not match
      the target.  */
@@ -2341,6 +2351,7 @@ where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last,
 
      Either nil or number as value from Flookup_key
      means undefined.  */
+  GCPRO2 (sequence, binding);
   if (keymap_specified)
     {
       binding = Flookup_key (keymap, sequence, Qnil);
@@ -2351,21 +2362,21 @@ where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last,
              Lisp_Object tem;
              tem = Fequal (binding, definition);
              if (NILP (tem))
-               return Qnil;
+               RETURN_UNGCPRO (Qnil);
            }
          else
            if (!EQ (binding, definition))
-             return Qnil;
+             RETURN_UNGCPRO (Qnil);
        }
     }
   else
     {
       binding = Fkey_binding (sequence, Qnil);
       if (!EQ (binding, definition))
-       return Qnil;
+       RETURN_UNGCPRO (Qnil);
     }
 
-  return sequence;
+  RETURN_UNGCPRO (sequence);
 }
 \f
 /* describe-bindings - summarizing all the bindings in a set of keymaps.  */
@@ -2775,6 +2786,8 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
   int first = 1;
   struct gcpro gcpro1, gcpro2, gcpro3;
 
+  suppress = Qnil;
+
   if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
     {
       /* Call Fkey_description first, to avoid GC bug for the other string.  */
@@ -2851,7 +2864,7 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
            insert1 (elt_prefix);
 
          /* THIS gets the string to describe the character EVENT.  */
-         insert1 (Fsingle_key_description (event));
+         insert1 (Fsingle_key_description (event, Qnil));
 
          /* Print a description of the definition of this character.
             elt_describer will take care of spacing out far enough
@@ -2956,6 +2969,8 @@ describe_vector (vector, elt_prefix, elt_describer,
   int character;
   int starting_i;
 
+  suppress = Qnil;
+
   if (indices == 0)
     indices = (int *) alloca (3 * sizeof (int));
 
@@ -3116,7 +3131,7 @@ describe_vector (vector, elt_prefix, elt_describer,
       else if (CHAR_TABLE_P (vector))
        {
          if (complete_char)
-           insert1 (Fsingle_key_description (make_number (character)));
+           insert1 (Fsingle_key_description (make_number (character), Qnil));
          else
            {
              /* Print the information for this character set.  */
@@ -3132,7 +3147,7 @@ describe_vector (vector, elt_prefix, elt_describer,
        }
       else
        {
-         insert1 (Fsingle_key_description (make_number (character)));
+         insert1 (Fsingle_key_description (make_number (character), Qnil));
        }
 
       /* If we find a sub char-table within a char-table,
@@ -3188,7 +3203,7 @@ describe_vector (vector, elt_prefix, elt_describer,
            {
              if (char_table_depth == 0)
                {
-                 insert1 (Fsingle_key_description (make_number (i)));
+                 insert1 (Fsingle_key_description (make_number (i), Qnil));
                }
              else if (complete_char)
                {
@@ -3207,7 +3222,7 @@ describe_vector (vector, elt_prefix, elt_describer,
            }
          else
            {
-             insert1 (Fsingle_key_description (make_number (i)));
+             insert1 (Fsingle_key_description (make_number (i), Qnil));
            }
        }