(get_keymap_1, get_keyelt): Check the type of OBJECT
[bpt/emacs.git] / src / keymap.c
index 0ba367d..1b67338 100644 (file)
@@ -1,5 +1,5 @@
 /* Manipulation of keymaps
-   Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc.
+   Copyright (C) 1985, 86,87,88,93,94,95,98 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -21,6 +21,9 @@ Boston, MA 02111-1307, USA.  */
 
 #include <config.h>
 #include <stdio.h>
+#ifdef STDC_HEADERS
+#include <stdlib.h>
+#endif
 #undef NULL
 #include "lisp.h"
 #include "commands.h"
@@ -89,7 +92,7 @@ Lisp_Object Vkey_translation_map;
    when Emacs starts up.   t means don't record anything here.  */
 Lisp_Object Vdefine_key_rebound_commands;
 
-Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii;
+Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item;
 
 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
    in a string key sequence is equivalent to prefixing with this
@@ -102,13 +105,12 @@ static Lisp_Object define_as_prefix ();
 static Lisp_Object describe_buffer_bindings ();
 static void describe_command (), describe_translation ();
 static void describe_map ();
-Lisp_Object Fcopy_keymap ();
 \f
 /* Keymap object support - constructors and predicates.                        */
 
 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
-  "Construct and return a new keymap, of the form (keymap VECTOR . ALIST).\n\
-VECTOR is a vector which holds the bindings for the ASCII\n\
+  "Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).\n\
+CHARTABLE is a char-table that holds the bindings for the ASCII\n\
 characters.  ALIST is an assoc-list which holds bindings for function keys,\n\
 mouse events, and any other things that appear in the input stream.\n\
 All entries in it are initially nil, meaning \"command undefined\".\n\n\
@@ -222,9 +224,16 @@ get_keymap_1 (object, error, autoload)
   Lisp_Object tem;
 
  autoload_retry:
-  tem = indirect_function (object);
-  if (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap))
-    return tem;
+  if (NILP (object))
+    goto end;
+  if (CONSP (object) && EQ (XCAR (object), Qkeymap))
+    return object;
+  else
+    {
+      tem = indirect_function (object);
+      if (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap))
+       return tem;
+    }
 
   /* Should we do an autoload?  Autoload forms for keymaps have
      Qkeymap as their fifth element.  */
@@ -248,6 +257,7 @@ get_keymap_1 (object, error, autoload)
        }
     }
 
+ end:
   if (error)
     wrong_type_argument (Qkeymapp, object);
   else
@@ -368,22 +378,34 @@ 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)
-      && STRINGP (XCONS (submap)->car))
+  if (CONSP (submap))
     {
-      submap = XCONS (submap)->cdr;
-      /* Also remove a menu help string, if any,
-        following the menu item name.  */
-      if (CONSP (submap) && STRINGP (XCONS (submap)->car))
-       submap = XCONS (submap)->cdr;
-      /* Also remove the sublist that caches key equivalences, if any.  */
-      if (CONSP (submap)
-         && CONSP (XCONS (submap)->car))
+      /* May be an old format menu item */
+      if (STRINGP (XCONS (submap)->car))
        {
-         Lisp_Object carcar;
-         carcar = XCONS (XCONS (submap)->car)->car;
-         if (NILP (carcar) || VECTORP (carcar))
+         submap = XCONS (submap)->cdr;
+         /* Also remove a menu help string, if any,
+            following the menu item name.  */
+         if (CONSP (submap) && STRINGP (XCONS (submap)->car))
            submap = XCONS (submap)->cdr;
+         /* Also remove the sublist that caches key equivalences, if any.  */
+         if (CONSP (submap)
+             && CONSP (XCONS (submap)->car))
+           {
+             Lisp_Object carcar;
+             carcar = XCONS (XCONS (submap)->car)->car;
+             if (NILP (carcar) || VECTORP (carcar))
+               submap = XCONS (submap)->cdr;
+           }
+       }
+
+      /* Or a new format menu item */
+      else if (EQ (XCONS (submap)->car, Qmenu_item)
+              && CONSP (XCONS (submap)->cdr))
+       {
+         submap = XCONS (XCONS (submap)->cdr)->cdr;
+         if (CONSP (submap))
+           submap = XCONS (submap)->car;
        }
     }
 
