changeset 3952:f9dfc2872fb0

(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.

--- a/src/keymap.c	Fri Jul 02 04:00:38 1993 +0000
+++ b/src/keymap.c	Fri Jul 02 05:21:05 1993 +0000
@@ -1044,15 +1044,19 @@
 /* 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 @@
 	  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 @@
 		  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 @@
 			  /* 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 @@
 	}
     }
 
-  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 @@
     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 @@
 
 /* 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 @@
   {
     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 @@
     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 @@
 	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 @@
     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);
+      prefix = Fcar (elt);
 
-      /* If there is no shadow keymap given, don't shadow.  */
-      if (NILP (shadow))
-	sh = Qnil;
+      sub_shadows = Qnil;
+
+      for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
+	{
+	  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.  */
-      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 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 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
-	{
-	  sh = Flookup_key (shadow, Fcar (elt), Qt);
-	  if (XTYPE (sh) == Lisp_Int)
-	    sh = 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_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 @@
      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 @@
 
   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 @@
 	  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 @@
 	  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;
 	}