comparison src/keymap.c @ 81792:4ee4f467ca51

(struct accessible_keymaps_data, struct where_is_internal_data): New structs. (accessible_keymaps_1, where_is_internal_1): Use them to change interface to adhere to the one used by map_keymap. (Faccessible_keymaps, where_is_internal): Use map_keymap. (accessible_keymaps_char_table, where_is_internal_2): Remove.

81791:98732c4676bc

    RETURN_UNGCPRO (Qnil);

  if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
    Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);

  meta_bit = (VECTORP (key) || STRINGP (key) && STRING_MULTIBYTE (key)
	      ? meta_modifier : 0x80);

  if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
    { /* DEF is apparently an XEmacs-style keyboard macro.  */
      Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);

  return Flist (nmaps, maps);
}

/* Help functions for describing and documenting keymaps.		*/


static void
accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized)
     Lisp_Object maps, tail, thisseq, key, cmd;
     int is_metized;		/* If 1, `key' is assumed to be INTEGERP.  */
{
  Lisp_Object tem;

  cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
  if (NILP (cmd))
    return;

      tem = append_key (thisseq, key);
      nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
    }
}

static void
accessible_keymaps_char_table (args, index, cmd)
     Lisp_Object args, index, cmd;
{
  accessible_keymaps_1 (index, cmd,
			XCAR (XCAR (args)),
			XCAR (XCDR (args)),
			XCDR (XCDR (args)),
			XINT (XCDR (XCAR (args))));
}

/* This function cannot GC.  */

DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
       1, 2, 0,
       doc: /* Find all keymaps accessible via prefix characters from KEYMAP.

then the value includes only maps for prefixes that start with PREFIX.  */)
     (keymap, prefix)
     Lisp_Object keymap, prefix;
{
  Lisp_Object maps, tail;
  int prefixlen = 0;

  /* no need for gcpro because we don't autoload any keymaps.  */

  if (!NILP (prefix))
    prefixlen = XINT (Flength (prefix));

  if (!NILP (prefix))
    {
      /* If a prefix was specified, start with the keymap (if any) for
	 that prefix, so we don't waste time considering other prefixes.  */

      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.  */
      tem = get_keymap (tem, 0, 0);
      if (CONSP (tem))
	{
	  /* Convert PREFIX to a vector now, so that later on
	     we don't have to deal with the possibility of a string.  */
	  if (STRINGP (prefix))
	    {

     This is a breadth-first traversal, where tail is the queue of
     nodes, and maps accumulates a list of all nodes visited.  */

  for (tail = maps; CONSP (tail); tail = XCDR (tail))
    {
      register Lisp_Object thisseq, thismap;
      Lisp_Object last;
      /* Does the current sequence end in the meta-prefix-char?  */
      int is_metized;

      thisseq = Fcar (Fcar (tail));
      thismap = Fcdr (Fcar (tail));
      last = make_number (XINT (Flength (thisseq)) - 1);
      is_metized = (XINT (last) >= 0
		    /* Don't metize the last char of PREFIX.  */
		    && XINT (last) >= prefixlen
		    && EQ (Faref (thisseq, last), meta_prefix_char));

      for (; CONSP (thismap); thismap = XCDR (thismap))
	{
	  Lisp_Object elt;

	  elt = XCAR (thismap);

	  QUIT;

	  if (CHAR_TABLE_P (elt))
	    {
	      Lisp_Object indices[3];

	      map_char_table (accessible_keymaps_char_table, Qnil, elt,
			      elt, Fcons (Fcons (maps, make_number (is_metized)),
					  Fcons (tail, thisseq)),
			      0, indices);
	    }
	  else if (VECTORP (elt))
	    {
	      register int i;

	      /* Vector keymap.  Scan all the elements.  */
	      for (i = 0; i < ASIZE (elt); i++)
		accessible_keymaps_1 (make_number (i), AREF (elt, i),
				      maps, tail, thisseq, is_metized);

	    }
	  else if (CONSP (elt))
	    accessible_keymaps_1 (XCAR (elt), XCDR (elt),
				  maps, tail, thisseq,
				  is_metized && INTEGERP (XCAR (elt)));

	}
    }

  return maps;
}

Lisp_Object Qsingle_key_description, Qkey_description;

/* This function cannot GC.  */

DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,

      if (! CHAR_VALID_P (without_bits, 1))
	{
	  char buf[256];

	  sprintf (buf, "Invalid char code %d", XINT (key));
	  return build_string (buf);
	}
      else if (charset
	       && ((c1 == 0 && c2 == -1) || c2 == 0))
	{


/* where-is - finding a command in a set of keymaps.			*/

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

/* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
   Returns the first non-nil binding found in any of those maps.  */

static Lisp_Object

    }
  return Qnil;
}

static Lisp_Object Vmouse_events;

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

static Lisp_Object
where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)

  for (; !NILP (maps); maps = Fcdr (maps))
    {
      /* Key sequence to reach map, and the map that it reaches */
      register Lisp_Object this, map, tem;

      /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
	 [M-CHAR] sequences, check if last character of the sequence
	 is the meta-prefix char.  */
      Lisp_Object last;

	   non-ascii prefixes like `C-down-mouse-2'.  */
	continue;

      QUIT;

      while (CONSP (map))
	{
	  /* Because the code we want to run on each binding is rather
	     large, we don't want to have two separate loop bodies for
	     sparse keymap bindings and tables; we want to iterate one
	     loop body over both keymap and vector bindings.

	     For this reason, if Fcar (map) is a vector, we don't
	     advance map to the next element until i indicates that we
	     have finished off the vector.  */
	  Lisp_Object elt, key, binding;
	  elt = XCAR (map);
	  map = XCDR (map);

	  sequences = Qnil;

	  QUIT;

	  /* Set key and binding to the current key and binding, and
	     advance map and i to the next binding.  */
	  if (VECTORP (elt))
	    {
	      Lisp_Object sequence;
	      int i;
	      /* In a vector, look at each element.  */
	      for (i = 0; i < XVECTOR (elt)->size; i++)
		{
		  binding = AREF (elt, i);
		  XSETFASTINT (key, i);
		  sequence = where_is_internal_1 (binding, key, definition,
						  noindirect, this,
						  last, nomenus, last_is_meta);
		  if (!NILP (sequence))
		    sequences = Fcons (sequence, sequences);
		}
	    }
	  else if (CHAR_TABLE_P (elt))
	    {
	      Lisp_Object indices[3];
	      Lisp_Object args;

	      args = Fcons (Fcons (Fcons (definition, noindirect),
				   Qnil), /* Result accumulator.  */
			    Fcons (Fcons (this, last),
				   Fcons (make_number (nomenus),
					  make_number (last_is_meta))));
	      map_char_table (where_is_internal_2, Qnil, elt, elt, args,
			      0, indices);
	      sequences = XCDR (XCAR (args));
	    }
	  else if (CONSP (elt))
	    {
	      Lisp_Object sequence;

	      key = XCAR (elt);
	      binding = XCDR (elt);

	      sequence = where_is_internal_1 (binding, key, definition,
					      noindirect, this,
					      last, nomenus, last_is_meta);
	      if (!NILP (sequence))
		sequences = Fcons (sequence, sequences);
	    }


	  while (!NILP (sequences))
	    {
	      Lisp_Object sequence, remapped, function;

	      sequence = XCAR (sequences);
	      sequences = XCDR (sequences);

	      /* If the current sequence is a command remapping with
		 format [remap COMMAND], find the key sequences
		 which run COMMAND, and use those sequences instead.  */
	      remapped = Qnil;
	      if (NILP (no_remap)
		  && VECTORP (sequence) && XVECTOR (sequence)->size == 2
		  && EQ (AREF (sequence, 0), Qremap)
		  && (function = AREF (sequence, 1), SYMBOLP (function)))
		{
		  Lisp_Object remapped1;

		  remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
		  if (CONSP (remapped1))
		    {
		      /* Verify that this key binding actually maps to the
			 remapped command (see below).  */
		      if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
			continue;
		      sequence = XCAR (remapped1);
		      remapped = XCDR (remapped1);
		      goto record_sequence;
		    }
		}

	      /* Verify that this key binding is not shadowed by another
		 binding for the same key, before we say it exists.

		 Mechanism: look for local definition of this key and if
		 it is defined and does not match what we found then
		 ignore this key.

		 Either nil or number as value from Flookup_key
		 means undefined.  */
	      if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
		continue;

	    record_sequence:
	      /* Don't annoy user with strings from a menu such as
		 Select Paste.  Change them all to "(any string)",
		 so that there seems to be only one menu item
		 to report. */
	      if (! NILP (sequence))
		{
		  Lisp_Object tem;
		  tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
		  if (STRINGP (tem))
		    Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
			   build_string ("(any string)"));
		}

	      /* It is a true unshadowed match.  Record it, unless it's already
		 been seen (as could happen when inheriting keymaps).  */
	      if (NILP (Fmember (sequence, found)))
		found = Fcons (sequence, found);

	      /* If firstonly is Qnon_ascii, then we can return the first
		 binding we find.  If firstonly is not Qnon_ascii but not
		 nil, then we should return the first ascii-only binding
		 we find.  */
	      if (EQ (firstonly, Qnon_ascii))
		RETURN_UNGCPRO (sequence);
	      else if (!NILP (firstonly) && ascii_sequence_p (sequence))
		RETURN_UNGCPRO (sequence);

	      if (CONSP (remapped))
		{
		  sequence = XCAR (remapped);
		  remapped = XCDR (remapped);
		  goto record_sequence;
		}
	    }
	}
    }

  UNGCPRO;

    }

  return result;
}

/* This is the function that Fwhere_is_internal calls using map_char_table.
   ARGS has the form
   (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
    .
    ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
   Since map_char_table doesn't really use the return value from this function,
   we the result append to RESULT, the slot in ARGS.

   This function can GC because it calls where_is_internal_1 which can
   GC.  */

static void
where_is_internal_2 (args, key, binding)
     Lisp_Object args, key, binding;
{
  Lisp_Object definition, noindirect, this, last;
  Lisp_Object result, sequence;
  int nomenus, last_is_meta;
  struct gcpro gcpro1, gcpro2, gcpro3;

  GCPRO3 (args, key, binding);
  result = XCDR (XCAR (args));
  definition = XCAR (XCAR (XCAR (args)));
  noindirect = XCDR (XCAR (XCAR (args)));
  this = XCAR (XCAR (XCDR (args)));
  last = XCDR (XCAR (XCDR (args)));
  nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
  last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));

  sequence = where_is_internal_1 (binding, key, definition, noindirect,
				  this, last, nomenus, last_is_meta);

  if (!NILP (sequence))
    XSETCDR (XCAR (args), Fcons (sequence, result));

  UNGCPRO;
}


/* This function can GC because get_keyelt can.  */

static Lisp_Object
where_is_internal_1 (binding, key, definition, noindirect, this, last,
		     nomenus, last_is_meta)
     Lisp_Object binding, key, definition, noindirect, this, last;
     int nomenus, last_is_meta;
{
  Lisp_Object sequence;

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

  if (!(!NILP (where_is_cache)	/* everything "matches" during cache-fill.  */
	|| EQ (binding, definition)
	|| (CONSP (definition) && !NILP (Fequal (binding, definition)))))
    /* Doesn't match.  */
    return Qnil;

  /* We have found a match.  Construct the key sequence where we found it.  */
  if (INTEGERP (key) && last_is_meta)
    {
      sequence = Fcopy_sequence (this);

  if (!NILP (where_is_cache))
    {
      Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
      Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
      return Qnil;
    }
  else
    return sequence;
}

/* describe-bindings - summarizing all the bindings in a set of keymaps.  */

DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,

81792:4ee4f467ca51

    RETURN_UNGCPRO (Qnil);

  if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
    Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);

  meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key))
	      ? meta_modifier : 0x80);

  if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
    { /* DEF is apparently an XEmacs-style keyboard macro.  */
      Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);

  return Flist (nmaps, maps);
}

/* Help functions for describing and documenting keymaps.		*/

struct accessible_keymaps_data {
  Lisp_Object maps, tail, thisseq;
  /* Does the current sequence end in the meta-prefix-char?  */
  int is_metized;
};

static void
accessible_keymaps_1 (key, cmd, args, data)
     Lisp_Object key, cmd, args;
     /* Use void* to be compatible with map_keymap_function_t.  */
     void *data;
{
  struct accessible_keymaps_data *d = data; /* Cast! */
  Lisp_Object maps = d->maps;
  Lisp_Object tail = d->tail;
  Lisp_Object thisseq = d->thisseq;
  int is_metized = d->is_metized && INTEGERP (key);
  Lisp_Object tem;

  cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
  if (NILP (cmd))
    return;

      tem = append_key (thisseq, key);
      nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
    }
}

/* This function cannot GC.  */

DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
       1, 2, 0,
       doc: /* Find all keymaps accessible via prefix characters from KEYMAP.

then the value includes only maps for prefixes that start with PREFIX.  */)
     (keymap, prefix)
     Lisp_Object keymap, prefix;
{
  Lisp_Object maps, tail;
  int prefixlen = XINT (Flength (prefix));

  /* no need for gcpro because we don't autoload any keymaps.  */

  if (!NILP (prefix))
    {
      /* If a prefix was specified, start with the keymap (if any) for
	 that prefix, so we don't waste time considering other prefixes.  */

      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.  */
      tem = get_keymap (tem, 0, 0);
      /* If the keymap is autoloaded `tem' is not a cons-cell, but we still
	 want to return it.  */
      if (!NILP (tem))
	{
	  /* Convert PREFIX to a vector now, so that later on
	     we don't have to deal with the possibility of a string.  */
	  if (STRINGP (prefix))
	    {

     This is a breadth-first traversal, where tail is the queue of
     nodes, and maps accumulates a list of all nodes visited.  */

  for (tail = maps; CONSP (tail); tail = XCDR (tail))
    {
      struct accessible_keymaps_data data;
      register Lisp_Object thismap = Fcdr (XCAR (tail));
      Lisp_Object last;

      data.thisseq = Fcar (XCAR (tail));
      data.maps = maps;
      data.tail = tail;
      last = make_number (XINT (Flength (data.thisseq)) - 1);
      /* Does the current sequence end in the meta-prefix-char?  */
      data.is_metized = (XINT (last) >= 0
		    /* Don't metize the last char of PREFIX.  */
		    && XINT (last) >= prefixlen
		    && EQ (Faref (data.thisseq, last), meta_prefix_char));

      /* Since we can't run lisp code, we can't scan autoloaded maps.  */
      if (CONSP (thismap))
	map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0);
    }
  return maps;
}
Lisp_Object Qsingle_key_description, Qkey_description;

/* This function cannot GC.  */

DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,

      if (! CHAR_VALID_P (without_bits, 1))
	{
	  char buf[256];

	  sprintf (buf, "Invalid char code %ld", XINT (key));
	  return build_string (buf);
	}
      else if (charset
	       && ((c1 == 0 && c2 == -1) || c2 == 0))
	{


/* where-is - finding a command in a set of keymaps.			*/

static Lisp_Object where_is_internal ();
static void where_is_internal_1 P_ ((Lisp_Object key, Lisp_Object binding,
				     Lisp_Object args, void *data));

/* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
   Returns the first non-nil binding found in any of those maps.  */

static Lisp_Object

    }
  return Qnil;
}

static Lisp_Object Vmouse_events;

struct where_is_internal_data {
  Lisp_Object definition, noindirect, this, last;
  int last_is_meta;
  Lisp_Object sequences;
};

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

static Lisp_Object
where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)

  for (; !NILP (maps); maps = Fcdr (maps))
    {
      /* Key sequence to reach map, and the map that it reaches */
      register Lisp_Object this, map, tem;
      struct where_is_internal_data data;

      /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
	 [M-CHAR] sequences, check if last character of the sequence
	 is the meta-prefix char.  */
      Lisp_Object last;

	   non-ascii prefixes like `C-down-mouse-2'.  */
	continue;

      QUIT;

      data.definition = definition;
      data.noindirect = noindirect;
      data.this = this;
      data.last = last;
      data.last_is_meta = last_is_meta;
      data.sequences = Qnil;

      if (CONSP (map))
	map_keymap (map, where_is_internal_1, Qnil, &data, 0);

      sequences = data.sequences;

      while (CONSP (sequences))
	{
	  Lisp_Object sequence, remapped, function;
	  
	  sequence = XCAR (sequences);
	  sequences = XCDR (sequences);

	  /* If the current sequence is a command remapping with
	     format [remap COMMAND], find the key sequences
	     which run COMMAND, and use those sequences instead.  */
	  remapped = Qnil;
	  if (NILP (no_remap)
	      && VECTORP (sequence) && XVECTOR (sequence)->size == 2
	      && EQ (AREF (sequence, 0), Qremap)
	      && (function = AREF (sequence, 1), SYMBOLP (function)))
	    {
	      Lisp_Object remapped1;
	      
	      remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
	      if (CONSP (remapped1))
		{
		  /* Verify that this key binding actually maps to the
		     remapped command (see below).  */
		  if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
		    continue;
		  sequence = XCAR (remapped1);
		  remapped = XCDR (remapped1);
		  goto record_sequence;
		}
	    }

	  /* Verify that this key binding is not shadowed by another
	     binding for the same key, before we say it exists.

	     Mechanism: look for local definition of this key and if
	     it is defined and does not match what we found then
	     ignore this key.

	     Either nil or number as value from Flookup_key
	     means undefined.  */
	  if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
	    continue;

	record_sequence:
	  /* Don't annoy user with strings from a menu such as
	     Select Paste.  Change them all to "(any string)",
	     so that there seems to be only one menu item
	     to report. */
	  if (! NILP (sequence))
	    {
	      Lisp_Object tem;
	      tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
	      if (STRINGP (tem))
		Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
		       build_string ("(any string)"));
	    }

	  /* It is a true unshadowed match.  Record it, unless it's already
	     been seen (as could happen when inheriting keymaps).  */
	  if (NILP (Fmember (sequence, found)))
	    found = Fcons (sequence, found);

	  /* If firstonly is Qnon_ascii, then we can return the first
	     binding we find.  If firstonly is not Qnon_ascii but not
	     nil, then we should return the first ascii-only binding
	     we find.  */
	  if (EQ (firstonly, Qnon_ascii))
	    RETURN_UNGCPRO (sequence);
	  else if (!NILP (firstonly) && ascii_sequence_p (sequence))
	    RETURN_UNGCPRO (sequence);

	  if (CONSP (remapped))
	    {
	      sequence = XCAR (remapped);
	      remapped = XCDR (remapped);
	      goto record_sequence;
	    }
	}
    }

  UNGCPRO;

    }

  return result;
}

/* This function can GC because get_keyelt can.  */

static void
where_is_internal_1 (key, binding, args, data)
     Lisp_Object key, binding, args;
     void *data;
{
  struct where_is_internal_data *d = data; /* Cast! */
  Lisp_Object definition = d->definition;
  Lisp_Object noindirect = d->noindirect;
  Lisp_Object this = d->this;
  Lisp_Object last = d->last;
  int last_is_meta = d->last_is_meta;
  Lisp_Object sequence;

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

  if (!(!NILP (where_is_cache)	/* everything "matches" during cache-fill.  */
	|| EQ (binding, definition)
	|| (CONSP (definition) && !NILP (Fequal (binding, definition)))))
    /* Doesn't match.  */
    return;

  /* We have found a match.  Construct the key sequence where we found it.  */
  if (INTEGERP (key) && last_is_meta)
    {
      sequence = Fcopy_sequence (this);

  if (!NILP (where_is_cache))
    {
      Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
      Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
    }
  else
    d->sequences = Fcons (sequence, d->sequences);
}

/* describe-bindings - summarizing all the bindings in a set of keymaps.  */

DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,