keymap.c

/* Manipulation of keymaps
   Copyright (C) 1985-1988, 1993-1995, 1998-2013 Free Software
   Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */

/* Old BUGS:
   - [M-C-a] != [?\M-\C-a]
   - [M-f2] != [?\e f2].
   - (define-key map [menu-bar foo] <bla>) does not always place <bla>
     at the head of the menu (if `foo' was already bound earlier and
     then unbound, for example).
   TODO:
   - allow many more Meta -> ESC mappings (like Hyper -> C-e for Emacspeak)
   - Think about the various defaulting that's currently hard-coded in
     keyboard.c (uppercase->lowercase, char->charset, button-events, ...)
     and make it more generic.  Maybe we should allow mappings of the
     form (PREDICATE . BINDING) as generalization of the default binding,
     tho probably a cleaner way to attack this is to allow functional
     keymaps (i.e. keymaps that are implemented as functions that implement
     a few different methods like `lookup', `map', ...).
   - Make [a] equivalent to [?a].
   BEWARE:
   - map-keymap should work meaningfully even if entries are added/removed
     to the keymap while iterating through it:
       start - removed <= visited <= start + added
 */

#include <config.h>
#include <stdio.h>

#include "lisp.h"
#include "commands.h"
#include "character.h"
#include "buffer.h"
#include "charset.h"
#include "keyboard.h"
#include "frame.h"
#include "termhooks.h"
#include "blockinput.h"
#include "puresize.h"
#include "intervals.h"
#include "keymap.h"
#include "window.h"

/* Actually allocate storage for these variables.  */

Lisp_Object current_global_map;	/* Current global keymap.  */

Lisp_Object global_map;		/* Default global key bindings.  */

Lisp_Object meta_map;		/* The keymap used for globally bound
				   ESC-prefixed default commands.  */

Lisp_Object control_x_map;	/* The keymap used for globally bound
				   C-x-prefixed default commands.  */

				/* The keymap used by the minibuf for local
				   bindings when spaces are allowed in the
				   minibuf.  */

				/* The keymap used by the minibuf for local
				   bindings when spaces are not encouraged
				   in the minibuf.  */

/* Keymap used for minibuffers when doing completion.  */
/* Keymap used for minibuffers when doing completion and require a match.  */
static Lisp_Object Qkeymapp, Qnon_ascii;
Lisp_Object Qkeymap, Qmenu_item, Qremap;
static Lisp_Object QCadvertised_binding;

/* Alist of elements like (DEL . "\d").  */
static Lisp_Object exclude_keys;

/* Pre-allocated 2-element vector for Fcommand_remapping to use.  */
static Lisp_Object command_remapping_vector;

/* Hash table used to cache a reverse-map to speed up calls to where-is.  */
static Lisp_Object where_is_cache;
/* Which keymaps are reverse-stored in the cache.  */
static Lisp_Object where_is_cache_keymaps;

static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object);

static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object);
static void describe_command (Lisp_Object, Lisp_Object);
static void describe_translation (Lisp_Object, Lisp_Object);
static void describe_map (Lisp_Object, Lisp_Object,
                          void (*) (Lisp_Object, Lisp_Object),
			  bool, Lisp_Object, Lisp_Object*, bool, bool);
static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object,
                             void (*) (Lisp_Object, Lisp_Object), bool,
                             Lisp_Object, Lisp_Object, bool, bool);
static void silly_event_symbol_error (Lisp_Object);
static Lisp_Object get_keyelt (Lisp_Object, bool);

static void
CHECK_VECTOR_OR_CHAR_TABLE (Lisp_Object x)
{
  CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x);
}

/* Keymap object support - constructors and predicates.			*/

DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
       doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
CHARTABLE is a char-table that holds the bindings for all characters
without modifiers.  All entries in it are initially nil, meaning
"command undefined".  ALIST is an assoc-list which holds bindings for
function keys, mouse events, and any other things that appear in the
input stream.  Initially, ALIST is nil.

