comparison src/keymap.c @ 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.

32475:753586cbb758

      /* See if there is another `keymap'.  */
      if (KEYMAPP (list))
	return list;
    }

  return Qnil;
}


/* Check whether MAP is one of MAPS parents.  */
int

  if (NILP (submap))
    return;

  map_parent = Fkeymap_parent (map);
  if (! NILP (map_parent))
    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 T_OK is zero, bindings for Qt are not treated specially.

   If NOINHERIT, don't accept a subkeymap found in an inherited keymap.  */

Lisp_Object
access_keymap (map, idx, t_ok, noinherit)
     Lisp_Object map;
     Lisp_Object idx;
     int t_ok;
     int noinherit;
{
  int noprefix = 0;
  Lisp_Object val;

  /* If idx is a list (some sort of mouse click, perhaps?),

  else if (INTEGERP (idx))
    /* Clobber the high bits that can be present on a machine
       with more than 24 bits of integer.  */
    XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));

  {
    Lisp_Object tail;
    Lisp_Object t_binding;

    t_binding = Qnil;
    for (tail = map; CONSP (tail); tail = XCDR (tail))
      {
	Lisp_Object binding;

	binding = XCAR (tail);
	if (SYMBOLP (binding))
	  {
	    /* If NOINHERIT, stop finding prefix definitions
	       after we pass a second occurrence of the `keymap' symbol.  */
	    if (noinherit && EQ (binding, Qkeymap) && ! EQ (tail, map))
	      noprefix = 1;
	  }
	else if (CONSP (binding))
	  {
	    if (EQ (XCAR (binding), idx))

		val = XCDR (binding);
		if (noprefix && KEYMAPP (val))
		  return Qnil;
		if (CONSP (val))
		  fix_submap_inheritance (map, idx, val);
		return val;
	      }
	    if (t_ok && EQ (XCAR (binding), Qt))
	      t_binding = XCDR (binding);
	  }
	else if (VECTORP (binding))

		val = XVECTOR (binding)->contents[XFASTINT (idx)];
		if (noprefix && KEYMAPP (val))
		  return Qnil;
		if (CONSP (val))
		  fix_submap_inheritance (map, idx, val);
		return val;
	      }
	  }
	else if (CHAR_TABLE_P (binding))
	  {
	    /* Character codes with modifiers

		val = Faref (binding, idx);
		if (noprefix && KEYMAPP (val))
		  return Qnil;
		if (CONSP (val))
		  fix_submap_inheritance (map, idx, val);
		return val;
	      }
	  }

	QUIT;
      }

    return t_binding;
  }
}

/* Given OBJECT which was found in a slot in a keymap,
   trace indirect definitions to get the actual definition of that slot.

      /* If the contents are (KEYMAP . ELEMENT), go indirect.  */
      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);
	    }
	}
    }
}

static Lisp_Object

	error ("Key sequence contains invalid events");

      if (idx == length)
	RETURN_UNGCPRO (store_in_keymap (keymap, c, def));

      cmd = get_keyelt (access_keymap (keymap, c, 0, 1), 1);

      /* If this key is undefined, make it a prefix.  */
      if (NILP (cmd))
	cmd = define_as_prefix (keymap, c);

     Lisp_Object accept_default;
{
  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);

  if (!VECTORP (key) && !STRINGP (key))

  length = XFASTINT (Flength (key));
  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));

      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);
      if (idx == length)
	RETURN_UNGCPRO (cmd);

      keymap = get_keymap_1 (cmd, 0, 1);
      if (NILP (keymap))

static Lisp_Object
define_as_prefix (keymap, c)
     Lisp_Object keymap, c;
{
  Lisp_Object inherit, 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);
  store_in_keymap (keymap, c, cmd);

  return cmd;
}

static Lisp_Object where_is_internal_1 ();
static void where_is_internal_2 ();

/* This function can GC if Flookup_key autoloads any keymaps.  */

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\
If KEYMAP is nil, search all the currently active keymaps.\n\
\n\

{
  Lisp_Object sequence;
  int keymap_specified = !NILP (keymap);
  struct gcpro gcpro1, gcpro2;

  /* Search through indirections unless that's not wanted.  */
  if (NILP (noindirect))
    binding = get_keyelt (binding, 0);

  /* End this iteration if this element does not match

32476:9b2a0dc393a4

      /* See if there is another `keymap'.  */
      if (KEYMAPP (list))
	return list;
    }

  return get_keymap_1(list, 0, autoload);
}


