comparison src/keymap.c @ 7998:d4b5f4dd9c51

(Flookup_key): Add gcpro. (Fkey_binding, Fminor_mode_key_binding): Likewise. (Fwhere_is_internal): Likewise.

7997:dda8e966edf5

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

   If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
   is an autoload form, do the autoload and try again.

   ERROR controls how we respond if OBJECT isn't a keymap.
   If ERROR is non-zero, signal an error; otherwise, just return Qnil.

   Note that most of the time, we don't want to pursue autoloads.

  return copy;
}

/* Simple Keymap mutators and accessors.				*/

DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
  "Args KEYMAP, KEY, DEF.  Define key sequence KEY, in KEYMAP, as DEF.\n\
KEYMAP is a keymap.  KEY is a string or a vector of symbols and characters\n\
meaning a sequence of keystrokes and events.\n\

	       XSTRING (Fkey_description (key))->data);
    }
}

/* Value is number if KEY is too long; NIL if valid but has no definition. */

DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
  "In keymap KEYMAP, look up key sequence KEY.  Return the definition.\n\
nil means undefined.  See doc of `define-key' for kinds of definitions.\n\
\n\

  register Lisp_Object c;
  int metized = 0;
  int length;
  int t_ok = ! NILP (accept_default);
  int meta_bit;

  keymap = get_keymap_1 (keymap, 1, 1);

  if (XTYPE (key) != Lisp_Vector
      && XTYPE (key) != Lisp_String)

  if (XTYPE (key) == Lisp_Vector)
    meta_bit = meta_modifier;
  else
    meta_bit = 0x80;

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

	  idx++;
	}

      cmd = get_keyelt (access_keymap (keymap, c, t_ok, 0), 1);
      if (idx == length)
	return cmd;

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

      QUIT;
    }
}

  if (modeptr) *modeptr = cmm_modes;
  if (mapptr)  *mapptr  = cmm_maps;
  return i;
}

DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
  "Return the binding for command KEY in current keymaps.\n\
KEY is a string or vector, a sequence of keystrokes.\n\
The binding is probably a symbol with a function definition.\n\
\n\

  (key, accept_default)
     Lisp_Object key, accept_default;
{
  Lisp_Object *maps, value;
  int nmaps, i;

  if (!NILP (Voverriding_local_map))
    {
      value = Flookup_key (Voverriding_local_map, key, accept_default);
      if (! NILP (value) && XTYPE (value) != Lisp_Int)
	return value;
    }
  else
    { 
      nmaps = current_minor_maps (0, &maps);
      for (i = 0; i < nmaps; i++)
	if (! NILP (maps[i]))
	  {
	    value = Flookup_key (maps[i], key, accept_default);
	    if (! NILP (value) && XTYPE (value) != Lisp_Int)
	      return value;
	  }

      if (! NILP (current_buffer->keymap))
	{
	  value = Flookup_key (current_buffer->keymap, key, accept_default);
	  if (! NILP (value) && XTYPE (value) != Lisp_Int)
	    return value;
	}
    }

  value = Flookup_key (current_global_map, key, accept_default);
  if (! NILP (value) && XTYPE (value) != Lisp_Int)
    return value;
  
  return Qnil;
}

DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
  "Return the binding for command KEYS in current local keymap only.\n\
KEYS is a string, a sequence of keystrokes.\n\
The binding is probably a symbol with a function definition.\n\

  if (NILP (map))
    return Qnil;
  return Flookup_key (map, keys, accept_default);
}

DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
  "Return the binding for command KEYS in current global keymap only.\n\
KEYS is a string, a sequence of keystrokes.\n\
The binding is probably a symbol with a function definition.\n\
This function's return values are the same as those of lookup-key\n\
(which see).\n\
\n\
If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
bindings; see the description of `lookup-key' for more details about this.")
  (keys, accept_default)
     Lisp_Object keys, accept_default;
{
  return Flookup_key (current_global_map, keys, accept_default);
}

DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
  "Find the visible minor mode bindings of KEY.\n\
Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
the symbol which names the minor mode binding KEY, and BINDING is\n\

{
  Lisp_Object *modes, *maps;
  int nmaps;
  Lisp_Object binding;
  int i, j;

  nmaps = current_minor_maps (&modes, &maps);

  for (i = j = 0; i < nmaps; i++)
    if (! NILP (maps[i])
	&& ! NILP (binding = Flookup_key (maps[i], key, accept_default))
	&& XTYPE (binding) != Lisp_Int)
      {
	if (! NILP (get_keymap (binding)))
	  maps[j++] = Fcons (modes[i], binding);
	else if (j == 0)
	  return Fcons (Fcons (modes[i], binding), Qnil);
      }

  return Flist (j, maps);
}

DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2,
  "kSet key globally: \nCSet key %s to command: ",

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

DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
  1, 2, 0,
  "Find all keymaps accessible via prefix characters from KEYMAP.\n\
Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
KEYS starting from KEYMAP gets you to MAP.  These elements are ordered\n\

  (startmap, prefix)
     Lisp_Object startmap, prefix;
{
  Lisp_Object maps, good_maps, tail;
  int prefixlen = 0;

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

  maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),

  return Fnreverse (good_maps);
}

Lisp_Object Qsingle_key_description, Qkey_description;

DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
  "Return a pretty description of key-sequence KEYS.\n\
Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
spaces are put between sequence elements, etc.")
  (keys)

    }

  return p;  
}

DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0,
  "Return a pretty description of command character KEY.\n\
Control characters turn into C-whatever, etc.")
  (key)
     Lisp_Object key;

  else
    *p++ = c;
  return p;  
}

DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
  "Return a pretty description of file-character CHAR.\n\
Control characters turn into \"^char\", etc.")
  (chr)
     Lisp_Object chr;

  return 1;
}


/* where-is - finding a command in a set of 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\

indirect definition itself.")
  (definition, keymap, firstonly, noindirect)
     Lisp_Object definition, keymap;
     Lisp_Object firstonly, noindirect;
{
  register Lisp_Object maps;
  Lisp_Object found;
  int keymap_specified = !NILP (keymap);

  if (! keymap_specified)
    {
#ifdef USE_TEXT_PROPERTIES
      keymap = get_local_map (PT, current_buffer);

			 maps);
	  minors = XCONS (minors)->cdr;
	}
    }

  found = Qnil;

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

	     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, sequence;
	  elt = XCONS (map)->car;

	  QUIT;

	  /* Set key and binding to the current key and binding, and

	  /* 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 sequence;
	  else if (! NILP (firstonly) && ascii_sequence_p (sequence))
	    return sequence;
	}
    }

  found = Fnreverse (found);

  /* firstonly may have been t, but we may have gone all the way through
     the keymaps without finding an all-ASCII key sequence.  So just

7998:d4b5f4dd9c51

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

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

   ERROR controls how we respond if OBJECT isn't a keymap.
   If ERROR is non-zero, signal an error; otherwise, just return Qnil.

   Note that most of the time, we don't want to pursue autoloads.

  return copy;
}

/* Simple Keymap mutators and accessors.				*/

/* GC is possible in this function if it autoloads a keymap.  */

DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
  "Args KEYMAP, KEY, DEF.  Define key sequence KEY, in KEYMAP, as DEF.\n\
KEYMAP is a keymap.  KEY is a string or a vector of symbols and characters\n\
meaning a sequence of keystrokes and events.\n\

	       XSTRING (Fkey_description (key))->data);
    }
}

/* Value is number if KEY is too long; NIL if valid but has no definition. */
/* GC is possible in this function if it autoloads a keymap.  */

DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
  "In keymap KEYMAP, look up key sequence KEY.  Return the definition.\n\
nil means undefined.  See doc of `define-key' for kinds of definitions.\n\
\n\

  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 (XTYPE (key) != Lisp_Vector
      && XTYPE (key) != Lisp_String)

  if (XTYPE (key) == Lisp_Vector)
    meta_bit = meta_modifier;
  else
    meta_bit = 0x80;

  GCPRO1 (key);

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

	  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))
	RETURN_UNGCPRO (make_number (idx));

      QUIT;
    }
}

  if (modeptr) *modeptr = cmm_modes;
  if (mapptr)  *mapptr  = cmm_maps;
  return i;
}

/* GC is possible in this function if it autoloads a keymap.  */

DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
  "Return the binding for command KEY in current keymaps.\n\
KEY is a string or vector, a sequence of keystrokes.\n\
The binding is probably a symbol with a function definition.\n\
\n\

  (key, accept_default)
     Lisp_Object key, accept_default;
{
  Lisp_Object *maps, value;
  int nmaps, i;
  struct gcpro gcpro1;

  GCPRO1 (key);

  if (!NILP (Voverriding_local_map))
    {
      value = Flookup_key (Voverriding_local_map, key, accept_default);
      if (! NILP (value) && XTYPE (value) != Lisp_Int)
	RETURN_UNGCPRO (value);
    }
  else
    { 
      nmaps = current_minor_maps (0, &maps);
      /* Note that all these maps are GCPRO'd
	 in the places where we found them.  */

      for (i = 0; i < nmaps; i++)
	if (! NILP (maps[i]))
	  {
	    value = Flookup_key (maps[i], key, accept_default);
	    if (! NILP (value) && XTYPE (value) != Lisp_Int)
	      RETURN_UNGCPRO (value);
	  }

      if (! NILP (current_buffer->keymap))
	{
	  value = Flookup_key (current_buffer->keymap, key, accept_default);
	  if (! NILP (value) && XTYPE (value) != Lisp_Int)
	    RETURN_UNGCPRO (value);
	}
    }

  value = Flookup_key (current_global_map, key, accept_default);
  UNGCPRO;
  if (! NILP (value) && XTYPE (value) != Lisp_Int)
    return value;
  
  return Qnil;
}