@@ -531,53 +553,76 @@ get_keyelt (object, autoload)
 {
   while (1)
     {
-      register Lisp_Object map, tem;
+      if (!(CONSP (object)))
+       /* This is really the value.  */
+       return object;
 
-      /* If the contents are (KEYMAP . ELEMENT), go indirect.  */
-      map = get_keymap_1 (Fcar_safe (object), 0, autoload);
-      tem = Fkeymapp (map);
-      if (!NILP (tem))
+      /* If the keymap contents looks like (keymap ...) or (lambda ...)
+        then use itself. */
+      else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
+       return object;
+
+      /* 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.
+      */
+      else if (EQ (XCAR (object), Qmenu_item))
        {
-         Lisp_Object key;
-         key = Fcdr (object);
-         if (INTEGERP (key) && (XINT (key) & meta_modifier))
+         if (CONSP (XCDR (object)))
            {
-             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);
+             object = XCDR (XCDR (object));
+             if (CONSP (object))
+               object = XCAR (object);
            }
          else
-           object = access_keymap (map, key, 0, 0);
+           /* Invalid keymap */
+           return object;
        }
 
-      /* If the keymap contents looks like (STRING . DEFN),
-        use DEFN.
+      /* If the keymap contents looks like (STRING . DEFN), use DEFN.
         Keymap alist elements like (CHAR MENUSTRING . DEFN)
         will be used by HierarKey menus.  */
-      else if (CONSP (object)
-              && STRINGP (XCONS (object)->car))
+      else if (STRINGP (XCAR (object)))
        {
-         object = XCONS (object)->cdr;
+         object = XCDR (object);
          /* Also remove a menu help string, if any,
             following the menu item name.  */
-         if (CONSP (object) && STRINGP (XCONS (object)->car))
-           object = XCONS (object)->cdr;
+         if (CONSP (object) && STRINGP (XCAR (object)))
+           object = XCDR (object);
          /* Also remove the sublist that caches key equivalences, if any.  */
-         if (CONSP (object)
-             && CONSP (XCONS (object)->car))
+         if (CONSP (object) && CONSP (XCAR (object)))
            {
              Lisp_Object carcar;
-             carcar = XCONS (XCONS (object)->car)->car;
+             carcar = XCAR (XCAR (object));
              if (NILP (carcar) || VECTORP (carcar))
-               object = XCONS (object)->cdr;
+               object = XCDR (object);
            }
        }
 
+      /* If the contents are (KEYMAP . ELEMENT), go indirect.  */
       else
-       /* Anything else is really the value.  */
-       return object;
+       {
+         register 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);
+           }
+       }
     }
 }
 
@@ -588,8 +633,9 @@ store_in_keymap (keymap, idx, def)
      register Lisp_Object def;
 {
   /* If we are preparing to dump, and DEF is a menu element
-     with a menu item string, copy it to ensure it is not pure.  */
-  if (CONSP (def) && PURE_P (def) && STRINGP (XCONS (def)->car))
+     with a menu item indicator, copy it to ensure it is not pure.  */
+  if (CONSP (def) && PURE_P (def)
+      && (EQ (XCONS (def)->car, Qmenu_item) || STRINGP (XCONS (def)->car)))
     def = Fcons (XCONS (def)->car, XCONS (def)->cdr);
 
   if (!CONSP (keymap) || ! EQ (XCONS (keymap)->car, Qkeymap))
@@ -731,42 +777,80 @@ is not copied.")
              XVECTOR (elt)->contents[i]
                = Fcopy_keymap (XVECTOR (elt)->contents[i]);
        }
