(Fkeymap_prompt, Fcurrent_active_maps): New funs.

(accessible_keymaps_1): New function.
(Faccessible_keymaps, accessible_keymaps_char_table): Use it.
(Fwhere_is_internal): Use Fcurrent_active_maps.
(Fdescribe_buffer_bindings): Renamed from describe_buffer_bindings.
Insert in current buffer rather than standard-output.
Don't call `help-mode'.  Export to elisp.
(describe_buffer_bindings): New wrapper.
(syms_of_keymap): Defsubr Skeymap_prompt, Scurrent_active_maps
and Sdescribe_buffer_bindings.

1 files changed, 175 insertions, 177 deletions

diff --git a/src/keymap.c b/src/keymap.c
index 8f4a1cc478a..ac2727a623e 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -190,6 +190,24 @@ is also allowed as an element.")
   return (KEYMAPP (object) ? Qt : Qnil);
 }
 
+DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
+  "Return the prompt-string of a keymap MAP.\n\
+If non-nil, the prompt is shown in the echo-area\n\
+when reading a key-sequence to be looked-up in this keymap.")
+  (map)
+     Lisp_Object map;
+{
+  while (CONSP (map))
+    {
+      register Lisp_Object tem;
+      tem = Fcar (map);
+      if (STRINGP (tem))
+        return tem;
+      map = Fcdr (map);
+    }
+  return Qnil;
+}
+
 /* Check that OBJECT is a keymap (after dereferencing through any
    symbols).  If it is, return it.
 
@@ -338,7 +356,7 @@ 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) || KEYMAPP (list))
+      if (!CONSP (list) || KEYMAPP (list))
         {
           /* If we already have the right parent, return now
              so that we avoid the loops below.  */
@@ -699,7 +717,7 @@ store_in_keymap (keymap, idx, def)
       && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
     def = Fcons (XCAR (def), XCDR (def));
 
-  if (!CONSP (keymap) || ! EQ (XCAR (keymap), Qkeymap))
+  if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
     error ("attempt to define a key in a non-keymap");
 
   /* If idx is a list (some sort of mouse click, perhaps?),
@@ -804,6 +822,9 @@ is not copied.")
   (keymap)
      Lisp_Object keymap;
 {
+  /* FIXME: This doesn't properly copy menu-items in vectors.  */
+  /* FIXME: This also copies the parent keymap.  */
+
   register Lisp_Object copy, tail;
 
   copy = Fcopy_alist (get_keymap (keymap, 1, 0));
@@ -990,7 +1011,7 @@ the front of KEYMAP.")
           idx++;
         }
 
-      if (! INTEGERP (c) && ! SYMBOLP (c) && ! CONSP (c))
+      if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c))
         error ("Key sequence contains invalid events");
 
       if (idx == length)
@@ -1038,7 +1059,7 @@ recognize the default bindings, just as `read-key-sequence' does.")
   register Lisp_Object cmd;
   register Lisp_Object c;
   int length;
-  int t_ok = ! NILP (accept_default);
+  int t_ok = !NILP (accept_default);
   struct gcpro gcpro1;
 
   keymap = get_keymap (keymap, 1, 1);
@@ -1160,8 +1181,8 @@ current_minor_maps (modeptr, mapptr)
          alist = XCDR (alist))
       if ((assoc = XCAR (alist), CONSP (assoc))
           && (var = XCAR (assoc), SYMBOLP (var))
-          && (val = find_symbol_value (var), ! EQ (val, Qunbound))
-          && ! NILP (val))
+          && (val = find_symbol_value (var), !EQ (val, Qunbound))
+          && !NILP (val))
         {
           Lisp_Object temp;
 
@@ -1230,6 +1251,47 @@ current_minor_maps (modeptr, mapptr)
   return i;
 }
 
+DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
+  0, 1, 0,
+  "Return a list of the currently active keymaps.
+OLP if non-nil indicates that we should obey `overriding-local-map' and
+`overriding-terminal-local-map'.")
+     (olp)
+     Lisp_Object olp;
+{
+  Lisp_Object keymaps = Fcons (current_global_map, Qnil);
+
+  if (!NILP (olp))
+    {
+      if (!NILP (Voverriding_local_map))
+        keymaps = Fcons (Voverriding_local_map, keymaps);
+      if (!NILP (current_kboard->Voverriding_terminal_local_map))
+        keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
+    }
+  if (NILP (XCDR (keymaps)))
+    {
+      Lisp_Object local;
+      Lisp_Object *maps;
+      int nmaps, i;
+
+      local = get_local_map (PT, current_buffer, Qlocal_map);
+      if (!NILP (local))
+        keymaps = Fcons (local, keymaps);
+
+      local = get_local_map (PT, current_buffer, Qkeymap);
+      if (!NILP (local))
+        keymaps = Fcons (local, keymaps);
+
+      nmaps = current_minor_maps (0, &maps);
+
+      for (i = --nmaps; i >= 0; i--)
+        if (!NILP (maps[i]))
+          keymaps = Fcons (maps[i], keymaps);
+    }
+  
+  return keymaps;
+}
+
 /* GC is possible in this function if it autoloads a keymap.  */
 
 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
@@ -1459,7 +1521,64 @@ DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_
 
 /* Help functions for describing and documenting keymaps.               */
 
-static void accessible_keymaps_char_table P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
+
+static void
+accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized)
+     Lisp_Object maps, tail, thisseq, key, cmd;
+     int is_metized;            /* If 1, `key' is assumed to be INTEGERP.  */
+{
+  Lisp_Object tem;
+
+  cmd = get_keyelt (cmd, 0);
+  if (NILP (cmd))
+    return;
+
+  tem = get_keymap (cmd, 0, 0);
+  if (CONSP (tem))
+    {
+      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);
+              
+              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.  */
+              XCDR (tail)
+                = Fcons (Fcons (tem, cmd), XCDR (tail));
+            }
+          else
+            {
+              tem = append_key (thisseq, key);
+              nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
+            }
+        }
+    }
+}
+
+static void
+accessible_keymaps_char_table (args, index, cmd)
+     Lisp_Object args, index, cmd;
+{
+  accessible_keymaps_1 (index, cmd,
+                        XCAR (XCAR (args)),
+                        XCAR (XCDR (args)),
+                        XCDR (XCDR (args)),
+                        XINT (XCDR (XCAR (args))));
+}
 
 /* This function cannot GC.  */
 
