keymap.c

早期freebsd实现

  start1 = XBUFFER (descbuf)->keymap;
  if (!NULL (start1))
    {
      InsStr ("Local Bindings:\n");
      InsStr (heading);
      heading = 0;
      describe_map_tree (start1, 0, Qnil);
      InsStr ("\n");
    }

  InsStr ("Global Bindings:\n");
  if (heading)
    InsStr (heading);

  XSET (start1, Lisp_Vector, global_map);
  describe_map_tree (start1, 0, XBUFFER (descbuf)->keymap);

  Fset_buffer (descbuf);
  return Qnil;
}

/* Insert a desription of the key bindings in STARTMAP,
   followed by those of all maps reachable through STARTMAP.
   If PARTIAL is nonzero, omit certain "uninteresting" commands
   (such as `undefined').
   If SHADOW is non-nil, don't mention keys which would be shadowed by it */

describe_map_tree (startmap, partial, shadow)
     Lisp_Object startmap, shadow;
     int partial;
{
  register Lisp_Object maps, elt, sh;

  maps = Faccessible_keymaps (startmap);

  for (; !NULL (maps); maps = Fcdr (maps))
    {
      elt = Fcar (maps);
      sh = Fcar (elt);
      if (NULL (shadow))
	sh = Qnil;
      else if (XTYPE (sh) == Lisp_String &&
	       XSTRING (sh)->size == 0)
	sh = shadow;
      else
	{
	  sh = Flookup_key (shadow, Fcar (elt));
	  if (XTYPE (sh) == Lisp_Int)
	    sh = Qnil;
	}
      if (NULL (sh) || !NULL (Fkeymapp (sh)))
	describe_map (Fcdr (elt), Fcar (elt), partial, sh);
    }
}

describe_command (definition)
     Lisp_Object definition;
{
  register Lisp_Object tem1;

  Findent_to (make_number (16), make_number (1));

  if (XTYPE (definition) == Lisp_Symbol)
    {
      XSET (tem1, Lisp_String, XSYMBOL (definition)->name);
      insert1 (tem1);
      InsStr ("\n");
    }
  else
    {
      tem1 = Fkeymapp (definition);
      if (!NULL (tem1))
	InsStr ("Prefix Command\n");
      else
	InsStr ("??\n");
    }
}

/* Describe the contents of map MAP, assuming that this map
   itself is reached by the sequence of prefix keys STRING (a string).
   PARTIAL and SHADOW are the same as in `describe_map_tree' above.  */

describe_map (map, string, partial, shadow)
     Lisp_Object map, string;
     int partial;
     Lisp_Object shadow;
{
  register Lisp_Object keysdesc;

  if (!NULL (string) && XSTRING (string)->size > 0)
    keysdesc = concat2 (Fkey_description (string), build_string (" "));
  else
    keysdesc = Qnil;

  if (CONSP (map))
    describe_alist (Fcdr (map), keysdesc, describe_command,
		    partial, shadow);
  else
    describe_vector (map, keysdesc, describe_command,
		     partial, shadow);
}

describe_alist (alist, elt_prefix, elt_describer, partial, shadow)
     register Lisp_Object alist;
     Lisp_Object elt_prefix;
     int (*elt_describer) ();
     int partial;
     Lisp_Object shadow;
{
  Lisp_Object this;
  Lisp_Object tem1, tem2;
  Lisp_Object suppress;
  Lisp_Object kludge = Qnil;
  int first = 1;
  struct gcpro gcpro1, gcpro2;

  if (partial)
    suppress = intern ("suppress-keymap");

  for (; CONSP (alist); alist = Fcdr (alist))
    {
      QUIT;
      tem1 = Fcar (Fcar (alist));
      tem2 = get_keyelt (Fcdr (Fcar (alist)));
      if (NULL (tem2)) continue;
      if (XTYPE (tem2) == Lisp_Symbol && partial)
	{
	  this = Fget (tem2, suppress);
	  if (!NULL (this))
	    continue;
	}

      if (!NULL (shadow))
	{
	  Lisp_Object tem;
	  if (NULL (kludge)) kludge = build_string ("x");
	  XSTRING (kludge)->data[0] = XINT (tem1);
	  tem = Flookup_key (shadow, kludge);
	  if (!NULL (tem)) continue;
	}

      if (first)
	{
	  insert ("\n", 1);
	  first = 0;
	}

      GCPRO2 (elt_prefix, tem2);
      if (!NULL (elt_prefix))
	insert1 (elt_prefix);

      insert1 (Fsingle_key_description (tem1));

      (*elt_describer) (tem2);
      UNGCPRO;
    }
}

