keymap.c

早期freebsd实现

  (keys, function)
     Lisp_Object keys, function;
{
  register Lisp_Object map;
  XSET (map, Lisp_Vector, global_map);
  CHECK_STRING (keys, 1);
  Fdefine_key (map, keys, function);
  return Qnil;
}

DEFUN ("local-set-key", Flocal_set_key, Slocal_set_key, 2, 2,
  "kSet key locally: \nCSet key %s locally to command: ",
  "Give KEY a local definition of COMMAND.\n\
COMMAND is a symbol naming an interactively-callable function.\n\
KEY is a string representing a sequence of keystrokes.\n\
The definition goes in the current buffer's local map,\n\
which is shared with other buffers in the same major mode.")
  (keys, function)
     Lisp_Object keys, function;
{
  register Lisp_Object map;
  map = current_buffer->keymap;
  if (NULL (map))
    {
      map = Fmake_sparse_keymap ();
      current_buffer->keymap = map;
    }

  CHECK_STRING (keys, 1);
  Fdefine_key (map, keys, function);
  return Qnil;
}

DEFUN ("global-unset-key", Fglobal_unset_key, Sglobal_unset_key,
  1, 1, "kUnset key globally: ",
  "Remove global definition of KEY.\n\
KEY is a string representing a sequence of keystrokes.")
  (keys)
     Lisp_Object keys;
{
  return Fglobal_set_key (keys, Qnil);
}

DEFUN ("local-unset-key", Flocal_unset_key, Slocal_unset_key, 1, 1,
  "kUnset key locally: ",
  "Remove local definition of KEY.\n\
KEY is a string representing a sequence of keystrokes.")
  (keys)
     Lisp_Object keys;
{
  if (!NULL (current_buffer->keymap))
    Flocal_set_key (keys, Qnil);
  return Qnil;
}

DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 1, 0,
  "Define SYMBOL as a prefix command.\n\
A keymap is created and stored as SYMBOL's function definition.")
  (name)
     Lisp_Object name;
{
  Ffset (name, Fmake_keymap ());
  return name;
}

DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
  "Selects KEYMAP as the global keymap.")
  (keymap)
     Lisp_Object keymap;
{
  keymap = get_keymap (keymap);
  CHECK_VECTOR (keymap, 0);
  global_map = keymap;
  return Qnil;
}

DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
  "Selects KEYMAP as the local keymap.\n\
nil for KEYMAP means no local keymap.")
  (keymap)
     Lisp_Object keymap;
{
  if (!NULL (keymap))
    keymap = get_keymap (keymap);

  current_buffer->keymap = keymap;

  return Qnil;
}

DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
  "Return current buffer's local keymap, or nil if it has none.")
  ()
{
  return current_buffer->keymap;
}

DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
  "Return the current global keymap.")
  ()
{
  return global_map;
}

DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
  1, 1, 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\
so that the KEYS increase in length.  The first element is (\"\" . KEYMAP).")
  (startmap)
     Lisp_Object startmap;
{
  Lisp_Object maps, tail;
  register Lisp_Object thismap, thisseq;
  register Lisp_Object dummy;
  register Lisp_Object tem;
  register Lisp_Object cmd;
  register int i;

  maps = Fcons (Fcons (build_string (""), get_keymap (startmap)), Qnil);
  tail = maps;

  /* For each map in the list maps,
     look at any other maps it points to
     and stick them at the end if they are not already in the list */

  while (!NULL (tail))
    {
      thisseq = Fcar (Fcar (tail));
      thismap = Fcdr (Fcar (tail));
      for (i = 0; i < 0200; i++)
	{
	  cmd = get_keyelt (access_keymap (thismap, i));
	  if (NULL (cmd)) continue;
	  tem = Fkeymapp (cmd);
	  if (!NULL (tem))
	    {
	      cmd = get_keymap (cmd);
	      tem = Frassq (cmd, maps);
	      if (NULL (tem))
		{
		  XFASTINT (dummy) = i;
		  dummy = concat2 (thisseq, Fchar_to_string (dummy));
		  nconc2 (tail, Fcons (Fcons (dummy, cmd), Qnil));
		}
	    }
	}
      tail = Fcdr (tail);
    }

  return 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)
     Lisp_Object keys;
{
  return Fmapconcat (Qsingle_key_description, keys, build_string (" "));
}

