Mercurial > emacs

changeset 39689:0572449a62be

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Mon, 08 Oct 2001 09:47:10 +0000
parents 3cc8191c6032
children 38c1890338cc
files src/keymap.c
diffstat 1 files changed, 175 insertions(+), 177 deletions(-) [+]
line wrap: on
line diff
--- a/src/keymap.c	Mon Oct 08 09:42:24 2001 +0000
+++ b/src/keymap.c	Mon Oct 08 09:47:10 2001 +0000
@@ -190,6 +190,24 @@
   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 @@
       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 @@
       && (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 @@
   (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 @@
 	  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 @@
   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 @@
 	 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 @@
   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 @@
 
 /* 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 @@
 
 	      /* 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 @@
 
   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 @@
 	    }
 
 
-	  for (; ! NILP (sequences); sequences = XCDR (sequences))
+	  for (; !NILP (sequences); sequences = XCDR (sequences))
 	    {
 	      Lisp_Object sequence;
 
@@ -2264,7 +2256,7 @@
 		 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 @@
   /* 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 @@
   /* 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 @@
   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 @@
 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 @@
     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 @@
   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 @@
     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 @@
 	}
 
       /* 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 @@
 
 	  /* 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 @@
 	    }
 
 	  tem = Flookup_key (map, kludge, Qt);
-	  if (! EQ (tem, definition)) continue;
+	  if (!EQ (tem, definition)) continue;
 
 	  if (first)
 	    {
@@ -3155,7 +3150,7 @@
 	  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 @@
 
   defsubr (&Skeymapp);
   defsubr (&Skeymap_parent);
+  defsubr (&Skeymap_prompt);
   defsubr (&Sset_keymap_parent);
   defsubr (&Smake_keymap);
   defsubr (&Smake_sparse_keymap);
@@ -3472,6 +3468,7 @@
   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 @@
   defsubr (&Stext_char_description);
   defsubr (&Swhere_is_internal);
   defsubr (&Sdescribe_bindings_internal);
+  defsubr (&Sdescribe_buffer_bindings);
   defsubr (&Sapropos_internal);
 }