changeset 32476:9b2a0dc393a4

* keymap.c (access_keymap): Add AUTOLOAD parameter. Do the meta->esc mapping. Call get_keyelt before returning. Start scanning from the second element (the first is always `keymap') to make it easier to detect when we reach a parent map. Handle the case of inheriting from a symbol whose function is a map. (Fkeymap_parent): Also handle the `inherit from symbol' case. (fix_submap_inheritance, Fdefine_key): Update call to access_keymap. (get_keyelt, Flookup_key): Update call to access_keymap. Remove the meta->esc mappings. (define_as_prefix): Delete old disabled code. (menu_item_p): New function. (where_is_internal_1): Skip over the few remaining menu items. * lisp.h (access_keymap): Update prototype. * keyboard.c (read_char, menu_bar_items, tool_bar_items): Update call to access_keymap. (follow_key, read_key_sequence): Update calls to access_keymap. Remove the meta->esc mappings.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Sun, 15 Oct 2000 03:31:21 +0000
parents 753586cbb758
children f68c04b9e4a4
files src/keyboard.c src/keymap.c src/lisp.h
diffstat 3 files changed, 54 insertions(+), 149 deletions(-) [+]
line wrap: on
line diff
--- a/src/keyboard.c	Sun Oct 15 02:31:42 2000 +0000
+++ b/src/keyboard.c	Sun Oct 15 03:31:21 2000 +0000
@@ -2570,8 +2570,7 @@
      and loop around to read another event.  */
   save = Vquit_flag;
   Vquit_flag = Qnil;
-  tem = get_keyelt (access_keymap (get_keymap_1 (Vspecial_event_map, 0, 0),
-				   c, 0, 0), 1);
+  tem = access_keymap (get_keymap_1 (Vspecial_event_map, 0, 0), c, 0, 0, 1);
   Vquit_flag = save;
 
   if (!NILP (tem))
@@ -6254,7 +6253,7 @@
   for (mapno = nmaps - 1; mapno >= 0; mapno--)
     if (!NILP (maps[mapno]))
       {
-	def = get_keyelt (access_keymap (maps[mapno], Qmenu_bar, 1, 0), 0);
+	def = access_keymap (maps[mapno], Qmenu_bar, 1, 0, 0);
 	tem = Fkeymapp (def);
 	if (!NILP (tem))
 	  menu_bar_one_keymap (def);
@@ -6911,8 +6910,9 @@
     if (!NILP (maps[i]))
       {
 	Lisp_Object keymap;
-      
-	keymap = get_keyelt (access_keymap (maps[i], Qtool_bar, 1, 1), 0);
+
+	/* Why set the `noinherit' flag ?  -sm  */
+	keymap = access_keymap (maps[i], Qtool_bar, 1, 1, 0);
 	if (!NILP (Fkeymapp (keymap)))
 	  {
 	    Lisp_Object tail;
@@ -7599,31 +7599,6 @@
   int i, first_binding;
   int did_meta = 0;
 
-  /* If KEY is a meta ASCII character, treat it like meta-prefix-char
-     followed by the corresponding non-meta character.
-     Put the results into DEFS, since we are going to alter that anyway.
-     Do not alter CURRENT or NEXT.  */
-  if (INTEGERP (key) && (XUINT (key) & CHAR_META))
-    {
-      for (i = 0; i < nmaps; i++)
-	if (! NILP (current[i]))
-	  {
-	    Lisp_Object def;
-	    def = get_keyelt (access_keymap (current[i],
-					     meta_prefix_char, 1, 0), 0);
-
-	    /* Note that since we pass the resulting bindings through
-	       get_keymap_1, non-prefix bindings for meta-prefix-char
-	       disappear.  */
-	    defs[i] = get_keymap_1 (def, 0, 1);
-	  }
-	else
-	  defs[i] = Qnil;
-
-      did_meta = 1;
-      XSETINT (key, XFASTINT (key) & ~CHAR_META);
-    }
-
   first_binding = nmaps;
   for (i = nmaps - 1; i >= 0; i--)
     {
@@ -7635,7 +7610,7 @@
 	  else
 	    map = current[i];
 
-	  defs[i] = get_keyelt (access_keymap (map, key, 1, 0), 1);
+	  defs[i] = access_keymap (map, key, 1, 0, 1);
 	  if (! NILP (defs[i]))
 	    first_binding = i;
 	}
@@ -8457,22 +8432,8 @@
 	      Lisp_Object key;
 
 	      key = keybuf[fkey_end++];
-	      /* Look up meta-characters by prefixing them
-		 with meta_prefix_char.  I hate this.  */
-	      if (INTEGERP (key) && XUINT (key) & meta_modifier)
-		{
-		  fkey_next
-		    = get_keymap_1
-		      (get_keyelt
-		       (access_keymap (fkey_map, meta_prefix_char, 1, 0), 0),
-		       0, 1);
-		  XSETFASTINT (key, XFASTINT (key) & ~meta_modifier);
-		}
-	      else
-		fkey_next = fkey_map;
-
 	      fkey_next
-		= get_keyelt (access_keymap (fkey_next, key, 1, 0), 1);
+		= access_keymap (fkey_map, key, 1, 0, 1);
 
 	      /* Handle symbol with autoload definition.  */
 	      if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
@@ -8581,22 +8542,8 @@
 	    Lisp_Object key;
 
 	    key = keybuf[keytran_end++];
-	    /* Look up meta-characters by prefixing them
-	       with meta_prefix_char.  I hate this.  */
-	    if (INTEGERP (key) && XUINT (key) & meta_modifier)
-	      {
-		keytran_next
-		  = get_keymap_1
-		    (get_keyelt
-		     (access_keymap (keytran_map, meta_prefix_char, 1, 0), 0),
-		     0, 1);
-		XSETFASTINT (key, XFASTINT (key) & ~meta_modifier);
-	      }
-	    else
-	      keytran_next = keytran_map;
-
 	    keytran_next
-	      = get_keyelt (access_keymap (keytran_next, key, 1, 0), 1);
+	      = access_keymap (keytran_map, key, 1, 0, 1);
 
 	    /* Handle symbol with autoload definition.  */
 	    if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
--- a/src/keymap.c	Sun Oct 15 02:31:42 2000 +0000
+++ b/src/keymap.c	Sun Oct 15 03:31:21 2000 +0000
@@ -302,7 +302,7 @@
 	return list;
     }
 
-  return Qnil;
+  return get_keymap_1(list, 0, autoload);
 }
 
 
@@ -413,7 +413,7 @@
 
   map_parent = Fkeymap_parent (map);
   if (! NILP (map_parent))
-    parent_entry = get_keyelt (access_keymap (map_parent, event, 0, 0), 0);
+    parent_entry = access_keymap (map_parent, event, 0, 0, 0);
   else
     parent_entry = Qnil;
 
@@ -455,11 +455,12 @@
    If NOINHERIT, don't accept a subkeymap found in an inherited keymap.  */
 
 Lisp_Object
-access_keymap (map, idx, t_ok, noinherit)
+access_keymap (map, idx, t_ok, noinherit, autoload)
      Lisp_Object map;
      Lisp_Object idx;
      int t_ok;
      int noinherit;
+     int autoload;
 {
   int noprefix = 0;
   Lisp_Object val;
@@ -478,12 +479,23 @@
        with more than 24 bits of integer.  */
     XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
 
+  /* Handle the special meta -> esc mapping. */
+  if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
+    {
+      map = get_keymap_1 (access_keymap
+			  (map, meta_prefix_char, t_ok, noinherit, autoload),
+			  0, autoload);
+      XSETINT (idx, XFASTINT (idx) & ~meta_modifier);
+    }
+
   {
     Lisp_Object tail;
     Lisp_Object t_binding;
 
     t_binding = Qnil;
-    for (tail = map; CONSP (tail); tail = XCDR (tail))
+    for (tail = XCDR (map);
+	 CONSP (tail) || (tail = get_keymap_1(tail, 0, autoload), CONSP (tail));
+	 tail = XCDR (tail))
       {
 	Lisp_Object binding;
 
@@ -492,7 +504,7 @@
 	  {
 	    /* If NOINHERIT, stop finding prefix definitions
 	       after we pass a second occurrence of the `keymap' symbol.  */
-	    if (noinherit && EQ (binding, Qkeymap) && ! EQ (tail, map))
+	    if (noinherit && EQ (binding, Qkeymap))
 	      noprefix = 1;
 	  }
 	else if (CONSP (binding))
@@ -504,7 +516,7 @@
 		  return Qnil;
 		if (CONSP (val))
 		  fix_submap_inheritance (map, idx, val);
-		return val;
+		return get_keyelt (val, autoload);
 	      }
 	    if (t_ok && EQ (XCAR (binding), Qt))
 	      t_binding = XCDR (binding);
@@ -518,7 +530,7 @@
 		  return Qnil;
 		if (CONSP (val))
 		  fix_submap_inheritance (map, idx, val);
-		return val;
+		return get_keyelt (val, autoload);
 	      }
 	  }
 	else if (CHAR_TABLE_P (binding))
@@ -536,14 +548,14 @@
 		  return Qnil;
 		if (CONSP (val))
 		  fix_submap_inheritance (map, idx, val);
-		return val;
+		return get_keyelt (val, autoload);
 	      }
 	  }
 
 	QUIT;
       }
 