char *
push_key_description (c, p)
     register unsigned int c;
     register char *p;
{
  if (c >= 0200)
    {
      *p++ = 'M';
      *p++ = '-';
      c -= 0200;
    }
  if (c < 040)
    {
      if (c == 033)
	{
	  *p++ = 'E';
	  *p++ = 'S';
	  *p++ = 'C';
	}
      else if (c == Ctl('I'))
	{
	  *p++ = 'T';
	  *p++ = 'A';
	  *p++ = 'B';
	}
      else if (c == Ctl('J'))
	{
	  *p++ = 'L';
	  *p++ = 'F';
	  *p++ = 'D';
	}
      else if (c == Ctl('M'))
	{
	  *p++ = 'R';
	  *p++ = 'E';
	  *p++ = 'T';
	}
      else
	{
	  *p++ = 'C';
	  *p++ = '-';
	  if (c > 0 && c <= Ctl ('Z'))
	    *p++ = c + 0140;
	  else
	    *p++ = c + 0100;
	}
    }
  else if (c == 0177)
    {
      *p++ = 'D';
      *p++ = 'E';
      *p++ = 'L';
    }
  else if (c == ' ')
    {
      *p++ = 'S';
      *p++ = 'P';
      *p++ = 'C';
    }
  else
    *p++ = c;
  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;
{
  register unsigned char c;
  char tem[6];

  CHECK_NUMBER (key, 0);
  c = XINT (key) & 0377;

  *push_key_description (c, tem) = 0;

  return build_string (tem);
}

char *
push_text_char_description (c, p)
     register unsigned int c;
     register char *p;
{
  if (c >= 0200)
    {
      *p++ = 'M';
      *p++ = '-';
      c -= 0200;
    }
  if (c < 040)
    {
      *p++ = '^';
      *p++ = c + 64;		/* 'A' - 1 */
    }
  else if (c == 0177)
    {
      *p++ = '^';
      *p++ = '?';
    }
  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;
{
  char tem[6];

  CHECK_NUMBER (chr, 0);

  *push_text_char_description (XINT (chr) & 0377, tem) = 0;

  return build_string (tem);
}

DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 3, 0,
  "Return list of key sequences that currently invoke command DEFINITION\n\
in KEYMAP or (current-global-map).  If KEYMAP is nil, only search for\n\
keys in the global map.\n\
\n\
If FIRSTONLY is non-nil, returns a string representing the first key\n\
sequence found, rather than a list of all possible key sequences.")
  (definition, local_keymap, firstonly)
     Lisp_Object definition, local_keymap, firstonly;
{
  Lisp_Object start1;
  register Lisp_Object maps;
  Lisp_Object found;

  XSET (start1, Lisp_Vector, global_map);

  if (!NULL (local_keymap))
    maps = nconc2 (Faccessible_keymaps (get_keymap (local_keymap)),
		   Faccessible_keymaps (start1));
  else
    maps = Faccessible_keymaps (start1);

  found = Qnil;

  for (; !NULL (maps); maps = Fcdr (maps))
    {
      register this = Fcar (Fcar (maps)); /* Key sequence to reach map */
      register map = Fcdr (Fcar (maps)); /* The map that it reaches */
      register int i = 0;
	 
      if (CONSP (map))
	map = Fcdr (map);

      /* If the MAP is a vector, I increments and eventually reaches 0200.
	 Otherwise I remains 0; MAP is cdr'd and eventually becomes nil.  */

      while (!NULL (map) && i < 0200)
	{
	  register Lisp_Object elt, dummy;

	  QUIT;
	  if (CONSP (map))
	    {
	      elt = Fcdr (Fcar (map));
	      dummy = Fcar (Fcar (map));
	      map = Fcdr (map);
	    }
	  else
	    {
	      elt = XVECTOR (map)->contents[i];
	      XFASTINT (dummy) = i;
	      i++;
	    }

	  if (XTYPE (definition) != Lisp_Cons)
	    elt = get_keyelt (elt);

	  /* End this iteration if this element does not match
	     the target.  */

	  if (XTYPE (definition) == Lisp_Cons)
	    {
	      Lisp_Object tem;
	      tem = Fequal (elt, definition);
	      if (NULL (tem))
		continue;
	    }
	  else
	    if (!EQ (elt, definition))
	      continue;

	  /* We have found a match.
	     Construct the key sequence where we found it.  */

	  dummy = concat2 (this, Fchar_to_string (dummy));

	  /* Verify that this key binding is not shadowed
	     by another binding for the same key,
	     before we say it exists.
	     The 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 (!NULL (local_keymap))
	    elt = Flookup_key (local_keymap, dummy);
	  if (!NULL (elt) && XTYPE (elt) != Lisp_Int)
	    {
	      if (XTYPE (definition) == Lisp_Cons)
		{
		  Lisp_Object tem;
		  tem = Fequal (elt, definition);
		  if (NULL (tem))
		    continue;
		}
	      else
		if (!EQ (elt, definition))
		  continue;
	    }

	  /* It is a true unshadowed match  Record it.  */

	  if (!NULL (firstonly))
	    return dummy;
	  found = Fcons (dummy, found);
	}
    }
  return Fnreverse (found);
}

DEFUN ("where-is", Fwhere_is, Swhere_is, 1, 1, "CWhere is command: ",
  "Print message listing key sequences that invoke specified command.\n\
Argument is a command definition, usually a symbol with a function definition.")
  (definition)
     Lisp_Object definition;
{
  register Lisp_Object tem;
  CHECK_SYMBOL (definition, 0);
  tem = Fmapconcat (Qkey_description,
		    Fwhere_is_internal (definition, current_buffer->keymap, Qnil),
		    build_string (", "));
  if (XSTRING (tem)->size)
    message ("%s is on %s", XSYMBOL (definition)->name->data, XSTRING (tem)->data);
  else
    message ("%s is not on any keys", XSYMBOL (definition)->name->data);
  return Qnil;
}

Lisp_Object describe_buffer_bindings ();

DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 0, "",
  "Show a list of all defined keys, and their definitions.\n\
The list is put in a buffer, which is displayed.")
  ()
{
  register Lisp_Object thisbuf;
  XSET (thisbuf, Lisp_Buffer, current_buffer);
  internal_with_output_to_temp_buffer ("*Help*", describe_buffer_bindings, thisbuf);
  return Qnil;
}

Lisp_Object
describe_buffer_bindings (descbuf)
     Lisp_Object descbuf;
{
  register Lisp_Object start1;
  char *heading = "key		binding\n---		-------\n";

  Fset_buffer (Vstandard_output);