describe_vector (vector, elt_prefix, elt_describer, partial, shadow)
     register Lisp_Object vector;
     Lisp_Object elt_prefix;
     int (*elt_describer) ();
     int partial;
     Lisp_Object shadow;
{
  Lisp_Object this;
  Lisp_Object dummy;
  Lisp_Object tem1, tem2;
  register int i, size = XVECTOR (vector)->size;
  Lisp_Object suppress;
  Lisp_Object kludge;
  int first = 1;
  struct gcpro gcpro1, gcpro2;

  tem1 = Qnil;
  kludge = Qnil;
  GCPRO2 (elt_prefix, tem1);

  if (partial)
    suppress = intern ("suppress-keymap");

  for (i = 0; i < size; i++)
    {
      QUIT;
      tem1 = get_keyelt (XVECTOR (vector)->contents[i]);
      if (NULL (tem1)) continue;      
      if (XTYPE (tem1) == Lisp_Symbol && partial)
	{
	  this = Fget (tem1, suppress);
	  if (!NULL (this))
	    continue;
	}

      if (!NULL (shadow))
	{
	  Lisp_Object tem;
	  if (NULL (kludge)) kludge = build_string ("x");
	  XSTRING (kludge)->data[0] = XINT (i);
	  tem = Flookup_key (shadow, kludge);
	  if (!NULL (tem)) continue;
	}

      if (first)
	{
	  insert ("\n", 1);
	  first = 0;
	}

      if (!NULL (elt_prefix))
	insert1 (elt_prefix);

      XFASTINT (dummy) = i;
      insert1 (Fsingle_key_description (dummy));

      while (i + 1 < size
	     && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1]),
		 EQ (tem2, tem1)))
	i++;

      if (i != XINT (dummy))
	{
	  insert (" .. ", 4);
	  if (!NULL (elt_prefix))
	    insert1 (elt_prefix);

	  XFASTINT (dummy) = i;
	  insert1 (Fsingle_key_description (dummy));
	}

      (*elt_describer) (tem1);
    }

  UNGCPRO;
}

/* Apropos */
Lisp_Object apropos_predicate;
Lisp_Object apropos_accumulate;

static
apropos_accum (symbol, string)
     Lisp_Object symbol, string;
{
  register Lisp_Object tem;

  tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
  if (!NULL (tem) && !NULL (apropos_predicate))
    tem = call1 (apropos_predicate, symbol);
  if (!NULL (tem))
    apropos_accumulate = Fcons (symbol, apropos_accumulate);
}

static Lisp_Object
apropos1 (list)
     register Lisp_Object list;
{
  struct buffer *old = current_buffer;
  register Lisp_Object symbol, col, tem;

  while (!NULL (list))
    {
      Lisp_Object min_cols;

      QUIT;

      symbol = Fcar (list);
      list = Fcdr (list);

      tem = Fwhere_is_internal (symbol, current_buffer->keymap, Qnil);
      tem = Fmapconcat (Qkey_description, tem, build_string (", "));
      XFASTINT (col) = 30;

      set_buffer_internal (XBUFFER (Vstandard_output));
      Fprin1 (symbol, Qnil);
      XFASTINT (min_cols) = 1;
      Findent_to (col, min_cols);
      Fprinc (tem, Qnil);
      Fterpri (Qnil);
      tem = Ffboundp (symbol);
      if (!NULL (tem))
        tem = Fdocumentation (symbol);
      if (XTYPE (tem) == Lisp_String)
	insert_first_line ("  Function: ", tem);
      tem = Fdocumentation_property (symbol, Qvariable_documentation);
      if (XTYPE (tem) == Lisp_String)
	insert_first_line ("  Variable: ", tem);
      set_buffer_internal (old);
    }
  return Qnil;
}

static
insert_first_line (prefix, str)
     char *prefix;
     Lisp_Object str;
{
  extern char *index ();
  register unsigned char *p;
  register unsigned char *p1;
  register unsigned char *p2;
  struct gcpro gcpro1;

  GCPRO1 (str);
  InsStr (prefix);

 retry:
  p = XSTRING (str)->data;
  p1 = (unsigned char *) index (p, '\n');

  for (p2 = p; *p2 && p2 != p1; p2++)
    if (p2[0] == '\\' && p2[1] == '[')
      {
	str = Fsubstitute_command_keys (str);
	goto retry;
      }

  insert (p, p1 ? p1 - p : strlen (p));
  insert ("\n", 1);
  UNGCPRO;
}