The optional arg STRING supplies a menu name for the keymap
in case you use it as a menu with `x-popup-menu'.  */)
  (Lisp_Object string)
{
  Lisp_Object tail;
  if (!NILP (string))
    tail = Fcons (string, Qnil);
  else
    tail = Qnil;
  return Fcons (Qkeymap,
		Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
}

DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
       doc: /* Construct and return a new sparse keymap.
Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
which binds the function key or mouse event SYMBOL to DEFINITION.
Initially the alist is nil.

The optional arg STRING supplies a menu name for the keymap
in case you use it as a menu with `x-popup-menu'.  */)
  (Lisp_Object string)
{
  if (!NILP (string))
    {
      if (!NILP (Vpurify_flag))
	string = Fpurecopy (string);
      return Fcons (Qkeymap, Fcons (string, Qnil));
    }
  return Fcons (Qkeymap, Qnil);
}

/* This function is used for installing the standard key bindings
   at initialization time.

   For example:

   initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark");  */

void
initial_define_key (Lisp_Object keymap, int key, const char *defname)
{
  store_in_keymap (keymap, make_number (key), intern_c_string (defname));
}

void
initial_define_lispy_key (Lisp_Object keymap, const char *keyname, const char *defname)
{
  store_in_keymap (keymap, intern_c_string (keyname), intern_c_string (defname));
}

DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
       doc: /* Return t if OBJECT is a keymap.

A keymap is a list (keymap . ALIST),
or a symbol whose function definition is itself a keymap.
ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
a vector of densely packed bindings for small character codes
is also allowed as an element.  */)
  (Lisp_Object object)
{
  return (KEYMAPP (object) ? Qt : Qnil);
}

DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
       doc: /* Return the prompt-string of a keymap MAP.
If non-nil, the prompt is shown in the echo-area
when reading a key-sequence to be looked-up in this keymap.  */)
  (Lisp_Object map)
{
  map = get_keymap (map, 0, 0);
  while (CONSP (map))
    {
      Lisp_Object tem = XCAR (map);
      if (STRINGP (tem))
	return tem;
      else if (KEYMAPP (tem))
	{
	  tem = Fkeymap_prompt (tem);
	  if (!NILP (tem))
	    return tem;
	}
      map = XCDR (map);
    }
  return Qnil;
}

/* Check that OBJECT is a keymap (after dereferencing through any
   symbols).  If it is, return it.

   If AUTOLOAD and if OBJECT is a symbol whose function value
   is an autoload form, do the autoload and try again.
   If AUTOLOAD, callers must assume GC is possible.

   ERROR_IF_NOT_KEYMAP controls how we respond if OBJECT isn't a keymap.
   If ERROR_IF_NOT_KEYMAP, signal an error; otherwise,
   just return Qnil.

   Note that most of the time, we don't want to pursue autoloads.
   Functions like Faccessible_keymaps which scan entire keymap trees
   shouldn't load every autoloaded keymap.  I'm not sure about this,
   but it seems to me that only read_key_sequence, Flookup_key, and
   Fdefine_key should cause keymaps to be autoloaded.

   This function can GC when AUTOLOAD is true, because it calls
   Fautoload_do_load which can GC.  */

Lisp_Object
get_keymap (Lisp_Object object, bool error_if_not_keymap, bool autoload)
{
  Lisp_Object tem;

 autoload_retry:
  if (NILP (object))
    goto end;
  if (CONSP (object) && EQ (XCAR (object), Qkeymap))
    return object;

  tem = indirect_function (object);
  if (CONSP (tem))
    {
      if (EQ (XCAR (tem), Qkeymap))
	return tem;

      /* Should we do an autoload?  Autoload forms for keymaps have
	 Qkeymap as their fifth element.  */
      if ((autoload || !error_if_not_keymap) && EQ (XCAR (tem), Qautoload)
	  && SYMBOLP (object))
	{
	  Lisp_Object tail;

	  tail = Fnth (make_number (4), tem);
	  if (EQ (tail, Qkeymap))
	    {
	      if (autoload)
		{
		  struct gcpro gcpro1, gcpro2;

		  GCPRO2 (tem, object);
		  Fautoload_do_load (tem, object, Qnil);
		  UNGCPRO;

		  goto autoload_retry;
		}
	      else
	      	return object;
	    }
	}
    }

 end:
  if (error_if_not_keymap)
    wrong_type_argument (Qkeymapp, object);
  return Qnil;
}