-    return t_binding;
+    return get_keyelt (t_binding, autoload);
   }
 }
 
@@ -635,26 +647,9 @@
       else
 	{
 	  Lisp_Object map;
-	  
 	  map = get_keymap_1 (Fcar_safe (object), 0, autoload);
-	  if (NILP (map))
-	    /* Invalid keymap */
-	    return object;
-	  else
-	    {
-	      Lisp_Object key;
-	      key = Fcdr (object);
-	      if (INTEGERP (key) && (XUINT (key) & meta_modifier))
-		{
-		  object = access_keymap (map, meta_prefix_char, 0, 0);
-		  map = get_keymap_1 (object, 0, autoload);
-		  object = access_keymap (map, make_number (XINT (key)
-							    & ~meta_modifier),
-					  0, 0);
-		}
-	      else
-		object = access_keymap (map, key, 0, 0);
-	    }
+	  return (NILP (map) ? object /* Invalid keymap */
+		  : access_keymap (map, Fcdr (object), 0, 0, autoload));
 	}
     }
 }
@@ -973,7 +968,7 @@
       if (idx == length)
 	RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
 
-      cmd = get_keyelt (access_keymap (keymap, c, 0, 1), 1);
+      cmd = access_keymap (keymap, c, 0, 1, 1);
 
       /* If this key is undefined, make it a prefix.  */
       if (NILP (cmd))