@@ -1568,89 +1687,15 @@ then the value includes only maps for prefixes that start with PREFIX.")
 
               /* Vector keymap.  Scan all the elements.  */
               for (i = 0; i < ASIZE (elt); i++)
-                {
-                  register Lisp_Object tem;
-                  register Lisp_Object cmd;
-
-                  cmd = get_keyelt (AREF (elt, i), 0);
-                  if (NILP (cmd)) continue;
-                  tem = get_keymap (cmd, 0, 0);
-                  if (CONSP (tem))
-                    {
-                      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;
-                              tem = Fcopy_sequence (thisseq);
-                              
-                              Faset (tem, last, make_number (i | meta_bit));
-                              
-                              /* This new sequence is the same length as
-                                 thisseq, so stick it in the list right
-                                 after this one.  */
-                              XCDR (tail)
-                                = Fcons (Fcons (tem, cmd), XCDR (tail));
-                            }
-                          else
-                            {
-                              tem = append_key (thisseq, make_number (i));
-                              nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
-                            }
-                        }
-                    }
-                }
+                accessible_keymaps_1 (make_number (i), AREF (elt, i),
+                                      maps, tail, thisseq, is_metized);
+                                        
             }
           else if (CONSP (elt))
-            {
-              register Lisp_Object cmd, tem;
-
-              cmd = get_keyelt (XCDR (elt), 0);
-              /* Ignore definitions that aren't keymaps themselves.  */
-              tem = get_keymap (cmd, 0, 0);
-              if (CONSP (tem))
-                {
-                  /* Ignore keymaps that have been seen already.  */
-                  cmd = tem;
-                  tem = Frassq (cmd, maps);
-                  if (NILP (tem))
-                    {
-                      /* Let elt be the event defined by this map entry.  */
-                      elt = XCAR (elt);
-
-                      /* If the last key in thisseq is meta-prefix-char, and
-                         this entry is a binding for an ascii keystroke,
-                         turn it into a meta-ized keystroke.  */
-                      if (is_metized && INTEGERP (elt))
-                        {
-                          Lisp_Object element;
-
-                          element = thisseq;
-                          tem = Fvconcat (1, &element);
-                          XSETFASTINT (AREF (tem, XINT (last)),
-                                       XINT (elt) | meta_modifier);
-
-                          /* This new sequence is the same length as
-                             thisseq, so stick it in the list right
-                             after this one.  */
-                          XCDR (tail)
-                            = Fcons (Fcons (tem, cmd), XCDR (tail));
-                        }
-                      else
-                        nconc2 (tail,
-                                Fcons (Fcons (append_key (thisseq, elt), cmd),
-                                       Qnil));
-                    }
-                }
-            }
+            accessible_keymaps_1 (XCAR (elt), XCDR (elt),
+                                  maps, tail, thisseq,
+                                  is_metized && INTEGERP (XCAR (elt)));
+                                    
         }
     }
 