DEFUN ("apropos", Fapropos, Sapropos, 1, 3, "sApropos: ",
  "Show all symbols whose names contain match for REGEXP.\n\
If optional arg PRED is non-nil, (funcall PRED SYM) is done\n\
for each symbol and a symbol is mentioned if that returns non-nil.\n\
Returns list of symbols found; if third arg NOPRINT is non-nil,\n\
does not display them, just returns the list.")
  (string, pred, noprint)
     Lisp_Object string, pred, noprint;
{
  struct gcpro gcpro1, gcpro2;
  CHECK_STRING (string, 0);
  apropos_predicate = pred;
  GCPRO2 (apropos_predicate, apropos_accumulate);
  apropos_accumulate = Qnil;
  map_obarray (Vobarray, apropos_accum, string);
  apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
  if (NULL (noprint))
    internal_with_output_to_temp_buffer ("*Help*", apropos1,
					 apropos_accumulate);
  UNGCPRO;
  return apropos_accumulate;
}

syms_of_keymap ()
{
  Lisp_Object tem;

  Qkeymap = intern ("keymap");
  staticpro (&Qkeymap);

/* Initialize the keymaps standardly used.
   Each one is the value of a Lisp variable, and is also
   pointed to by a C variable */

#ifdef HAVE_X_WINDOWS
  tem = Fmake_keymap ();
  MouseMap = tem;
  Fset (intern ("mouse-map"), tem);
#endif /* HAVE_X_WINDOWS */

  tem = Fmake_keymap ();
  Vglobal_map = tem;
  Fset (intern ("global-map"), tem);

  tem = Fmake_keymap ();
  Vesc_map = tem;
  Fset (intern ("esc-map"), tem);
  Ffset (intern ("ESC-prefix"), tem);

  tem = Fmake_keymap ();
  Vctl_x_map = tem;
  Fset (intern ("ctl-x-map"), tem);
  Ffset (intern ("Control-X-prefix"), tem);

  DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
    "Default keymap to use when reading from the minibuffer.");
  Vminibuffer_local_map = Fmake_sparse_keymap ();

  DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
    "The keymap used by the minibuf for local bindings when spaces are not\n\
to be allowed in input string.");
  Vminibuffer_local_ns_map = Fmake_sparse_keymap ();

  DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
    "Keymap to use when reading from the minibuffer with completion.");
  Vminibuffer_local_completion_map = Fmake_sparse_keymap ();

  DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
    "Keymap to use when reading from the minibuffer with completion and\n\
an exact match of one of the completions is required.");
  Vminibuffer_local_must_match_map = Fmake_sparse_keymap ();

  global_map = Vglobal_map;

  Qsingle_key_description = intern ("single-key-description");
  staticpro (&Qsingle_key_description);

  Qkey_description = intern ("key-description");
  staticpro (&Qkey_description);

  Qkeymapp = intern ("keymapp");
  staticpro (&Qkeymapp);

  defsubr (&Skeymapp);
  defsubr (&Smake_keymap);
  defsubr (&Smake_sparse_keymap);
  defsubr (&Scopy_keymap);
  defsubr (&Skey_binding);
  defsubr (&Slocal_key_binding);
  defsubr (&Sglobal_key_binding);
  defsubr (&Sglobal_set_key);
  defsubr (&Slocal_set_key);
  defsubr (&Sdefine_key);
  defsubr (&Slookup_key);
  defsubr (&Sglobal_unset_key);
  defsubr (&Slocal_unset_key);
  defsubr (&Sdefine_prefix_command);
  defsubr (&Suse_global_map);
  defsubr (&Suse_local_map);
  defsubr (&Scurrent_local_map);
  defsubr (&Scurrent_global_map);
  defsubr (&Saccessible_keymaps);
  defsubr (&Skey_description);
  defsubr (&Ssingle_key_description);
  defsubr (&Stext_char_description);
  defsubr (&Swhere_is_internal);
  defsubr (&Swhere_is);
  defsubr (&Sdescribe_bindings);
  defsubr (&Sapropos);
}

keys_of_keymap ()
{
  ndefkey (Vglobal_map, 033, "ESC-prefix");
  ndefkey (Vglobal_map, Ctl ('X'), "Control-X-prefix");
}