-      else if (CONSP (elt))
+      else if (CONSP (elt) && CONSP (XCONS (elt)->cdr))
        {
-         /* Skip the optional menu string.  */
-         if (CONSP (XCONS (elt)->cdr)
-             && STRINGP (XCONS (XCONS (elt)->cdr)->car))
-           {
-             Lisp_Object tem;
+         Lisp_Object tem;
+         tem = XCONS (elt)->cdr;
 
-             /* Copy the cell, since copy-alist didn't go this deep.  */
-             XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car,
-                                       XCONS (XCONS (elt)->cdr)->cdr);
+         /* Is this a new format menu item.  */
+         if (EQ (XCONS (tem)->car,Qmenu_item))
+           {
+             /* Copy cell with menu-item marker.  */
+             XCONS (elt)->cdr
+               = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
              elt = XCONS (elt)->cdr;
-
-             /* Also skip the optional menu help string.  */
-             if (CONSP (XCONS (elt)->cdr)
-                 && STRINGP (XCONS (XCONS (elt)->cdr)->car))
+             tem = XCONS (elt)->cdr;
+             if (CONSP (tem))
+               {
+                 /* Copy cell with menu-item name.  */
+                 XCONS (elt)->cdr
+                   = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
+                 elt = XCONS (elt)->cdr;
+                 tem = XCONS (elt)->cdr;
+               };
+             if (CONSP (tem))
                {
-                 XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car,
-                                           XCONS (XCONS (elt)->cdr)->cdr);
+                 /* Copy cell with binding and if the binding is a keymap,
+                    copy that.  */
+                 XCONS (elt)->cdr
+                   = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
                  elt = XCONS (elt)->cdr;
+                 tem = XCONS (elt)->car;
+                 if (!(SYMBOLP (tem) || NILP (Fkeymapp (tem))))
+                   XCONS (elt)->car = Fcopy_keymap (tem);
+                 tem = XCONS (elt)->cdr;
+                 if (CONSP (tem) && CONSP (XCONS (tem)->car))
+                   /* Delete cache for key equivalences.  */
+                   XCONS (elt)->cdr = XCONS (tem)->cdr;
                }
-             /* There may also be a list that caches key equivalences.
-                Just delete it for the new keymap.  */
-             if (CONSP (XCONS (elt)->cdr)
-                 && CONSP (XCONS (XCONS (elt)->cdr)->car)
-                 && (NILP (tem = XCONS (XCONS (XCONS (elt)->cdr)->car)->car)
-                     || VECTORP (tem)))
-               XCONS (elt)->cdr = XCONS (XCONS (elt)->cdr)->cdr;
            }
-         if (CONSP (elt)
-             && ! SYMBOLP (XCONS (elt)->cdr)
-             && ! NILP (Fkeymapp (XCONS (elt)->cdr)))
-           XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr);
+         else
+           {
+             /* It may be an old fomat menu item.
+                Skip the optional menu string.
+             */
+             if (STRINGP (XCONS (tem)->car))
+               {
+                 /* Copy the cell, since copy-alist didn't go this deep.  */
+                 XCONS (elt)->cdr
+                   = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
+                 elt = XCONS (elt)->cdr;
+                 tem = XCONS (elt)->cdr;
+                 /* Also skip the optional menu help string.  */
+                 if (CONSP (tem) && STRINGP (XCONS (tem)->car))
+                   {
+                     XCONS (elt)->cdr
+                       = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
+                     elt = XCONS (elt)->cdr;
+                     tem = XCONS (elt)->cdr;
+                   }
+                 /* There may also be a list that caches key equivalences.
+                    Just delete it for the new keymap.  */
+                 if (CONSP (tem)
+                     && CONSP (XCONS (tem)->car)
+                     && (NILP (XCONS (XCONS (tem)->car)->car)
+                         || VECTORP (XCONS (XCONS (tem)->car)->car)))
+                   XCONS (elt)->cdr = XCONS (tem)->cdr;
+               }
+             if (CONSP (elt)
+                 && ! SYMBOLP (XCONS (elt)->cdr)
+                 && ! NILP (Fkeymapp (XCONS (elt)->cdr)))
+               XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr);
+           }
+
        }
     }
-
+             
   return copy;
 }
 \f