/* Return the parent map of KEYMAP, or nil if it has none.
   We assume that KEYMAP is a valid keymap.  */

static Lisp_Object
keymap_parent (Lisp_Object keymap, bool autoload)
{
  Lisp_Object list;

  keymap = get_keymap (keymap, 1, autoload);

  /* Skip past the initial element `keymap'.  */
  list = XCDR (keymap);
  for (; CONSP (list); list = XCDR (list))
    {
      /* See if there is another `keymap'.  */
      if (KEYMAPP (list))
	return list;
    }

  return get_keymap (list, 0, autoload);
}

DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
       doc: /* Return the parent keymap of KEYMAP.
If KEYMAP has no parent, return nil.  */)
  (Lisp_Object keymap)
{
  return keymap_parent (keymap, 1);
}

/* Check whether MAP is one of MAPS parents.  */
static bool
keymap_memberp (Lisp_Object map, Lisp_Object maps)
{
  if (NILP (map)) return 0;
  while (KEYMAPP (maps) && !EQ (map, maps))
    maps = keymap_parent (maps, 0);
  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,
       doc: /* Modify KEYMAP to set its parent map to PARENT.
Return PARENT.  PARENT should be nil or another keymap.  */)
  (Lisp_Object keymap, Lisp_Object parent)
{
  Lisp_Object list, prev;
  struct gcpro gcpro1, gcpro2;

  /* Flush any reverse-map cache.  */
  where_is_cache = Qnil; where_is_cache_keymaps = Qt;

  GCPRO2 (keymap, parent);
  keymap = get_keymap (keymap, 1, 1);

  if (!NILP (parent))
    {
      parent = get_keymap (parent, 1, 0);

      /* Check for cycles.  */
      if (keymap_memberp (keymap, parent))
	error ("Cyclic keymap inheritance");
    }

  /* Skip past the initial element `keymap'.  */
  prev = keymap;
  while (1)
    {
      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))
	{
	  CHECK_IMPURE (prev);
	  XSETCDR (prev, parent);
	  RETURN_UNGCPRO (parent);
	}
      prev = list;
    }
}


/* 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.

   MAP must be a keymap or a list of keymaps.

   If T_OK, bindings for Qt are treated as default
   bindings; any key left unmentioned by other tables and bindings is
   given the binding of Qt.

   If not T_OK, bindings for Qt are not treated specially.

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

   Return Qunbound if no binding was found (and return Qnil if a nil
   binding was found).  */

