(describe_map_tree): Insert key_heading here.

New arg TITLE.
(describe_buffer_bindings): Corresponding changes.

(shadow_lookup): New function.
(describe_map_2): Call it.  SHADOW is now a list of maps.
(describe_vector): Likewise.
(describe_map): SHADOW is now a list of maps.
(describe_map_tree): Likewise.
(describe_buffer_bindings): Build suitable list to pass as SHADOW.
(Faccessible_keymaps): New arg PREFIX.  Callers changed.
(describe_map_tree): New arg PREFIX.
(Fdescribe_bindings): New arg PREFIX.
Pass to describe_buffer_bindings along with buffer.
(describe_buffer_bindings): Extract PREFIX and pass along.

1 files changed, 158 insertions, 75 deletions

diff --git a/src/keymap.c b/src/keymap.c
index 9cef916565b..f3567a8d13b 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1044,15 +1044,19 @@ DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_
 /* Help functions for describing and documenting keymaps.               */
 
 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
-  1, 1, 0,
+  1, 2, 0,
   "Find all keymaps accessible via prefix characters from KEYMAP.\n\
 Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
 KEYS starting from KEYMAP gets you to MAP.  These elements are ordered\n\
 so that the KEYS increase in length.  The first element is (\"\" . KEYMAP).")
-  (startmap)
-     Lisp_Object startmap;
+  (startmap, prefix)
+     Lisp_Object startmap, prefix;
 {
-  Lisp_Object maps, tail;
+  Lisp_Object maps, good_maps, tail;
+  int prefixlen = 0;
+
+  if (!NILP (prefix))
+    prefixlen = XINT (Flength (prefix));
 
   maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
                        get_keymap (startmap)),
@@ -1131,7 +1135,7 @@ so that the KEYS increase in length.  The first element is (\"\" . KEYMAP).")
           else if (CONSP (elt))
             {
               register Lisp_Object cmd = get_keyelt (XCONS (elt)->cdr);
-              register Lisp_Object tem;
+              register Lisp_Object tem, filter;
 
               /* Ignore definitions that aren't keymaps themselves.  */
               tem = Fkeymapp (cmd);
@@ -1142,7 +1146,7 @@ so that the KEYS increase in length.  The first element is (\"\" . KEYMAP).")
                   tem = Frassq (cmd, maps);
                   if (NILP (tem))
                     {
-                      /* let elt be the event defined by this map entry.  */
+                      /* Let elt be the event defined by this map entry.  */
                       elt = XCONS (elt)->car;
 
                       /* If the last key in thisseq is meta-prefix-char, and
@@ -1157,8 +1161,8 @@ so that the KEYS increase in length.  The first element is (\"\" . KEYMAP).")
                           /* This new sequence is the same length as
                              thisseq, so stick it in the list right
                              after this one.  */
-                          XCONS (tail)->cdr =
-                            Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
+                          XCONS (tail)->cdr
+                            = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
                         }
                       else
                         nconc2 (tail,
@@ -1170,7 +1174,35 @@ so that the KEYS increase in length.  The first element is (\"\" . KEYMAP).")
         }
     }
 
-  return maps;
+  if (NILP (prefix))
+    return maps;
+
+  /* Now find just the maps whose access prefixes start with PREFIX.  */
+
+  good_maps = Qnil;
+  for (; CONSP (maps); maps = XCONS (maps)->cdr)
+    {
+      Lisp_Object elt, thisseq;
+      elt = XCONS (maps)->car;
+      thisseq = XCONS (elt)->car;
+      /* 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;
+              XFASTINT (i1) = i;
+              if (!EQ (Faref (thisseq, i1), Faref (prefix, i1)))
+                break;
+            }
+          if (i == prefixlen)
+            good_maps = Fcons (elt, good_maps);
+        }
+    }
+
+  return Fnreverse (good_maps);
 }
 
 Lisp_Object Qsingle_key_description, Qkey_description;
@@ -1424,10 +1456,10 @@ indirect definition itself.")
     global_keymap = current_global_map;
 
   if (!NILP (local_keymap))
-    maps = nconc2 (Faccessible_keymaps (get_keymap (local_keymap)),
-                   Faccessible_keymaps (get_keymap (global_keymap)));
+    maps = nconc2 (Faccessible_keymaps (get_keymap (local_keymap), Qnil),
+                   Faccessible_keymaps (get_keymap (global_keymap), Qnil));
   else
-    maps = Faccessible_keymaps (get_keymap (global_keymap));
+    maps = Faccessible_keymaps (get_keymap (global_keymap), Qnil);
 
   found = Qnil;
 
@@ -1616,35 +1648,40 @@ Argument is a command definition, usually a symbol with a function definition.")
 
 /* describe-bindings - summarizing all the bindings in a set of keymaps.  */
 
-DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 0, "",
+DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 1, "",
   "Show a list of all defined keys, and their definitions.\n\
-The list is put in a buffer, which is displayed.")
-  ()
+The list is put in a buffer, which is displayed.\n\
+An 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;
 {
   register Lisp_Object thisbuf;
   XSET (thisbuf, Lisp_Buffer, current_buffer);
   internal_with_output_to_temp_buffer ("*Help*",
                                        describe_buffer_bindings,
-                                       thisbuf);
+                                       Fcons (thisbuf, prefix));
   return Qnil;
 }
 
