(sigunblockx): Definitions deleted.
[bpt/emacs.git] / src / keymap.c
index d2f232c..88f89cd 100644 (file)
@@ -15,7 +15,8 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
-the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
 
 
 #include <config.h>
@@ -179,7 +180,7 @@ synkey (frommap, fromchar, tomap, tochar)
 #endif /* 0 */
 
 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
-  "Return t if ARG is a keymap.\n\
+  "Return t if OBJECT is a keymap.\n\
 \n\
 A keymap is a list (keymap . ALIST),\n\
 or a symbol whose function definition is itself a keymap.\n\
@@ -257,8 +258,141 @@ get_keymap (object)
 {
   return get_keymap_1 (object, 1, 0);
 }
+\f
+/* Return the parent map of the keymap MAP, or nil if it has none.
+   We assume that MAP is a valid keymap.  */
+
+DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
+  "Return the parent keymap of KEYMAP.")
+  (keymap)
+     Lisp_Object keymap;
+{
+  Lisp_Object list;
+
+  keymap = get_keymap_1 (keymap, 1, 1);
+
+  /* Skip past the initial element `keymap'.  */
+  list = XCONS (keymap)->cdr;
+  for (; CONSP (list); list = XCONS (list)->cdr)
+    {
+      /* See if there is another `keymap'.  */
+      if (EQ (Qkeymap, XCONS (list)->car))
+       return list;
+    }
+
+  return Qnil;
+}
+
+/* Set the parent keymap of MAP to PARENT.  */
+
+DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
+  "Modify KEYMAP to set its parent map to PARENT.\n\
+PARENT should be nil or another keymap.")
+  (keymap, parent)
+     Lisp_Object keymap, parent;
+{
+  Lisp_Object list, prev;
+  int i;
+
+  keymap = get_keymap_1 (keymap, 1, 1);
+  if (!NILP (parent))
+    parent = get_keymap_1 (parent, 1, 1);
+
+  /* Skip past the initial element `keymap'.  */
+  prev = keymap;
+  while (1)
+    {
+      list = XCONS (prev)->cdr;
+      /* If there is a parent keymap here, replace it.
+        If we came to the end, add the parent in PREV.  */
+      if (! CONSP (list) || EQ (Qkeymap, XCONS (list)->car))
+       {
+         /* If we already have the right parent, return now
+            so that we avoid the loops below.  */
+         if (EQ (XCONS (prev)->cdr, parent))
+           return parent;
+
+         XCONS (prev)->cdr = parent;
+         break;
+       }
+      prev = list;
+    }
+
+  /* Scan through for submaps, and set their parents too.  */
+
+  for (list = XCONS (keymap)->cdr; CONSP (list); list = XCONS (list)->cdr)
+    {
+      /* Stop the scan when we come to the parent.  */
+      if (EQ (XCONS (list)->car, Qkeymap))
+       break;
+
+      /* If this element holds a prefix map, deal with it.  */
+      if (CONSP (XCONS (list)->car)
+         && CONSP (XCONS (XCONS (list)->car)->cdr))
+       fix_submap_inheritance (keymap, XCONS (XCONS (list)->car)->car,
+                               XCONS (XCONS (list)->car)->cdr);
+
+      if (VECTORP (XCONS (list)->car))
+       for (i = 0; i < XVECTOR (XCONS (list)->car)->size; i++)
+         if (CONSP (XVECTOR (XCONS (list)->car)->contents[i]))
+           fix_submap_inheritance (keymap, make_number (i),
+                                   XVECTOR (XCONS (list)->car)->contents[i]);
+    }
+
+  return parent;
+}
+
+/* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
+   if EVENT is also a prefix in MAP's parent,
+   make sure that SUBMAP inherits that definition as its own parent.  */
+
+fix_submap_inheritance (map, event, submap)
+     Lisp_Object map, event, submap;
+{
+  Lisp_Object map_parent, parent_entry;
+
+  /* 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))
+    {
+      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;
+       }
+    }
+
+  /* If it isn't a keymap now, there's no work to do.  */
+  if (! CONSP (submap)
+      || ! EQ (XCONS (submap)->car, Qkeymap))
+    return;
+
+  map_parent = Fkeymap_parent (map);
+  if (! NILP (map_parent))
+    parent_entry = access_keymap (map_parent, event, 0, 0);
+  else
+    parent_entry = Qnil;
 
+  /* If MAP's parent has something other than a keymap,
+     our own submap shadows it completely, so use nil as SUBMAP's parent.  */
+  if (! (CONSP (parent_entry) && EQ (XCONS (parent_entry)->car, Qkeymap)))
+    parent_entry = Qnil;
+
+  if (! EQ (parent_entry, submap))
+    Fset_keymap_parent (submap, parent_entry);
+}
+\f
 /* Look up IDX in MAP.  IDX may be any sort of event.
    Note that this does only one level of lookup; IDX must be a single
    event, not a sequence. 
@@ -319,6 +453,8 @@ access_keymap (map, idx, t_ok, noinherit)
                val = XCONS (binding)->cdr;
                if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap))
                  return Qnil;
+               if (CONSP (val))
+                 fix_submap_inheritance (map, idx, val);
                return val;
              }
            if (t_ok && EQ (XCONS (binding)->car, Qt))
@@ -331,6 +467,8 @@ access_keymap (map, idx, t_ok, noinherit)
                val = XVECTOR (binding)->contents[XFASTINT (idx)];
                if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap))
                  return Qnil;
+               if (CONSP (val))
+                 fix_submap_inheritance (map, idx, val);
                return val;
              }
          }
@@ -758,6 +896,20 @@ define_as_prefix (keymap, c)
      make it a prefix in this map, and make its definition
      inherit the other prefix definition.  */
   inherit = access_keymap (keymap, c, 0, 0);