static Lisp_Object
access_keymap_1 (Lisp_Object map, Lisp_Object idx,
		 bool t_ok, bool noinherit, bool autoload)
{
  /* If idx is a list (some sort of mouse click, perhaps?),
     the index we want to use is the car of the list, which
     ought to be a symbol.  */
  idx = EVENT_HEAD (idx);

  /* If idx is a symbol, it might have modifiers, which need to
     be put in the canonical order.  */
  if (SYMBOLP (idx))
    idx = reorder_modifiers (idx);
  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) && XFASTINT (idx) & meta_modifier)
    {
      /* See if there is a meta-map.  If there's none, there is
         no binding for IDX, unless a default binding exists in MAP.  */
      struct gcpro gcpro1;
      Lisp_Object event_meta_binding, event_meta_map;
      GCPRO1 (map);
      /* A strange value in which Meta is set would cause
	 infinite recursion.  Protect against that.  */
      if (XINT (meta_prefix_char) & CHAR_META)
	meta_prefix_char = make_number (27);
      event_meta_binding = access_keymap_1 (map, meta_prefix_char, t_ok,
					    noinherit, autoload);
      event_meta_map = get_keymap (event_meta_binding, 0, autoload);
      UNGCPRO;
      if (CONSP (event_meta_map))
	{
	  map = event_meta_map;
	  idx = make_number (XFASTINT (idx) & ~meta_modifier);
	}
      else if (t_ok)
	/* Set IDX to t, so that we only find a default binding.  */
	idx = Qt;
      else
	/* An explicit nil binding, or no binding at all.  */
	return NILP (event_meta_binding) ? Qnil : Qunbound;
    }

  /* t_binding is where we put a default binding that applies,
     to use in case we do not find a binding specifically
     for this key sequence.  */
  {
    Lisp_Object tail;
    Lisp_Object t_binding = Qunbound;
    Lisp_Object retval = Qunbound;
    Lisp_Object retval_tail = Qnil;
    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;

    GCPRO4 (tail, idx, t_binding, retval);

    for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
	 (CONSP (tail)
	  || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
	 tail = XCDR (tail))
      {
	/* Qunbound in VAL means we have found no binding.  */
	Lisp_Object val = Qunbound;
	Lisp_Object binding = XCAR (tail);
	Lisp_Object submap = get_keymap (binding, 0, autoload);

	if (EQ (binding, Qkeymap))
	  {
	    if (noinherit || NILP (retval))
	      /* If NOINHERIT, stop here, the rest is inherited.  */
	      break;
	    else if (!EQ (retval, Qunbound))
	      {
		Lisp_Object parent_entry;
		eassert (KEYMAPP (retval));
		parent_entry
		  = get_keymap (access_keymap_1 (tail, idx,
						 t_ok, 0, autoload),
				0, autoload);
		if (KEYMAPP (parent_entry))
		  {
		    if (CONSP (retval_tail))
		      XSETCDR (retval_tail, parent_entry);
		    else
		      {
			retval_tail = Fcons (retval, parent_entry);
			retval = Fcons (Qkeymap, retval_tail);
		      }
		  }
		break;
	      }
	  }
	else if (CONSP (submap))
	  {
	    val = access_keymap_1 (submap, idx, t_ok, noinherit, autoload);
	  }
	else if (CONSP (binding))
	  {
	    Lisp_Object key = XCAR (binding);

	    if (EQ (key, idx))
	      val = XCDR (binding);
	    else if (t_ok && EQ (key, Qt))
	      {
		t_binding = XCDR (binding);
		t_ok = 0;
	      }
	  }
	else if (VECTORP (binding))
	  {
	    if (INTEGERP (idx) && XFASTINT (idx) < ASIZE (binding))
	      val = AREF (binding, XFASTINT (idx));
	  }
	else if (CHAR_TABLE_P (binding))
	  {
	    /* Character codes with modifiers
	       are not included in a char-table.
	       All character codes without modifiers are included.  */
	    if (INTEGERP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
	      {
		val = Faref (binding, idx);
		/* `nil' has a special meaning for char-tables, so
		   we use something else to record an explicitly
		   unbound entry.  */
		if (NILP (val))
		  val = Qunbound;
	      }
	  }

	/* If we found a binding, clean it up and return it.  */
	if (!EQ (val, Qunbound))
	  {
	    if (EQ (val, Qt))
	      /* A Qt binding is just like an explicit nil binding
		 (i.e. it shadows any parent binding but not bindings in
		 keymaps of lower precedence).  */
	      val = Qnil;

	    val = get_keyelt (val, autoload);

	    if (!KEYMAPP (val))
	      {
		if (NILP (retval) || EQ (retval, Qunbound))
		  retval = val;
		if (!NILP (val))
		  break;  /* Shadows everything that follows.  */
	      }
	    else if (NILP (retval) || EQ (retval, Qunbound))
	      retval = val;
	    else if (CONSP (retval_tail))
	      {
		XSETCDR (retval_tail, Fcons (val, Qnil));
		retval_tail = XCDR (retval_tail);
	      }
	    else
	      {
		retval_tail = Fcons (val, Qnil);
		retval = Fcons (Qkeymap, Fcons (retval, retval_tail));
	      }
	  }
	QUIT;
      }
    UNGCPRO;
    return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval;
  }
}

Lisp_Object
access_keymap (Lisp_Object map, Lisp_Object idx,
	       bool t_ok, bool noinherit, bool autoload)
{
  Lisp_Object val = access_keymap_1 (map, idx, t_ok, noinherit, autoload);
  return EQ (val, Qunbound) ? Qnil : val;
}