+/* ARG is (BUFFER . PREFIX).  */
+
 static Lisp_Object
-describe_buffer_bindings (descbuf)
-     Lisp_Object descbuf;
+describe_buffer_bindings (arg)
+     Lisp_Object arg;
 {
+  Lisp_Object descbuf, prefix, shadow;
   register Lisp_Object start1, start2;
 
-  char *key_heading
-    = "\
-key             binding\n\
----             -------\n";
   char *alternate_heading
     = "\
 Alternate Characters (use anywhere the nominal character is listed):\n\
 nominal         alternate\n\
 -------         ---------\n";
 
+  descbuf = XCONS (arg)->car;
+  prefix = XCONS (arg)->cdr;
+
   Fset_buffer (Vstandard_output);
 
   /* Report on alternates for keys.  */
@@ -1681,6 +1718,9 @@ nominal         alternate\n\
   {
     int i, nmaps;
     Lisp_Object *modes, *maps;
+    Lisp_Object shadow;
+
+    shadow = Qnil;
 
     /* Temporarily switch to descbuf, so that we can get that buffer's
        minor modes correctly.  */
@@ -1688,6 +1728,9 @@ nominal         alternate\n\
     nmaps = current_minor_maps (&modes, &maps);
     Fset_buffer (Vstandard_output);
 
+    shadow = Qnil;
+
+    /* Print the minor mode maps.  */
     for (i = 0; i < nmaps; i++)
       {
         if (XTYPE (modes[i]) == Lisp_Symbol)
@@ -1699,26 +1742,24 @@ nominal         alternate\n\
         else
           insert_string ("Strangely Named");
         insert_string (" Minor Mode Bindings:\n");
-        insert_string (key_heading);
-        describe_map_tree (maps[i], 0, Qnil);
+        describe_map_tree (maps[i], 0, shadow, prefix, 0);
+        shadow = Fcons (maps[i], shadow);
         insert_char ('\n');
       }
   }
 
+  /* Print the (major mode) local map.  */
   start1 = XBUFFER (descbuf)->keymap;
   if (!NILP (start1))
     {
-      insert_string ("Local Bindings:\n");
-      insert_string (key_heading);
-      describe_map_tree (start1, 0, Qnil);
+      describe_map_tree (start1, 0, shadow, prefix,
+                         "Major Mode Bindings:\n");
+      shadow = Fcons (start1, shadow);
       insert_string ("\n");
     }
 
-  insert_string ("Global Bindings:\n");
-  if (NILP (start1))
-    insert_string (key_heading);
-
-  describe_map_tree (current_global_map, 0, XBUFFER (descbuf)->keymap);
+  describe_map_tree (current_global_map, 0, shadow, prefix,
+                     "Global Bindings:\n");
 
   Fset_buffer (descbuf);
   return Qnil;
@@ -1728,55 +1769,79 @@ nominal         alternate\n\
     followed by those of all maps reachable through STARTMAP.
    If PARTIAL is nonzero, omit certain "uninteresting" commands
     (such as `undefined').
-   If SHADOW is non-nil, it is another map;
-    don't mention keys which would be shadowed by it.  */
+   If SHADOW is non-nil, it is a list of maps;
+    don't mention keys which would be shadowed by any of them.
+   PREFIX, if non-nil, says mention only keys that start with PREFIX.
+   TITLE, if not 0, is a string to insert at the beginning.  */
 
 void
-describe_map_tree (startmap, partial, shadow)
-     Lisp_Object startmap, shadow;
+describe_map_tree (startmap, partial, shadow, prefix, title)
+     Lisp_Object startmap, shadow, prefix;
      int partial;
+     char *title;
 {
-  register Lisp_Object elt, sh;
   Lisp_Object maps;
   struct gcpro gcpro1;
+  char *key_heading
+    = "\
+key             binding\n\
+---             -------\n";
 
-  maps = Faccessible_keymaps (startmap);
+  maps = Faccessible_keymaps (startmap, prefix);
   GCPRO1 (maps);
 
+  if (!NILP (maps))
+    {
+      if (title)
+        insert_string (title);
+      insert_string (key_heading);
+    }
+
   for (; !NILP (maps); maps = Fcdr (maps))
     {
+      register Lisp_Object elt, prefix, sub_shadows, tail;
+
       elt = Fcar (maps);
-      sh = Fcar (elt);
-
-      /* If there is no shadow keymap given, don't shadow.  */
-      if (NILP (shadow))
-        sh = Qnil;
-
-      /* If the sequence by which we reach this keymap is zero-length,
-         then the shadow map for this keymap is just SHADOW.  */
-      else if ((XTYPE (sh) == Lisp_String
-                && XSTRING (sh)->size == 0)
-               || (XTYPE (sh) == Lisp_Vector
-                   && XVECTOR (sh)->size == 0))
-        sh = shadow;
-
-      /* If the sequence by which we reach this keymap actually has
-         some elements, then the sequence's definition in SHADOW is
-         what we should use.  */
-      else
+      prefix = Fcar (elt);
+
+      sub_shadows = Qnil;
+
+      for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
         {
-          sh = Flookup_key (shadow, Fcar (elt), Qt);
-          if (XTYPE (sh) == Lisp_Int)
-            sh = Qnil;
+          Lisp_Object shmap;
+
+          shmap = XCONS (tail)->car;
+
+          /* If the sequence by which we reach this keymap is zero-length,
+             then the shadow map for this keymap is just SHADOW.  */
+          if ((XTYPE (prefix) == Lisp_String
+               && XSTRING (prefix)->size == 0)
+              || (XTYPE (prefix) == Lisp_Vector
+                  && XVECTOR (prefix)->size == 0))
+            ;
+          /* If the sequence by which we reach this keymap actually has
+             some elements, then the sequence's definition in SHADOW is
+             what we should use.  */
+          else
+            {
+              shmap = Flookup_key (shadow, Fcar (elt), Qt);
+              if (XTYPE (shmap) == Lisp_Int)
+                shmap = Qnil;
+            }
+
+          /* If shmap is not nil and not a keymap,
+             it completely shadows this map, so don't
+             describe this map at all.  */
+          if (!NILP (shmap) && NILP (Fkeymapp (shmap)))
+            goto skip;
+
+          if (!NILP (shmap))
+            sub_shadows = Fcons (shmap, sub_shadows);
         }
 
-      /* If sh is null (meaning that the current map is not shadowed),
-         or a keymap (meaning that bindings from the current map might
-         show through), describe the map.  Otherwise, sh is a command
-         that completely shadows the current map, and we shouldn't
-         bother.  */
-      if (NILP (sh) || !NILP (Fkeymapp (sh)))
-        describe_map (Fcdr (elt), Fcar (elt), partial, sh);
+      describe_map (Fcdr (elt), Fcar (elt), partial, sub_shadows);
+
+    skip: ;
     }
 
   UNGCPRO;
@@ -1831,6 +1896,24 @@ describe_map (map, keys, partial, shadow)
   describe_map_2 (map, keysdesc, describe_command, partial, shadow);
 }
 
+/* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
+   Returns the first non-nil binding found in any of those maps.  */
+
+static Lisp_Object
+shadow_lookup (shadow, key, flag)
+     Lisp_Object shadow, key, flag;
+{
+  Lisp_Object tail, value;
+
+  for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
+    {
+      value = Flookup_key (XCONS (tail)->car, key, flag);
+      if (!NILP (value))
+        return value;
+    }
+  return Qnil;
+}
+
 /* Insert a description of KEYMAP into the current buffer.  */
 
 static void
@@ -1841,7 +1924,7 @@ describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow)
      int partial;
      Lisp_Object shadow;
 {
-  Lisp_Object definition, event;
+  Lisp_Object tail, definition, event;
   Lisp_Object tem;
   Lisp_Object suppress;
   Lisp_Object kludge;
@@ -1859,17 +1942,17 @@ describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow)
 
   GCPRO3 (elt_prefix, definition, kludge);
 
-  for (; CONSP (keymap); keymap = Fcdr (keymap))
+  for (tail = XCONS (keymap)->cdr; CONSP (tail); tail = Fcdr (tail))
     {
       QUIT;
 
-      if (XTYPE (XCONS (keymap)->car) == Lisp_Vector)
-        describe_vector (XCONS (keymap)->car,
+      if (XTYPE (XCONS (tail)->car) == Lisp_Vector)
+        describe_vector (XCONS (tail)->car,
                          elt_prefix, elt_describer, partial, shadow);
       else
         {
-          event = Fcar_safe (Fcar (keymap));
-          definition = get_keyelt (Fcdr_safe (Fcar (keymap)));
+          event = Fcar_safe (Fcar (tail));
+          definition = get_keyelt (Fcdr_safe (Fcar (tail)));
 
           /* Don't show undefined commands or suppressed commands.  */
           if (NILP (definition)) continue;
@@ -1886,11 +1969,11 @@ describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow)
           XVECTOR (kludge)->contents[0] = event;
           if (!NILP (shadow))
             {
-              tem = Flookup_key (shadow, kludge, Qt);
+              tem = shadow_lookup (shadow, kludge, Qt);
               if (!NILP (tem)) continue;
             }
 
-          tem = Flookup_key (map, kludge, Qt);
+          tem = Flookup_key (keymap, kludge, Qt);
           if (! EQ (tem, definition)) continue;
 
           if (first)
@@ -1988,7 +2071,7 @@ describe_vector (vector, elt_prefix, elt_describer, partial, shadow)
           Lisp_Object tem;
           
           XVECTOR (kludge)->contents[0] = make_number (i);
-          tem = Flookup_key (shadow, kludge, Qt);
+          tem = shadow_lookup (shadow, kludge, Qt);
 
           if (!NILP (tem)) continue;
         }