@@ -1014,10 +1009,8 @@
   register int idx;
   register Lisp_Object cmd;
   register Lisp_Object c;
-  int metized = 0;
   int length;
   int t_ok = ! NILP (accept_default);
-  int meta_bit;
   struct gcpro gcpro1;
 
   keymap = get_keymap_1 (keymap, 1, 1);
@@ -1029,38 +1022,21 @@
   if (length == 0)
     return keymap;
 
-  if (VECTORP (key))
-    meta_bit = meta_modifier;
-  else
-    meta_bit = 0x80;
-
   GCPRO1 (key);
 
   idx = 0;
   while (1)
     {
-      c = Faref (key, make_number (idx));
+      c = Faref (key, make_number (idx++));
 
       if (CONSP (c) && lucid_event_type_list_p (c))
 	c = Fevent_convert_list (c);
 
-      if (INTEGERP (c)
-	  && (XINT (c) & meta_bit)
-	  && !metized)
-	{
-	  c = meta_prefix_char;
-	  metized = 1;
-	}
-      else
-	{
-	  if (INTEGERP (c))
-	    XSETINT (c, XINT (c) & ~meta_bit);
-
-	  metized = 0;
-	  idx++;
-	}
-
-      cmd = get_keyelt (access_keymap (keymap, c, t_ok, 0), 1);
+      /* Turn the 8th bit of string chars into a meta modifier.  */
+      if (XINT (c) & 0x80 && STRINGP (key))
+	XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
+
+      cmd = access_keymap (keymap, c, t_ok, 0, 1);
       if (idx == length)
 	RETURN_UNGCPRO (cmd);
 
@@ -1080,44 +1056,13 @@
 define_as_prefix (keymap, c)
      Lisp_Object keymap, c;
 {
-  Lisp_Object inherit, cmd;
+  Lisp_Object cmd;
 
   cmd = Fmake_sparse_keymap (Qnil);
   /* If this key is defined as a prefix in an inherited keymap,
      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
-	 and it doesn't define this key,
-	 make it define this key.  */
-      Lisp_Object tail;
-
-      for (tail = Fcdr (keymap); CONSP (tail); tail = XCDR (tail))
-	if (EQ (XCAR (tail), Qkeymap))
-	  break;
-
-      if (!NILP (tail))
-	inherit = define_as_prefix (tail, c);
-    }
-#endif
-
-  cmd = nconc2 (cmd, inherit);
+  cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
   store_in_keymap (keymap, c, cmd);
 
   return cmd;
@@ -2082,6 +2027,15 @@
 
 /* This function can GC if Flookup_key autoloads any keymaps.  */
 
+static INLINE int
+menu_item_p (item)
+     Lisp_Object item;
+{
+  return (CONSP (item)
+	  && (EQ (XCAR (item),Qmenu_item)
+	      || STRINGP (XCAR (item))));
+}
+
 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
   "Return list of keys that invoke DEFINITION.\n\
 If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
@@ -2334,6 +2288,10 @@
   int keymap_specified = !NILP (keymap);
   struct gcpro gcpro1, gcpro2;
 
+  /* Skip left-over menu-items.
+     These can appear in a keymap bound to a mouse click, for example.  */
+  if (nomenus && menu_item_p (binding))
+    return Qnil;
   /* Search through indirections unless that's not wanted.  */
   if (NILP (noindirect))
     binding = get_keyelt (binding, 0);
--- a/src/lisp.h	Sun Oct 15 02:31:42 2000 +0000
+++ b/src/lisp.h	Sun Oct 15 03:31:21 2000 +0000
@@ -2591,7 +2591,7 @@
 EXFUN (Fkey_description, 1);
 EXFUN (Fsingle_key_description, 2);
 EXFUN (Fwhere_is_internal, 4);
-extern Lisp_Object access_keymap P_ ((Lisp_Object, Lisp_Object, int, int));
+extern Lisp_Object access_keymap P_ ((Lisp_Object, Lisp_Object, int, int, int));
 extern Lisp_Object get_keyelt P_ ((Lisp_Object, int));
 extern Lisp_Object get_keymap P_ ((Lisp_Object));
 extern Lisp_Object get_keymap_1 P_ ((Lisp_Object, int, int));