+#if 0
+  /* This code is needed to do the right thing in the following case:
+     keymap A inherits from B,
+     you define KEY as a prefix in A,
+     then later you define KEY as a prefix in B.
+     We want the old prefix definition in A to inherit from that in B.
+     It is hard to do that retroactively, so this code
+     creates the prefix in B right away.
+
+     But it turns out that this code causes problems immediately
+     when the prefix in A is defined: it causes B to define KEY
+     as a prefix with no subcommands.
+
+     So I took out this code.  */
   if (NILP (inherit))
     {
       /* If there's an inherited keymap
@@ -772,6 +924,7 @@ define_as_prefix (keymap, c)
       if (!NILP (tail))
        inherit = define_as_prefix (tail, c);
     }
+#endif
 
   cmd = nconc2 (cmd, inherit);
   store_in_keymap (keymap, c, cmd);
@@ -1050,17 +1203,17 @@ 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.")
-  (name, mapvar)
-     Lisp_Object name, mapvar;
+  (command, mapvar)
+     Lisp_Object command, mapvar;
 {
   Lisp_Object map;
   map = Fmake_sparse_keymap (Qnil);
-  Ffset (name, map);
+  Ffset (command, map);
   if (!NILP (mapvar))
     Fset (mapvar, map);
   else
-    Fset (name, map);
-  return name;
+    Fset (command, map);
+  return command;
 }
 
 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
@@ -1070,7 +1223,6 @@ DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
 {
   keymap = get_keymap (keymap);
   current_global_map = keymap;
-  record_asynch_buffer_change ();
 
   return Qnil;
 }
@@ -1085,7 +1237,6 @@ If KEYMAP is nil, that means no local keymap.")
     keymap = get_keymap (keymap);
 
   current_buffer->keymap = keymap;
-  record_asynch_buffer_change ();
 
   return Qnil;
 }
@@ -1123,11 +1274,11 @@ DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
   "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).\n\
+so that the KEYS increase in length.  The first element is ([] . KEYMAP).\n\
 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
 then the value includes only maps for prefixes that start with PREFIX.")
-  (startmap, prefix)
-     Lisp_Object startmap, prefix;
+  (keymap, prefix)
+     Lisp_Object keymap, prefix;
 {
   Lisp_Object maps, good_maps, tail;
   int prefixlen = 0;
@@ -1142,7 +1293,7 @@ then the value includes only maps for prefixes that start with PREFIX.")
       /* If a prefix was specified, start with the keymap (if any) for
         that prefix, so we don't waste time considering other prefixes.  */
       Lisp_Object tem;
-      tem = Flookup_key (startmap, prefix, Qt);
+      tem = Flookup_key (keymap, prefix, Qt);
       /* Flookup_key may give us nil, or a number,
         if the prefix is not defined in this particular map.
         It might even give us a list that isn't a keymap.  */
@@ -1154,7 +1305,7 @@ then the value includes only maps for prefixes that start with PREFIX.")
     }
   else
     maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
-                        get_keymap (startmap)),
+                        get_keymap (keymap)),
                  Qnil);
 
   /* For each map in the list maps,
@@ -1519,16 +1670,16 @@ push_text_char_description (c, p)
 /* This function cannot GC.  */
 
 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