static void
map_keymap_item (map_keymap_function_t fun, Lisp_Object args, Lisp_Object key, Lisp_Object val, void *data)
{
  if (EQ (val, Qt))
    val = Qnil;
  (*fun) (key, val, args, data);
}

static void
map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val)
{
  if (!NILP (val))
    {
      map_keymap_function_t fun
	= (map_keymap_function_t) XSAVE_FUNCPOINTER (args, 0);
      /* If the key is a range, make a copy since map_char_table modifies
	 it in place.  */
      if (CONSP (key))
	key = Fcons (XCAR (key), XCDR (key));
      map_keymap_item (fun, XSAVE_OBJECT (args, 2), key,
		       val, XSAVE_POINTER (args, 1));
    }
}

/* Call FUN for every binding in MAP and stop at (and return) the parent.
   FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).  */
static Lisp_Object
map_keymap_internal (Lisp_Object map,
		     map_keymap_function_t fun,
		     Lisp_Object args,
		     void *data)
{
  struct gcpro gcpro1, gcpro2, gcpro3;
  Lisp_Object tail
    = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;

  GCPRO3 (map, args, tail);
  for (; CONSP (tail) && !EQ (Qkeymap, XCAR (tail)); tail = XCDR (tail))
    {
      Lisp_Object binding = XCAR (tail);

      if (KEYMAPP (binding))	/* An embedded parent.  */
	break;
      else if (CONSP (binding))
	map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
      else if (VECTORP (binding))
	{
	  /* Loop over the char values represented in the vector.  */
	  int len = ASIZE (binding);
	  int c;
	  for (c = 0; c < len; c++)
	    {
	      Lisp_Object character;
	      XSETFASTINT (character, c);
	      map_keymap_item (fun, args, character, AREF (binding, c), data);
	    }
	}
      else if (CHAR_TABLE_P (binding))
	map_char_table (map_keymap_char_table_item, Qnil, binding,
			make_save_value (SAVE_TYPE_FUNCPTR_PTR_OBJ,
					 (voidfuncptr) fun, data, args));
    }
  UNGCPRO;
  return tail;
}

static void
map_keymap_call (Lisp_Object key, Lisp_Object val, Lisp_Object fun, void *dummy)
{
  call2 (fun, key, val);
}

/* Same as map_keymap_internal, but traverses parent keymaps as well.
   AUTOLOAD indicates that autoloaded keymaps should be loaded.  */
void
map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args,
	    void *data, bool autoload)
{
  struct gcpro gcpro1;
  GCPRO1 (args);
  map = get_keymap (map, 1, autoload);
  while (CONSP (map))
    {
      if (KEYMAPP (XCAR (map)))
	{
	  map_keymap (XCAR (map), fun, args, data, autoload);
	  map = XCDR (map);
	}
      else
	map = map_keymap_internal (map, fun, args, data);
      if (!CONSP (map))
	map = get_keymap (map, 0, autoload);
    }
  UNGCPRO;
}

static Lisp_Object Qkeymap_canonicalize;

/* Same as map_keymap, but does it right, properly eliminating duplicate
   bindings due to inheritance.   */
void
map_keymap_canonical (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data)
{
  struct gcpro gcpro1;
  GCPRO1 (args);
  /* map_keymap_canonical may be used from redisplay (e.g. when building menus)
     so be careful to ignore errors and to inhibit redisplay.  */
  map = safe_call1 (Qkeymap_canonicalize, map);
  /* No need to use `map_keymap' here because canonical map has no parent.  */
  map_keymap_internal (map, fun, args, data);
  UNGCPRO;
}

DEFUN ("map-keymap-internal", Fmap_keymap_internal, Smap_keymap_internal, 2, 2, 0,
       doc: /* Call FUNCTION once for each event binding in KEYMAP.
FUNCTION is called with two arguments: the event that is bound, and
the definition it is bound to.  The event may be a character range.
If KEYMAP has a parent, this function returns it without processing it.  */)
  (Lisp_Object function, Lisp_Object keymap)
{
  struct gcpro gcpro1;
  GCPRO1 (function);
  keymap = get_keymap (keymap, 1, 1);
  keymap = map_keymap_internal (keymap, map_keymap_call, function, NULL);
  UNGCPRO;
  return keymap;
}

DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
       doc: /* Call FUNCTION once for each event binding in KEYMAP.
FUNCTION is called with two arguments: the event that is bound, and
the definition it is bound to.  The event may be a character range.

If KEYMAP has a parent, the parent's bindings are included as well.
This works recursively: if the parent has itself a parent, then the
grandparent's bindings are also included and so on.
usage: (map-keymap FUNCTION KEYMAP)  */)
  (Lisp_Object function, Lisp_Object keymap, Lisp_Object sort_first)
{
  if (! NILP (sort_first))
    return call2 (intern ("map-keymap-sorted"), function, keymap);

  map_keymap (keymap, map_keymap_call, function, NULL, 1);
  return Qnil;
}

/* Given OBJECT which was found in a slot in a keymap,
   trace indirect definitions to get the actual definition of that slot.
   An indirect definition is a list of the form
   (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
   and INDEX is the object to look up in KEYMAP to yield the definition.

   Also if OBJECT has a menu string as the first element,
   remove that.  Also remove a menu help string as second element.

   If AUTOLOAD, load autoloadable keymaps
   that are referred to with indirection.

   This can GC because menu_item_eval_property calls Feval.  */

static Lisp_Object
get_keyelt (Lisp_Object object, bool autoload)
{
  while (1)
    {
      if (!(CONSP (object)))
	/* This is really the value.  */
	return object;

      /* If the keymap contents looks like (keymap ...) or (lambda ...)
	 then use itself. */
      else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
	return object;

      /* If the keymap contents looks like (menu-item name . DEFN)
	 or (menu-item name DEFN ...) then use DEFN.
	 This is a new format menu item.  */
      else if (EQ (XCAR (object), Qmenu_item))
	{
	  if (CONSP (XCDR (object)))
	    {
	      Lisp_Object tem;

	      object = XCDR (XCDR (object));
	      tem = object;
	      if (CONSP (object))
		object = XCAR (object);

	      /* If there's a `:filter FILTER', apply FILTER to the
		 menu-item's definition to get the real definition to
		 use.  */
	      for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
		if (EQ (XCAR (tem), QCfilter) && autoload)
		  {
		    Lisp_Object filter;
		    filter = XCAR (XCDR (tem));
		    filter = list2 (filter, list2 (Qquote, object));
		    object = menu_item_eval_property (filter);
		    break;
		  }
	    }
	  else
	    /* Invalid keymap.  */
	    return object;
	}

      /* If the keymap contents looks like (STRING . DEFN), use DEFN.
	 Keymap alist elements like (CHAR MENUSTRING . DEFN)
	 will be used by HierarKey menus.  */
      else if (STRINGP (XCAR (object)))
	{
	  object = XCDR (object);
	  /* Also remove a menu help string, if any,
	     following the menu item name.  */
	  if (CONSP (object) && STRINGP (XCAR (object)))
	    object = XCDR (object);
	  /* Also remove the sublist that caches key equivalences, if any.  */
	  if (CONSP (object) && CONSP (XCAR (object)))
	    {
	      Lisp_Object carcar;
	      carcar = XCAR (XCAR (object));
	      if (NILP (carcar) || VECTORP (carcar))
		object = XCDR (object);
	    }
	}

      /* If the contents are (KEYMAP . ELEMENT), go indirect.  */
      else if (KEYMAPP (XCAR (object)))
	error ("Wow, indirect keymap entry!!");
      else
	return object;
    }
}

static Lisp_Object
store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
{
  /* Flush any reverse-map cache.  */
  where_is_cache = Qnil;
  where_is_cache_keymaps = Qt;

  if (EQ (idx, Qkeymap))
    error ("`keymap' is reserved for embedded parent maps");

  /* If we are preparing to dump, and DEF is a menu element
     with a menu item indicator, copy it to ensure it is not pure.  */
  if (CONSP (def) && PURE_P (def)
      && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
    def = Fcons (XCAR (def), XCDR (def));

  if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
    error ("attempt to define a key in a non-keymap");