keymap.c

早期freebsd实现

/* Manipulation of keymaps
   Copyright (C) 1985, 1986, 1987, 1988, 1990 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 1, 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; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */


#include "config.h"
#include <stdio.h>
#undef NULL
#include "lisp.h"
#include "commands.h"
#include "buffer.h"

#define min(a, b) ((a) < (b) ? (a) : (b))

/* Actually allocate storage for these variables */

#ifdef HAVE_X_WINDOWS
Lisp_Object MouseMap;		/* Keymap for mouse commands */
#endif /* HAVE_X_WINDOWS */

Lisp_Object global_map;

Lisp_Object Vglobal_map;

Lisp_Object Vesc_map;

Lisp_Object Vctl_x_map;

/* Keymap used for minibuffers with self-inserting space.  */
Lisp_Object Vminibuffer_local_map;

/* Keymap used for minibuffers when space does not self insert.  */
Lisp_Object Vminibuffer_local_ns_map;			

/* Keymap used for minibuffers when doing completion */
Lisp_Object Vminibuffer_local_completion_map;

/* Keymap used for minibuffers when doing completion and require a match */
Lisp_Object Vminibuffer_local_must_match_map;

Lisp_Object Qkeymapp, Qkeymap;

/* A char over 0200 in a key sequence
   is equivalent to prefixing with this character.  */

extern int meta_prefix_char;

DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 0, 0,
  "Construct and return a new keymap, a vector of length 128.\n\
All entries in it are nil, meaning \"command undefined\".")
  ()
{
  register Lisp_Object val;
  XFASTINT (val) = 0200;
  return Fmake_vector (val, Qnil);
}

DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 0, 0,
  "Construct and return a new sparse-keymap list.\n\
Its car is 'keymap and its cdr is an alist of (CHAR . DEFINITION).\n\
Initially the alist is nil.")
  ()
{
  return Fcons (Qkeymap, Qnil);
}

/* Install a standard key binding at initialization time.
   For example,
     ndefkey (Vctl_x_map, Ctl ('X'), "exchange-point-and-mark");  */

void
ndefkey (keymap, key, defname)
     Lisp_Object keymap;
     int key;
     char *defname;
{
  store_in_keymap (keymap, key, intern (defname));
}

/* Define character fromchar in map frommap as an alias for character tochar in map tomap.
 Subsequent redefinitions of the latter WILL affect the former. */

#ifdef NOTDEF
void
synkey (frommap, fromchar, tomap, tochar)
     struct Lisp_Vector *frommap, *tomap;
     int fromchar, tochar;
{
  Lisp_Object v, c;
  XSET (v, Lisp_Vector, tomap);
  XFASTINT (c) = tochar;
  frommap->contents[fromchar] = Fcons (v, c);
}
#endif /* NOTDEF */

DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
  "Return t if ARG is a keymap.\n\
A keymap is a vector of length 128, or a list (keymap . ALIST),\n\
where alist elements look like (CHAR . DEFN).")
  (object)
     Lisp_Object object;
{
  register Lisp_Object tem;
  tem = object;
  while (XTYPE (tem) == Lisp_Symbol)
    {
      tem = XSYMBOL (tem)->function;
      if (EQ (tem, Qunbound))
	return Qnil;
      QUIT;
    }

  if ((XTYPE (tem) == Lisp_Vector && XVECTOR (tem)->size == 0200)
      || (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap)))
    return Qt;
  return Qnil;
}

Lisp_Object
get_keymap_1 (object, error)
     Lisp_Object object;
     int error;
{
  register Lisp_Object tem;

  while (1)
    {
      tem = object;
      while (XTYPE (tem) == Lisp_Symbol && !EQ (tem, Qunbound))
	{
	  tem = XSYMBOL (tem)->function;
	  QUIT;
	}
      if ((XTYPE (tem) == Lisp_Vector && XVECTOR (tem)->size == 0200)
	  || (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap)))
	return tem;
      if (error)
	object = wrong_type_argument (Qkeymapp, object);
      else return Qnil;
    }
}