-  "Return a pretty description of file-character CHAR.\n\
+  "Return a pretty description of file-character CHARACTER.\n\
 Control characters turn into \"^char\", etc.")
-  (chr)
-     Lisp_Object chr;
+  (character)
+     Lisp_Object character;
 {
   char tem[6];
 
-  CHECK_NUMBER (chr, 0);
+  CHECK_NUMBER (character, 0);
 
-  *push_text_char_description (XINT (chr) & 0377, tem) = 0;
+  *push_text_char_description (XINT (character) & 0377, tem) = 0;
 
   return build_string (tem);
 }
@@ -2069,7 +2220,7 @@ key             binding\n\
 
       describe_map (Fcdr (elt), Fcar (elt),
                    transl ? describe_translation : describe_command,
-                   partial, sub_shadows, &seen);
+                   partial, sub_shadows, &seen, nomenu);
 
     skip: ;
     }
@@ -2080,13 +2231,30 @@ key             binding\n\
   UNGCPRO;
 }
 
+static int previous_description_column;
+
 static void
 describe_command (definition)
      Lisp_Object definition;
 {
   register Lisp_Object tem1;
+  int column = current_column ();
+  int description_column;
 
-  Findent_to (make_number (16), make_number (1));
+  /* If column 16 is no good, go to col 32;
+     but don't push beyond that--go to next line instead.  */
+  if (column > 30)
+    {
+      insert_char ('\n');
+      description_column = 32;
+    }
+  else if (column > 14 || (column > 10 && previous_description_column == 32))
+    description_column = 32;
+  else
+    description_column = 16;
+
+  Findent_to (make_number (description_column), make_number (1));
+  previous_description_column = description_column;
 
   if (SYMBOLP (definition))
     {
@@ -2155,16 +2323,17 @@ shadow_lookup (shadow, key, flag)
 
 /* Describe the contents of map MAP, assuming that this map itself is
    reached by the sequence of prefix keys KEYS (a string or vector).
-   PARTIAL, SHADOW are as in `describe_map_tree' above.  */
+   PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above.  */
 
 static void
-describe_map (map, keys, elt_describer, partial, shadow, seen)
+describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
      register Lisp_Object map;
      Lisp_Object keys;
      int (*elt_describer) ();
      int partial;
      Lisp_Object shadow;
      Lisp_Object *seen;
+     int nomenu;
 {
   Lisp_Object elt_prefix;
   Lisp_Object tail, definition, event;
@@ -2210,6 +2379,9 @@ describe_map (map, keys, elt_describer, partial, shadow, seen)
          if (! (SYMBOLP (event) || INTEGERP (event)))
            continue;
 
+         if (nomenu && EQ (event, Qmenu_bar))
+           continue;
+
          definition = get_keyelt (XCONS (XCONS (tail)->car)->cdr, 0);
 
          /* Don't show undefined commands or suppressed commands.  */
@@ -2236,6 +2408,7 @@ describe_map (map, keys, elt_describer, partial, shadow, seen)
 
          if (first)
            {
+             previous_description_column = 0;
              insert ("\n", 1);
              first = 0;
            }
@@ -2515,18 +2688,18 @@ apropos_accum (symbol, string)
 
 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0, 
   "Show all symbols whose names contain match for REGEXP.\n\
-If optional 2nd arg PRED is non-nil, (funcall PRED SYM) is done\n\
+If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\
 for each symbol and a symbol is mentioned only if that returns non-nil.\n\
 Return list of symbols found.")
-  (string, pred)
-     Lisp_Object string, pred;
+  (regexp, predicate)
+     Lisp_Object regexp, predicate;
 {
   struct gcpro gcpro1, gcpro2;
-  CHECK_STRING (string, 0);
-  apropos_predicate = pred;
+  CHECK_STRING (regexp, 0);
+  apropos_predicate = predicate;
   GCPRO2 (apropos_predicate, apropos_accumulate);
   apropos_accumulate = Qnil;
-  map_obarray (Vobarray, apropos_accum, string);
+  map_obarray (Vobarray, apropos_accum, regexp);
   apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
   UNGCPRO;
   return apropos_accumulate;
@@ -2627,6 +2800,8 @@ and applies even for keys that have ordinary bindings.");
   staticpro (&Qnon_ascii);
 
   defsubr (&Skeymapp);
+  defsubr (&Skeymap_parent);
+  defsubr (&Sset_keymap_parent);
   defsubr (&Smake_keymap);
   defsubr (&Smake_sparse_keymap);
   defsubr (&Scopy_keymap);