(keymap_memberp): New function.

(Fset_keymap_parent): Use it.
(fix_submap_inheritance): Use get_keyelt, get_keymap_1 and KEYMAPP.
Use keymap_memberp to avoid creating cycles.
(access_keymap): Use KEYMAPP.

diff --git a/src/ChangeLog b/src/ChangeLog
index b3f37d6a5576db473c24a3df228ac8909b44a16c..1b68592eced99cba1661e17196abd4591d49adcf 100644 (file)
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2000-09-30  Stefan Monnier  <monnier@cs.yale.edu>
+
+       * keymap.c (keymap_memberp): New function.
+       (Fset_keymap_parent): Use it.
+       (fix_submap_inheritance): Use get_keyelt, get_keymap_1 and KEYMAPP.
+       Use keymap_memberp to avoid creating cycles.
+       (access_keymap): Use KEYMAPP.
+
 2000-09-30  Gerd Moellmann  <gerd@gnu.org>
 
        * process.c (Fopen_network_stream) [HAVE_GETADDRINFO]: Use

diff --git a/src/keymap.c b/src/keymap.c
index 7bb7b0d7f6c9b2cd5b6857cc6adeedfcc1ddb472..a9b659804cd332ef908d85a5685b3a24db19dddb 100644 (file)
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -306,6 +306,16 @@ DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
 }
 
 
+/* Check whether MAP is one of MAPS parents.  */
+int
+keymap_memberp (map, maps)
+     Lisp_Object map, maps;
+{
+  while (KEYMAPP (maps) && !EQ (map, maps))
+    maps = Fkeymap_parent (maps);
+  return (EQ (map, maps));
+}
+
 /* Set the parent keymap of MAP to PARENT.  */
 
 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
@@ -323,15 +333,10 @@ PARENT should be nil or another keymap.")
   
   if (!NILP (parent))
     {
-      Lisp_Object k;
-      
       parent = get_keymap_1 (parent, 1, 1);
 
       /* Check for cycles.  */
-      k = parent;
-      while (KEYMAPP (k) && !EQ (keymap, k))
-       k = Fkeymap_parent (k);
-      if (EQ (keymap, k))
+      if (keymap_memberp (keymap, parent))
        error ("Cyclic keymap inheritance");
     }
 
@@ -400,51 +405,21 @@ fix_submap_inheritance (map, event, submap)
   /* SUBMAP is a cons that we found as a key binding.
      Discard the other things found in a menu key binding.  */
 
-  if (CONSP (submap))
-    {
-      /* May be an old format menu item */
-      if (STRINGP (XCAR (submap)))
-       {
-         submap = XCDR (submap);
-         /* Also remove a menu help string, if any,
-            following the menu item name.  */
-         if (CONSP (submap) && STRINGP (XCAR (submap)))
-           submap = XCDR (submap);
-         /* Also remove the sublist that caches key equivalences, if any.  */
-         if (CONSP (submap)
-             && CONSP (XCAR (submap)))
-           {
-             Lisp_Object carcar;
-             carcar = XCAR (XCAR (submap));
-             if (NILP (carcar) || VECTORP (carcar))
-               submap = XCDR (submap);
-           }
-       }
-
-      /* Or a new format menu item */
-      else if (EQ (XCAR (submap), Qmenu_item)
-              && CONSP (XCDR (submap)))
-       {
-         submap = XCDR (XCDR (submap));
-         if (CONSP (submap))
-           submap = XCAR (submap);
-       }
-    }
+  submap = get_keymap_1 (get_keyelt (submap, 0), 0, 0);
 
   /* If it isn't a keymap now, there's no work to do.  */
-  if (! CONSP (submap)
-      || ! EQ (XCAR (submap), Qkeymap))
+  if (NILP (submap))
     return;
 
   map_parent = Fkeymap_parent (map);
   if (! NILP (map_parent))
-    parent_entry = access_keymap (map_parent, event, 0, 0);
+    parent_entry = get_keyelt (access_keymap (map_parent, event, 0, 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 (XCAR (parent_entry), Qkeymap)))
+  if (! KEYMAPP (parent_entry))
     parent_entry = Qnil;
 
   if (! EQ (parent_entry, submap))
@@ -455,10 +430,10 @@ fix_submap_inheritance (map, event, submap)
        {
          Lisp_Object tem;
          tem = Fkeymap_parent (submap_parent);
-         if (EQ (tem, parent_entry))
+         if (keymap_memberp (tem, parent_entry))
+           /* Fset_keymap_parent could create a cycle.  */
            return;
-          if (CONSP (tem)
-             && EQ (XCAR (tem), Qkeymap))
+          if (KEYMAPP (tem))
            submap_parent = tem;
          else
            break;
@@ -525,7 +500,7 @@ access_keymap (map, idx, t_ok, noinherit)
            if (EQ (XCAR (binding), idx))
              {
                val = XCDR (binding);
-               if (noprefix && CONSP (val) && EQ (XCAR (val), Qkeymap))
+               if (noprefix && KEYMAPP (val))
                  return Qnil;
                if (CONSP (val))
                  fix_submap_inheritance (map, idx, val);
@@ -539,7 +514,7 @@ access_keymap (map, idx, t_ok, noinherit)
            if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (binding)->size)
              {
                val = XVECTOR (binding)->contents[XFASTINT (idx)];
-               if (noprefix && CONSP (val) && EQ (XCAR (val), Qkeymap))
+               if (noprefix && KEYMAPP (val))
                  return Qnil;
                if (CONSP (val))
                  fix_submap_inheritance (map, idx, val);
@@ -557,7 +532,7 @@ access_keymap (map, idx, t_ok, noinherit)
                         | CHAR_SHIFT | CHAR_CTL | CHAR_META)))
              {
                val = Faref (binding, idx);
-               if (noprefix && CONSP (val) && EQ (XCAR (val), Qkeymap))
+               if (noprefix && KEYMAPP (val))
                  return Qnil;
                if (CONSP (val))
                  fix_submap_inheritance (map, idx, val);
@@ -782,7 +757,7 @@ store_in_keymap (keymap, idx, def)
     XCDR (insertion_point)
       = Fcons (Fcons (idx, def), XCDR (insertion_point));
   }
-         
+  
   return def;
 }