/* GC is possible in this function if it autoloads a keymap.  */

DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
  "Return the binding for command KEYS in current local keymap only.\n\
KEYS is a string, a sequence of keystrokes.\n\
The binding is probably a symbol with a function definition.\n\

  if (NILP (map))
    return Qnil;
  return Flookup_key (map, keys, accept_default);
}

/* GC is possible in this function if it autoloads a keymap.  */

DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
  "Return the binding for command KEYS in current global keymap only.\n\
KEYS is a string, a sequence of keystrokes.\n\
The binding is probably a symbol with a function definition.\n\
This function's return values are the same as those of lookup-key\n\
\(which see).\n\
\n\
If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
bindings; see the description of `lookup-key' for more details about this.")
  (keys, accept_default)
     Lisp_Object keys, accept_default;
{
  return Flookup_key (current_global_map, keys, accept_default);
}

/* GC is possible in this function if it autoloads a keymap.  */

DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
  "Find the visible minor mode bindings of KEY.\n\
Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
the symbol which names the minor mode binding KEY, and BINDING is\n\

{
  Lisp_Object *modes, *maps;
  int nmaps;
  Lisp_Object binding;
  int i, j;
  struct gcpro gcpro1, gcpro2;

  nmaps = current_minor_maps (&modes, &maps);
  /* Note that all these maps are GCPRO'd
     in the places where we found them.  */

  binding = Qnil;
  GCPRO2 (key, binding);

  for (i = j = 0; i < nmaps; i++)
    if (! NILP (maps[i])
	&& ! NILP (binding = Flookup_key (maps[i], key, accept_default))
	&& XTYPE (binding) != Lisp_Int)
      {
	if (! NILP (get_keymap (binding)))
	  maps[j++] = Fcons (modes[i], binding);
	else if (j == 0)
	  RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
      }

  UNGCPRO;
  return Flist (j, maps);
}

DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2,
  "kSet key globally: \nCSet key %s to command: ",

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

/* This function cannot GC.  */

DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
  1, 2, 0,
  "Find all keymaps accessible via prefix characters from KEYMAP.\n\
Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
KEYS starting from KEYMAP gets you to MAP.  These elements are ordered\n\

  (startmap, prefix)
     Lisp_Object startmap, prefix;
{
  Lisp_Object maps, good_maps, tail;
  int prefixlen = 0;

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

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

  maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),

  return Fnreverse (good_maps);
}

Lisp_Object Qsingle_key_description, Qkey_description;

/* This function cannot GC.  */

DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
  "Return a pretty description of key-sequence KEYS.\n\
Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
spaces are put between sequence elements, etc.")
  (keys)

    }

  return p;  
}

/* This function cannot GC.  */

DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0,
  "Return a pretty description of command character KEY.\n\
Control characters turn into C-whatever, etc.")
  (key)
     Lisp_Object key;

  else
    *p++ = c;
  return p;  
}

/* This function cannot GC.  */

DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
  "Return a pretty description of file-character CHAR.\n\
Control characters turn into \"^char\", etc.")
  (chr)
     Lisp_Object chr;

  return 1;
}

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

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

indirect definition itself.")
  (definition, keymap, firstonly, noindirect)
     Lisp_Object definition, keymap;
     Lisp_Object firstonly, noindirect;
{
  Lisp_Object maps;
  Lisp_Object found, sequence;
  int keymap_specified = !NILP (keymap);
  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;

  if (! keymap_specified)
    {
#ifdef USE_TEXT_PROPERTIES
      keymap = get_local_map (PT, current_buffer);

			 maps);
	  minors = XCONS (minors)->cdr;
	}
    }

  GCPRO5 (definition, keymap, maps, found, sequence);
  found = Qnil;
  sequence = Qnil;

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

	     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 = XCONS (map)->car;

	  QUIT;

	  /* Set key and binding to the current key and binding, and

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

  UNGCPRO;

  found = Fnreverse (found);

  /* firstonly may have been t, but we may have gone all the way through
     the keymaps without finding an all-ASCII key sequence.  So just