@@ -1684,59 +1729,6 @@ then the value includes only maps for prefixes that start with PREFIX.")
 
   return Fnreverse (good_maps);
 }
-
-static void
-accessible_keymaps_char_table (args, index, cmd)
-     Lisp_Object args, index, cmd;
-{
-  Lisp_Object tem;
-  Lisp_Object maps, tail, thisseq;
-  int is_metized;
-
-  cmd = get_keyelt (cmd, 0);
-  if (NILP (cmd))
-    return;
-
-  maps = XCAR (XCAR (args));
-  is_metized = XINT (XCDR (XCAR (args)));
-  tail = XCAR (XCDR (args));
-  thisseq = XCDR (XCDR (args));
-
-  tem = get_keymap (cmd, 0, 0);
-  if (CONSP (tem))
-    {
-      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);
-              
-              Faset (tem, last, make_number (XINT (index) | meta_bit));
-              
-              /* This new sequence is the same length as
-                 thisseq, so stick it in the list right
-                 after this one.  */
-              XCDR (tail)
-                = Fcons (Fcons (tem, cmd), XCDR (tail));
-            }
-          else
-            {
-              tem = append_key (thisseq, index);
-              nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
-            }
-        }
-    }
-}
 
 Lisp_Object Qsingle_key_description, Qkey_description;
 
@@ -2235,7 +2227,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect)
             }
 
 
-          for (; ! NILP (sequences); sequences = XCDR (sequences))
+          for (; !NILP (sequences); sequences = XCDR (sequences))
             {
               Lisp_Object sequence;
 
@@ -2264,7 +2256,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect)
                  we find.  */
               if (EQ (firstonly, Qnon_ascii))
                 RETURN_UNGCPRO (sequence);
-              else if (! NILP (firstonly) && ascii_sequence_p (sequence))
+              else if (!NILP (firstonly) && ascii_sequence_p (sequence))
                 RETURN_UNGCPRO (sequence);
             }
         }
@@ -2277,7 +2269,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect)
   /* firstonly may have been t, but we may have gone all the way through
      the keymaps without finding an all-ASCII key sequence.  So just
      return the best we could find.  */
-  if (! NILP (firstonly))
+  if (!NILP (firstonly))
     return Fcar (found);
     
   return found;
@@ -2311,16 +2303,10 @@ indirect definition itself.")
   /* Find the relevant keymaps.  */
   if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
     keymaps = keymap;
-  else if (! NILP (keymap))
+  else if (!NILP (keymap))
     keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
   else
-    keymaps =
-      Fdelq (Qnil,
-             nconc2 (Fcurrent_minor_mode_maps (),
-                     Fcons (get_local_map (PT, current_buffer, Qkeymap),
-                            Fcons (get_local_map (PT, current_buffer,
-                                                  Qlocal_map),
-                                   Fcons (current_global_map, Qnil)))));
+    keymaps = Fcurrent_active_maps (Qnil);
 
   /* Only use caching for the menubar (i.e. called with (def nil t nil).
      We don't really need to check `keymap'.  */
@@ -2488,14 +2474,19 @@ then we display only bindings that start with that prefix.")
   return Qnil;
 }
 