/* Check whether MAP is one of MAPS parents.  */
int

  if (NILP (submap))
    return;

  map_parent = Fkeymap_parent (map);
  if (! NILP (map_parent))
    parent_entry = 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 T_OK is zero, bindings for Qt are not treated specially.

   If NOINHERIT, don't accept a subkeymap found in an inherited keymap.  */

Lisp_Object
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;

  /* If idx is a list (some sort of mouse click, perhaps?),

  else if (INTEGERP (idx))
    /* Clobber the high bits that can be present on a machine
       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 = XCDR (map);
	 CONSP (tail) || (tail = get_keymap_1(tail, 0, autoload), CONSP (tail));
	 tail = XCDR (tail))
      {
	Lisp_Object binding;

	binding = XCAR (tail);
	if (SYMBOLP (binding))
	  {
	    /* If NOINHERIT, stop finding prefix definitions
	       after we pass a second occurrence of the `keymap' symbol.  */
	    if (noinherit && EQ (binding, Qkeymap))
	      noprefix = 1;
	  }
	else if (CONSP (binding))
	  {
	    if (EQ (XCAR (binding), idx))

		val = XCDR (binding);
		if (noprefix && KEYMAPP (val))
		  return Qnil;
		if (CONSP (val))
		  fix_submap_inheritance (map, idx, val);
		return get_keyelt (val, autoload);
	      }
	    if (t_ok && EQ (XCAR (binding), Qt))
	      t_binding = XCDR (binding);
	  }
	else if (VECTORP (binding))

		val = XVECTOR (binding)->contents[XFASTINT (idx)];
		if (noprefix && KEYMAPP (val))
		  return Qnil;
		if (CONSP (val))
		  fix_submap_inheritance (map, idx, val);
		return get_keyelt (val, autoload);
	      }
	  }
	else if (CHAR_TABLE_P (binding))
	  {
	    /* Character codes with modifiers

		val = Faref (binding, idx);
		if (noprefix && KEYMAPP (val))
		  return Qnil;
		if (CONSP (val))
		  fix_submap_inheritance (map, idx, val);
		return get_keyelt (val, autoload);
	      }
	  }

	QUIT;
      }

    return get_keyelt (t_binding, autoload);
  }
}

/* Given OBJECT which was found in a slot in a keymap,
   trace indirect definitions to get the actual definition of that slot.

      /* If the contents are (KEYMAP . ELEMENT), go indirect.  */
      else
	{
	  Lisp_Object map;
	  map = get_keymap_1 (Fcar_safe (object), 0, autoload);
	  return (NILP (map) ? object /* Invalid keymap */
		  : access_keymap (map, Fcdr (object), 0, 0, autoload));
	}
    }
}

static Lisp_Object

	error ("Key sequence contains invalid events");

      if (idx == length)
	RETURN_UNGCPRO (store_in_keymap (keymap, c, def));

      cmd = access_keymap (keymap, c, 0, 1, 1);

      /* If this key is undefined, make it a prefix.  */
      if (NILP (cmd))
	cmd = define_as_prefix (keymap, c);

     Lisp_Object accept_default;
{
  register int idx;
  register Lisp_Object cmd;
  register Lisp_Object c;
  int length;
  int t_ok = ! NILP (accept_default);
  struct gcpro gcpro1;

  keymap = get_keymap_1 (keymap, 1, 1);

  if (!VECTORP (key) && !STRINGP (key))

  length = XFASTINT (Flength (key));
  if (length == 0)
    return keymap;

  GCPRO1 (key);

  idx = 0;
  while (1)
    {
      c = Faref (key, make_number (idx++));

      if (CONSP (c) && lucid_event_type_list_p (c))
	c = Fevent_convert_list (c);

      /* 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);

      keymap = get_keymap_1 (cmd, 0, 1);
      if (NILP (keymap))

static Lisp_Object
define_as_prefix (keymap, c)
     Lisp_Object keymap, c;
{
  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.  */
  cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
  store_in_keymap (keymap, c, cmd);

  return cmd;
}

static Lisp_Object where_is_internal_1 ();
static void where_is_internal_2 ();

/* 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\
If KEYMAP is nil, search all the currently active keymaps.\n\
\n\

{
  Lisp_Object sequence;
  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);

  /* End this iteration if this element does not match