@@ -1077,6 +1161,16 @@ current_minor_maps (modeptr, mapptr)
        {
          Lisp_Object temp;
 
+         /* If a variable has an entry in Vminor_mode_overriding_map_alist,
+            and also an entry in Vminor_mode_map_alist,
+            ignore the latter.  */
+         if (list_number == 1)
+           {
+             val = assq_no_quit (var, lists[0]);
+             if (!NILP (val))
+               break;
+           }
+
          if (i >= cmm_size)
            {
              Lisp_Object *newmodes, *newmaps;
@@ -1279,17 +1373,19 @@ bindings; see the description of `lookup-key' for more details about this.")
   return Flist (j, maps);
 }
 
-DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 2, 0,
+DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
   "Define COMMAND as a prefix command.  COMMAND should be a symbol.\n\
 A new sparse keymap is stored as COMMAND's function definition and its value.\n\
 If a second optional argument MAPVAR is given, the map is stored as\n\
 its value instead of as COMMAND's value; but COMMAND is still defined\n\
-as a function.")
-  (command, mapvar)
-     Lisp_Object command, mapvar;
+as a function.\n\
+The third optional argument NAME, if given, supplies a menu name\n\
+string for the map.  This is required to use the keymap as a menu.")
+  (command, mapvar, name)
+     Lisp_Object command, mapvar, name;
 {
   Lisp_Object map;
-  map = Fmake_sparse_keymap (Qnil);
+  map = Fmake_sparse_keymap (name);
   Ffset (command, map);
   if (!NILP (mapvar))
     Fset (mapvar, map);
@@ -1388,16 +1484,22 @@ then the value includes only maps for prefixes that start with PREFIX.")
             we don't have to deal with the possibility of a string.  */
          if (STRINGP (prefix))
            {
-             int i;
+             int i, i_byte, c;
              Lisp_Object copy;
 
              copy = Fmake_vector (make_number (XSTRING (prefix)->size), Qnil);
-             for (i = 0; i < XSTRING (prefix)->size; i++)
+             for (i = 0, i_byte = 0; i < XSTRING (prefix)->size;)
                {
-                 int c = XSTRING (prefix)->data[i];
-                 if (c & 0200)
-                   c ^= 0200 | meta_modifier;
-                 XVECTOR (copy)->contents[i] = make_number (c);
+                 int i_before = i;
+                 if (STRING_MULTIBYTE (prefix))
+                   FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
+                 else
+                   {
+                     c = XSTRING (prefix)->data[i++];
+                     if (c & 0200)
+                       c ^= 0200 | meta_modifier;
+                   }
+                 XVECTOR (copy)->contents[i_before] = make_number (c);
                }
              prefix = copy;
            }
@@ -1612,7 +1714,7 @@ spaces are put between sequence elements, etc.")
      Lisp_Object keys;
 {
   int len;
-  int i;
+  int i, i_byte;
   Lisp_Object sep;
   Lisp_Object *args;
 
@@ -1620,34 +1722,62 @@ spaces are put between sequence elements, etc.")
     {
       Lisp_Object vector;
       vector = Fmake_vector (Flength (keys), Qnil);
-      for (i = 0; i < XSTRING (keys)->size; i++)
+      for (i = 0, i_byte = 0; i < XSTRING (keys)->size; )
        {
-         if (XSTRING (keys)->data[i] & 0x80)
-           XSETFASTINT (XVECTOR (vector)->contents[i],
-                        meta_modifier | (XSTRING (keys)->data[i] & ~0x80));
+         int c;
+         int i_before = i;
+
+         if (STRING_MULTIBYTE (keys))
+           FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte);
          else
-           XSETFASTINT (XVECTOR (vector)->contents[i],
-                        XSTRING (keys)->data[i]);
+           {
+             c = XSTRING (keys)->data[i++];
+             if (c & 0200)
+               c ^= 0200 | meta_modifier;
+           }
+
+         XSETFASTINT (XVECTOR (vector)->contents[i_before], c);
        }
       keys = vector;
     }
-  else if (!VECTORP (keys))
-    keys = wrong_type_argument (Qarrayp, keys);
 
-  /* In effect, this computes
-     (mapconcat 'single-key-description keys " ")
-     but we shouldn't use mapconcat because it can do GC.  */
+  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));
+      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++)
+      for (i = 0; i < len; i++)
+       {
+         args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i]);
+         args[i * 2 + 1] = sep;
+       }
+    }
+  else if (CONSP (keys))
     {
-      args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i]);
-      args[i * 2 + 1] = sep;
+      /* 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 (XCONS (keys)->car);
+         args[i * 2 + 1] = sep;
+         keys = XCONS (keys)->cdr;
+       }
     }
+  else
+    keys = wrong_type_argument (Qarrayp, keys);
 
   return Fconcat (len * 2 - 1, args);
 }
@@ -1733,29 +1863,40 @@ push_key_description (c, p)
       *p++ = 'L';
     }
   else if (c == ' ')
-    {
+   {
       *p++ = 'S';
       *p++ = 'P';
       *p++ = 'C';
     }
-  else if (c < 256)
+  else if (c < 128
+          || (NILP (current_buffer->enable_multibyte_characters)
+              && SINGLE_BYTE_CHAR_P (c)))
     *p++ = c;
-  else if (c < 512)
-    {
-      *p++ = '\\';
-      *p++ = (7 & (c >> 6)) + '0';
-      *p++ = (7 & (c >> 3)) + '0';
-      *p++ = (7 & (c >> 0)) + '0';
-    }
   else
     {
-      *p++ = '\\';
-      *p++ = (7 & (c >> 15)) + '0';
-      *p++ = (7 & (c >> 12)) + '0';
-      *p++ = (7 & (c >> 9)) + '0';
-      *p++ = (7 & (c >> 6)) + '0';
-      *p++ = (7 & (c >> 3)) + '0';
-      *p++ = (7 & (c >> 0)) + '0';
+      if (! NILP (current_buffer->enable_multibyte_characters))
+       c = unibyte_char_to_multibyte (c);
+
+      if (NILP (current_buffer->enable_multibyte_characters)
+         || SINGLE_BYTE_CHAR_P (c)
+         || ! char_valid_p (c, 0))
+       {
+         int bit_offset;
+         *p++ = '\\';
+         /* The biggest character code uses 19 bits.  */
+         for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
+           {
+             if (c >= (1 << bit_offset))
+               *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
+           }
+       }
+      else
+       {
+         unsigned char work[4], *str;
+         int i = CHAR_STRING (c, work, str);
+         bcopy (str, p, i);
+         p += i;
+       }
     }
 
   return p;  
@@ -1769,14 +1910,39 @@ Control characters turn into C-whatever, etc.")
   (key)
      Lisp_Object key;
 {
-  char tem[20];
+  if (CONSP (key) && lucid_event_type_list_p (key))
+    key = Fevent_convert_list (key);
 
   key = EVENT_HEAD (key);
 
   if (INTEGERP (key))          /* Normal character */
     {
-      *push_key_description (XUINT (key), tem) = 0;
-      return build_string (tem);
+      unsigned int charset, c1, c2;
+      int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
+
+      if (SINGLE_BYTE_CHAR_P (without_bits))
+       charset = 0;
+      else
+       SPLIT_NON_ASCII_CHAR (without_bits, charset, c1, c2);
+
+      if (charset
+         && CHARSET_DEFINED_P (charset)
+         && ((c1 >= 0 && c1 < 32)
+             || (c2 >= 0 && c2 < 32)))
+       {
+         /* Handle a generic character.  */
+         Lisp_Object name;
+         name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX);
+         CHECK_STRING (name, 0);
+         return concat2 (build_string ("Character set "), name);
+       }
+      else
+       {
+         char tem[20];
+
+         *push_key_description (XUINT (key), tem) = 0;
+         return build_string (tem);
+       }
     }
   else if (SYMBOLP (key))      /* Function key or event-symbol */
     return Fsymbol_name (key);
@@ -1829,7 +1995,7 @@ Control characters turn into \"^char\", etc.")
       unsigned char *str;
       int len = non_ascii_char_to_string (XFASTINT (character), tem, &str);
 
-      return make_string (str, len);
+      return make_multibyte_string (str, 1, len);
     }
 
   *push_text_char_description (XINT (character) & 0377, tem) = 0;
@@ -2114,9 +2280,10 @@ where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last,
              else
                break;
            }
-         /* If the contents are (STRING ...), reject.  */
+         /* If the contents are (menu-item ...) or (STRING ...), reject.  */
          if (CONSP (definition)
-             && STRINGP (XCONS (definition)->car))
+             && (EQ (XCONS (definition)->car,Qmenu_item)
+                 || STRINGP (XCONS (definition)->car)))
            return Qnil;
        }
       else
@@ -2185,40 +2352,48 @@ where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last,
 \f
 /* describe-bindings - summarizing all the bindings in a set of keymaps.  */
 
-DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 1, "",
+DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, Sdescribe_bindings_internal, 0, 2, "",
   "Show a list of all defined keys, and their definitions.\n\
-The list is put in a buffer, which is displayed.\n\
-An optional argument PREFIX, if non-nil, should be a key sequence;\n\
+We put that list in a buffer, and display the buffer.\n\
+\n\
+The optional argument MENUS, if non-nil, says to mention menu bindings.\n\
+\(Ordinarily these are omitted from the output.)\n\
+The optional argument PREFIX, if non-nil, should be a key sequence;\n\
 then we display only bindings that start with that prefix.")
-  (prefix)
-     Lisp_Object prefix;
+  (menus, prefix)
+     Lisp_Object menus, prefix;
 {
   register Lisp_Object thisbuf;
   XSETBUFFER (thisbuf, current_buffer);
   internal_with_output_to_temp_buffer ("*Help*",
                                       describe_buffer_bindings,
-                                      Fcons (thisbuf, prefix));
+                                      list3 (thisbuf, prefix, menus));
   return Qnil;
 }
 
-/* ARG is (BUFFER . PREFIX).  */
+/* ARG is (BUFFER PREFIX MENU-FLAG).  */
 
 static Lisp_Object
 describe_buffer_bindings (arg)
      Lisp_Object arg;
 {
   Lisp_Object descbuf, prefix, shadow;
+  int nomenu;
   register Lisp_Object start1;
   struct gcpro gcpro1;
 
   char *alternate_heading
     = "\
-Alternate Characters (use anywhere the nominal character is listed):\n\
-nominal         alternate\n\
--------         ---------\n";
+Keyboard translations:\n\n\
+You type        Translation\n\
+--------        -----------\n";
 
   descbuf = XCONS (arg)->car;
-  prefix = XCONS (arg)->cdr;
+  arg = XCONS (arg)->cdr;
+  prefix = XCONS (arg)->car;
+  arg = XCONS (arg)->cdr;
+  nomenu = NILP (XCONS (arg)->car);
+
   shadow = Qnil;
   GCPRO1 (shadow);
 
@@ -2257,7 +2432,7 @@ nominal         alternate\n\
 
   if (!NILP (Vkey_translation_map))
     describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
-                      "Key translations", 0, 1, 0);
+                      "Key translations", nomenu, 1, 0);
 
   {
     int i, nmaps;
@@ -2296,7 +2471,7 @@ nominal         alternate\n\
        p += sizeof (" Minor Mode Bindings") - 1;
        *p = 0;
 
-       describe_map_tree (maps[i], 1, shadow, prefix, title, 0, 0, 0);
+       describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0);
        shadow = Fcons (maps[i], shadow);
       }
   }
@@ -2312,17 +2487,17 @@ nominal         alternate\n\
   if (!NILP (start1))
     {
       describe_map_tree (start1, 1, shadow, prefix,
-                        "Major Mode Bindings", 0, 0, 0);
+                        "Major Mode Bindings", nomenu, 0, 0);
       shadow = Fcons (start1, shadow);
     }
 
   describe_map_tree (current_global_map, 1, shadow, prefix,
-                    "Global Bindings", 0, 0, 1);
+                    "Global Bindings", nomenu, 0, 1);
 
   /* Print the function-key-map translations under this prefix.  */
   if (!NILP (Vfunction_key_map))
     describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
-                      "Function key map translations", 0, 1, 0);
+                      "Function key map translations", nomenu, 1, 0);
 
   call0 (intern ("help-mode"));
   Fset_buffer (descbuf);
@@ -2357,7 +2532,7 @@ describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
      int transl;
      int always_title;
 {
-  Lisp_Object maps, seen, sub_shadows;
+  Lisp_Object maps, orig_maps, seen, sub_shadows;
   struct gcpro gcpro1, gcpro2, gcpro3;
   int something = 0;
   char *key_heading
@@ -2365,7 +2540,7 @@ describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
 key             binding\n\
 ---             -------\n";
 
-  maps = Faccessible_keymaps (startmap, prefix);
+  orig_maps = maps = Faccessible_keymaps (startmap, prefix);
   seen = Qnil;
   sub_shadows = Qnil;
   GCPRO3 (maps, seen, sub_shadows);
@@ -2446,7 +2621,16 @@ key             binding\n\
            sub_shadows = Fcons (shmap, sub_shadows);
        }
 
-      describe_map (Fcdr (elt), Fcar (elt),
+      /* Maps we have already listed in this loop shadow this map.  */
+      for (tail = orig_maps; ! EQ (tail, maps); tail = XCDR (tail))
+       {
+         Lisp_Object tem;
+         tem = Fequal (Fcar (XCAR (tail)), prefix);
+         if (! NILP (tem))
+           sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
+       }
+
+      describe_map (Fcdr (elt), prefix,
                    transl ? describe_translation : describe_command,
                    partial, sub_shadows, &seen, nomenu);
 
@@ -2746,8 +2930,6 @@ describe_vector (vector, elt_prefix, elt_describer,
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
   /* Range of elements to be handled.  */
   int from, to;
-  /* Flag to tell if we should handle multibyte characters.  */
-  int multibyte = !NILP (current_buffer->enable_multibyte_characters);
   /* A flag to tell if a leaf in this level of char-table is not a
      generic character (i.e. a complete multibyte character).  */
   int complete_char;
@@ -2922,7 +3104,8 @@ describe_vector (vector, elt_prefix, elt_describer,
              insert_string ("<");
              tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
              if (STRINGP (tem2))
-               insert_from_string (tem2, 0 , XSTRING (tem2)->size, 0);
+               insert_from_string (tem2, 0, 0, XSTRING (tem2)->size,
+                                   STRING_BYTES (XSTRING (tem2)), 0);
              else
                insert ("?", 1);
              insert (">", 1);
@@ -2936,7 +3119,7 @@ describe_vector (vector, elt_prefix, elt_describer,
       /* If we find a sub char-table within a char-table,
         scan it recursively; it defines the details for
         a character set or a portion of a character set.  */
-      if (multibyte && CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
+      if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
        {
          insert ("\n", 1);
          describe_vector (definition, elt_prefix, elt_describer,
@@ -3063,6 +3246,7 @@ Return list of symbols found.")
   return apropos_accumulate;
 }
 \f
+void
 syms_of_keymap ()
 {
   Lisp_Object tem;
@@ -3169,6 +3353,9 @@ and applies even for keys that have ordinary bindings.");
   Qnon_ascii = intern ("non-ascii");
   staticpro (&Qnon_ascii);
 
+  Qmenu_item = intern ("menu-item");
+  staticpro (&Qmenu_item);
+
   defsubr (&Skeymapp);
   defsubr (&Skeymap_parent);
   defsubr (&Sset_keymap_parent);
@@ -3193,10 +3380,11 @@ and applies even for keys that have ordinary bindings.");
   defsubr (&Ssingle_key_description);
   defsubr (&Stext_char_description);
   defsubr (&Swhere_is_internal);
-  defsubr (&Sdescribe_bindings);
+  defsubr (&Sdescribe_bindings_internal);
   defsubr (&Sapropos_internal);
 }
 
+void
 keys_of_keymap ()
 {
   Lisp_Object tem;