-/* ARG is (BUFFER PREFIX MENU-FLAG).  */
-
-static Lisp_Object
-describe_buffer_bindings (arg)
-     Lisp_Object arg;
+DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
+  "Insert the list of all defined keys and their definitions.\n\
+The list is inserted in the current buffer, while the bindings are\n\
+looked up in BUFFER.\n\
+The optional argument PREFIX, if non-nil, should be a key sequence;\n\
+then we display only bindings that start with that prefix.\n\
+The optional argument MENUS, if non-nil, says to mention menu bindings.\n\
+\(Ordinarily these are omitted from the output.)")
+ (buffer, prefix, menus)
+     Lisp_Object buffer, prefix, menus;
 {
-  Lisp_Object descbuf, prefix, shadow;
-  int nomenu;
+  Lisp_Object outbuf, shadow;
+  int nomenu = NILP (menus);
   register Lisp_Object start1;
   struct gcpro gcpro1;
 
@@ -2505,16 +2496,10 @@ Keyboard translations:\n\n\
 You type        Translation\n\
 --------        -----------\n";
 
-  descbuf = XCAR (arg);
-  arg = XCDR (arg);
-  prefix = XCAR (arg);
-  arg = XCDR (arg);
-  nomenu = NILP (XCAR (arg));
-
   shadow = Qnil;
   GCPRO1 (shadow);
 
-  Fset_buffer (Vstandard_output);
+  outbuf = Fcurrent_buffer();
 
   /* Report on alternates for keys.  */
   if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
@@ -2555,16 +2540,16 @@ You type        Translation\n\
     int i, nmaps;
     Lisp_Object *modes, *maps;
 
-    /* Temporarily switch to descbuf, so that we can get that buffer's
+    /* Temporarily switch to `buffer', so that we can get that buffer's
        minor modes correctly.  */
-    Fset_buffer (descbuf);
+    Fset_buffer (buffer);
 
     if (!NILP (current_kboard->Voverriding_terminal_local_map)
         || !NILP (Voverriding_local_map))
       nmaps = 0;
     else
       nmaps = current_minor_maps (&modes, &maps);
-    Fset_buffer (Vstandard_output);
+    Fset_buffer (outbuf);
 
     /* Print the minor mode maps.  */
     for (i = 0; i < nmaps; i++)
@@ -2601,7 +2586,7 @@ You type        Translation\n\
   else if (!NILP (Voverriding_local_map))
     start1 = Voverriding_local_map;
   else
-    start1 = XBUFFER (descbuf)->keymap;
+    start1 = XBUFFER (buffer)->keymap;
 
   if (!NILP (start1))
     {
@@ -2618,12 +2603,22 @@ You type        Translation\n\
     describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
                        "\f\nFunction key map translations", nomenu, 1, 0);
 
-  call0 (intern ("help-mode"));
-  Fset_buffer (descbuf);
   UNGCPRO;
   return Qnil;
 }
 
+/* ARG is (BUFFER PREFIX MENU-FLAG).  */
+ 
+static Lisp_Object
+describe_buffer_bindings (arg)
+     Lisp_Object arg;
+{
+  Fset_buffer (Vstandard_output);
+  return Fdescribe_buffer_bindings (XCAR (arg), XCAR (XCDR (arg)),
+                                    XCAR (XCDR (XCDR (arg))));
+}
+
+
 /* Insert a description of the key bindings in STARTMAP,
     followed by those of all maps reachable through STARTMAP.
    If PARTIAL is nonzero, omit certain "uninteresting" commands
@@ -2741,11 +2736,11 @@ key             binding\n\
         }
 
       /* Maps we have already listed in this loop shadow this map.  */
-      for (tail = orig_maps; ! EQ (tail, maps); tail = XCDR (tail))
+      for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
         {
           Lisp_Object tem;
           tem = Fequal (Fcar (XCAR (tail)), prefix);
-          if (! NILP (tem))
+          if (!NILP (tem))
             sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
         }
 
@@ -2885,7 +2880,7 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
 
           /* Ignore bindings whose "keys" are not really valid events.
              (We get these in the frames and buffers menu.)  */
-          if (! (SYMBOLP (event) || INTEGERP (event)))
+          if (!(SYMBOLP (event) || INTEGERP (event)))
             continue;
 
           if (nomenu && EQ (event, Qmenu_bar))
@@ -2913,7 +2908,7 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
             }
 
           tem = Flookup_key (map, kludge, Qt);
-          if (! EQ (tem, definition)) continue;
+          if (!EQ (tem, definition)) continue;
 
           if (first)
             {
@@ -3155,7 +3150,7 @@ describe_vector (vector, elt_prefix, elt_describer,
           ASET (kludge, 0, make_number (character));
           tem = Flookup_key (entire_map, kludge, Qt);
 
-          if (! EQ (tem, definition))
+          if (!EQ (tem, definition))
             continue;
         }
 
@@ -3456,6 +3451,7 @@ and applies even for keys that have ordinary bindings.");
 
   defsubr (&Skeymapp);
   defsubr (&Skeymap_parent);
+  defsubr (&Skeymap_prompt);
   defsubr (&Sset_keymap_parent);
   defsubr (&Smake_keymap);
   defsubr (&Smake_sparse_keymap);
@@ -3472,6 +3468,7 @@ and applies even for keys that have ordinary bindings.");
   defsubr (&Scurrent_local_map);
   defsubr (&Scurrent_global_map);
   defsubr (&Scurrent_minor_mode_maps);
+  defsubr (&Scurrent_active_maps);
   defsubr (&Saccessible_keymaps);
   defsubr (&Skey_description);
   defsubr (&Sdescribe_vector);
@@ -3479,6 +3476,7 @@ and applies even for keys that have ordinary bindings.");
   defsubr (&Stext_char_description);
   defsubr (&Swhere_is_internal);
   defsubr (&Sdescribe_bindings_internal);
+  defsubr (&Sdescribe_buffer_bindings);
   defsubr (&Sapropos_internal);
 }