Lisp_Object
get_keymap (object)
     Lisp_Object object;
{
  return get_keymap_1 (object, 1);
}

Lisp_Object
get_keyelt (object)
     register Lisp_Object object;
{
  register Lisp_Object map, tem;

  while (map = get_keymap_1 (Fcar_safe (object), 0),
	 tem = Fkeymapp (map),
	 !NULL (tem))
      /*(XTYPE (object) == Lisp_Cons && !EQ (XCONS (object)->car, Qkeymap))*/
    {
      object = Fcdr (object);
      if (CONSP (map))
	object = Fcdr (Fassq (object, Fcdr (map)));
      else
	object = Faref (map, object);
    }
  return object;
}

Lisp_Object
access_keymap (map, idx)
     Lisp_Object map;
     register int idx;
{
  register Lisp_Object val;
  if (idx < 0 || idx >= 0200)
    error ("Command key out of range 0-127");

  /* Get definition for character `idx' proper.  */
  if (CONSP (map))
    val = Fcdr (Fassq (make_number (idx), Fcdr (map)));
  else
    val = XVECTOR (map)->contents[idx];

  return val;
}

Lisp_Object
store_in_keymap (keymap, idx, def)
     Lisp_Object keymap;
     register int idx;
     register Lisp_Object def;
{
  register Lisp_Object tem;

  if (idx < 0 || idx >= 0200)
    error ("Command key out of range 0-127");

  if (CONSP (keymap))
    {
      tem = Fassq (make_number (idx), Fcdr (keymap));
      if (!NULL (tem))
	Fsetcdr (tem, def);
      else
	Fsetcdr (keymap, Fcons (Fcons (make_number (idx), def),
				Fcdr (keymap)));
    }
  else
    XVECTOR (keymap)->contents[idx] = def;

  return def;
}

DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
  "Return a copy of the keymap KEYMAP.\n\
The copy starts out with the same definitions of KEYMAP,\n\
but changing either the copy or KEYMAP does not affect the other.\n\
Any key definitions that are subkeymaps are recursively copied.")
  (keymap)
     Lisp_Object keymap;
{
  register Lisp_Object copy, tem;

  keymap = get_keymap (keymap);
  if (XTYPE (keymap) == Lisp_Vector)
    {
      register int i;
      copy = Fcopy_sequence (keymap);
      for (i = 0; i < XVECTOR (copy)->size; i++)
	if (tem = Fkeymapp (XVECTOR (copy)->contents[i]), !NULL (tem))
	  XVECTOR (copy)->contents[i] = Fcopy_keymap (XVECTOR (copy)->contents[i]);
    }
  else
    {
      register Lisp_Object tail;
      copy = Fcopy_alist (keymap); 
      for (tail = copy; CONSP (tail); tail = XCONS (tail)->cdr)
	{
	  register Lisp_Object elt;
	  elt = XCONS (tail)->car;
	  if (CONSP (elt) && (tem = Fkeymapp (XCONS (elt)->cdr), !NULL (tem)))
	    XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr);
	}
    }
  return copy;
}

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 meaning a sequence of keystrokes.\n\
DEF is anything that can be a key's definition:\n\
 nil (means key is undefined in this keymap),\n\
 a command (a Lisp function suitable for interactive calling)\n\
 a string (treated as a keyboard macro),\n\
 a keymap (to define a prefix key),\n\
 a list (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP,\n\
 or a symbol.  The symbol's function definition is used as the key's\n\
definition, and may be any of the above (including another symbol).")
  (keymap, key, def)
     register Lisp_Object keymap;
     Lisp_Object key;
     Lisp_Object def;
{
  register int idx;
  register int c;
  register Lisp_Object tem;
  register Lisp_Object cmd;
  int metized = 0;

  keymap = get_keymap (keymap);

  CHECK_STRING (key, 1);
  if (XSTRING (key)->size == 0)
    return Qnil;

  idx = 0;
  while (1)
    {
      c = XSTRING (key)->data[idx];
      if (c >= 0200 && !metized)
	{
	  c = meta_prefix_char;
	  metized = 1;
	}
      else
	{
	  c &= 0177;
	  metized = 0;
	  idx++;
	}

      if (idx == XSTRING (key)->size)
	return store_in_keymap (keymap, c, def);

      cmd = get_keyelt (access_keymap (keymap, c));
      if (NULL (cmd))
	{
	  cmd = Fmake_sparse_keymap ();
	  store_in_keymap (keymap, c, cmd);
	}
      tem = Fkeymapp (cmd);
      if (NULL (tem))
	error ("Key sequence %s uses invalid prefix characters",
	       XSTRING (key)->data);

      keymap = get_keymap (cmd);
    }
}

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

DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 2, 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\
Number as value means KEY is \"too long\";\n\
that is, characters in it except for the last one\n\
fail to be a valid sequence of prefix characters in KEYMAP.\n\
The number is how many characters at the front of KEY\n\
it takes to reach a non-prefix command.")
  (keymap, key)
     register Lisp_Object keymap;
     Lisp_Object key;
{
  register int idx;
  register Lisp_Object tem;
  register Lisp_Object cmd;
  register int c;
  int metized = 0;

  keymap = get_keymap (keymap);

  CHECK_STRING (key, 1);
  if (XSTRING (key)->size == 0)
    return Qnil;

  idx = 0;
  while (1)
    {
      c = XSTRING (key)->data[idx];
      if (c >= 0200 && !metized)
	{
	  c = meta_prefix_char;
	  metized = 1;
	}
      else
	{
	  c &= 0177;
	  metized = 0;
	  idx++;
	}

      cmd = get_keyelt (access_keymap (keymap, c));
      if (idx == XSTRING (key)->size)
	return cmd;

      tem = Fkeymapp (cmd);
      if (NULL (tem))
	return make_number (idx);

      keymap = get_keymap (cmd);
      QUIT;
    }
}

DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 1, 0,
  "Return the definition for command KEYS in current keymaps.\n\
KEYS is a string, a sequence of keystrokes.\n\
The definition is probably a symbol with a function definition.")
  (keys)
     Lisp_Object keys;
{
  register Lisp_Object map, value, value1;
  map = current_buffer->keymap;
  if (!NULL (map))
    {
      value = Flookup_key (map, keys);
      if (NULL (value))
	{
	  XSET (map, Lisp_Vector, global_map);
	  value1 = Flookup_key (map, keys);
	  if (XTYPE (value1) == Lisp_Int)
	    return Qnil;
	  return value1;
	}
      else if (XTYPE (value) != Lisp_Int)
	return value;
    }
  XSET (map, Lisp_Vector, global_map);
  return Flookup_key (map, keys);
}

DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 1, 0,
  "Return the definition for command KEYS in current local keymap only.\n\
KEYS is a string, a sequence of keystrokes.\n\
The definition is probably a symbol with a function definition.")
  (keys)
     Lisp_Object keys;
{
  register Lisp_Object map;
  map = current_buffer->keymap;
  if (NULL (map))
    return Qnil;
  return Flookup_key (map, keys);
}

DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 1, 0,
  "Return the definition for command KEYS in current global keymap only.\n\
KEYS is a string, a sequence of keystrokes.\n\
The definition is probably a symbol with a function definition.")
  (keys)
     Lisp_Object keys;
{
  register Lisp_Object map;
  XSET (map, Lisp_Vector, global_map);
  return Flookup_key (map, keys);
}

DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2,
  "kSet key globally: \nCSet key %s to command: ",
  "Give KEY a definition of COMMAND.\n\
COMMAND is a symbol naming an interactively-callable function.\n\
KEY is a string representing a sequence of keystrokes.\n\
Note that if KEY has a local definition in the current buffer\n\
that local definition will continue to shadow any global definition.")