keyboard.c

早期freebsd实现

{
  Lisp_Object function;
  char buf[40];
  Lisp_Object saved_keys;
  struct gcpro gcpro1;

  saved_keys = Fthis_command_keys ();
  GCPRO1 (saved_keys);

  buf[0] = 0;

  if (EQ (prefixarg, Qminus))
    strcpy (buf, "- ");
  else if (CONSP (prefixarg) && XINT (XCONS (prefixarg)->car) == 4)
    strcpy (buf, "C-u ");
  else if (CONSP (prefixarg) && XTYPE (XCONS (prefixarg)->car) == Lisp_Int)
    sprintf (buf, "%d ", XINT (XCONS (prefixarg)->car));
  else if (XTYPE (prefixarg) == Lisp_Int)
    sprintf (buf, "%d ", XINT (prefixarg));

  /* This isn't strictly correct if execute-extended-command
     is bound to anything else */
  strcat (buf, "M-x ");

  function = Fcompleting_read (build_string (buf), Vobarray, Qcommandp, Qt, Qnil);

  saved_keys = concat2 (saved_keys, function);
  if (this_command_keys_size < XSTRING (function)->size)
    {
      this_command_keys_size += XSTRING (function)->size;
      this_command_keys = (char *) xrealloc (this_command_keys,
					      this_command_keys_size);
    }
  bcopy (XSTRING (function)->data, this_command_keys,
	 XSTRING (function)->size + 1);
  this_command_key_count = XSTRING (saved_keys)->size;

  UNGCPRO;

  function = Fintern (function, Vobarray);
  Vprefix_arg = prefixarg;
  this_command = function;

  return Fcommand_execute (function, Qt);
}

detect_input_pending ()
{
  if (!input_pending)
    get_input_pending (&input_pending);

  return input_pending;
}

DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
  "T if command input is currently available with no waiting.\n\
Actually, the value is NIL only if we can be sure that no input is available.")
  ()
{
  if (unread_command_char >= 0) return Qt;

  return detect_input_pending () ? Qt : Qnil;
}

DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
  "Return string of last 100 chars read from terminal.")
  ()
{
  Lisp_Object val;
  if (total_keys < sizeof recent_keys)
    return make_string (recent_keys, total_keys);

  val = make_string (recent_keys, sizeof recent_keys);
  bcopy (recent_keys + recent_keys_index,
	 XSTRING (val)->data,
	 sizeof recent_keys - recent_keys_index);
  bcopy (recent_keys,
	 XSTRING (val)->data + sizeof recent_keys - recent_keys_index,
	 recent_keys_index);
  return val;
}

DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
  "Return string of the keystrokes that invoked this command.")
  ()
{
  return make_string (this_command_keys, this_command_key_count);
}

DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
  "Return the current depth in recursive edits.")
  ()
{
  Lisp_Object temp;
  XFASTINT (temp) = command_loop_level + minibuf_level;
  return temp;
}

DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
  "FOpen dribble file: ",
  "Start writing all keyboard characters to FILE.")
  (file)
     Lisp_Object file;
{
  file = Fexpand_file_name (file, Qnil);
  dribble = fopen (XSTRING (file)->data, "w");
  return Qnil;
}

DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
  "Discard the contents of the terminal input buffer.\n\
Also flush any kbd macro definition in progress.")
  ()
{
  defining_kbd_macro = 0;
  update_mode_lines++;

  unread_command_char = -1;
  discard_tty_input ();

  kbd_count = 0;
  input_pending = 0;

  return Qnil;
}

DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
  "Stop Emacs and return to superior process.  You can resume.\n\
If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
to be read as terminal input by Emacs's superior shell.\n\
Before suspending, if `suspend-hook' is bound and value is non-nil\n\
call the value as a function of no args.  Don't suspend if it returns non-nil.\n\
Otherwise, suspend normally and after resumption call\n\
`suspend-resume-hook' if that is bound and non-nil.")
  (stuffstring)
     Lisp_Object stuffstring;
{
  register Lisp_Object tem;
  int count = specpdl_ptr - specpdl;
  int old_height, old_width;
  int width, height;
  struct gcpro gcpro1;
  extern init_sys_modes ();

  if (!NULL (stuffstring))
    CHECK_STRING (stuffstring, 0);
  GCPRO1 (stuffstring);

  /* Call value of suspend-hook
     if it is bound and value is non-nil.  */
  tem = intern ("suspend-hook");
  tem = XSYMBOL (tem)->value;
  if (! EQ (tem, Qunbound) && ! EQ (tem, Qnil))
    {
      tem = call0 (tem);
      if (!EQ (tem, Qnil)) return Qnil;
    }

  get_screen_size (&old_width, &old_height);
  reset_sys_modes ();
  /* sys_suspend can get an error if it tries to fork a subshell
     and the system resources aren't available for that.  */
  record_unwind_protect (init_sys_modes, 0);
  stuff_buffered_input (stuffstring);
  sys_suspend ();
  unbind_to (count);

  /* Check if terminal/window size has changed.
     Note that this is not useful when we are running directly
     with a window system; but suspend should be disabled in that case.  */
  get_screen_size (&width, &height);
  if (width != old_width || height != old_height)
    change_screen_size (height, width, 0);

  /* Call value of suspend-resume-hook
     if it is bound and value is non-nil.  */
  tem = intern ("suspend-resume-hook");
  tem = XSYMBOL (tem)->value;
  if (! EQ (tem, Qunbound) && ! EQ (tem, Qnil))
    call0 (tem);
  UNGCPRO;
  return Qnil;
}

/* If STUFFSTRING is a string, stuff its contents as pending terminal input.
   Then in any case stuff anthing Emacs has read ahead and not used.  */

stuff_buffered_input (stuffstring)
     Lisp_Object stuffstring;
{
  register unsigned char *p;

/* stuff_char works only in BSD, versions 4.2 and up.  */
#ifdef BSD
#ifndef BSD4_1
  if (XTYPE (stuffstring) == Lisp_String)
    {
      register int count;

      p = XSTRING (stuffstring)->data;
      count = XSTRING (stuffstring)->size;
      while (count-- > 0)
	stuff_char (*p++);
      stuff_char ('\n');
    }
  /* Anything we have read ahead, put back for the shell to read.  */
  while (kbd_count)
    {
      stuff_char (*kbd_ptr++);
      kbd_count--;
    }
  input_pending = 0;
#endif
#endif /* BSD and not BSD4_1 */
}

set_waiting_for_input (word_to_clear)
     long *word_to_clear;
{
  input_available_clear_word = word_to_clear;

  /* Tell interrupt_signal to throw back to read_command_char,  */
  waiting_for_input = 1;

  /* If interrupt_signal was called before and buffered a C-g,
     make it run again now, to avoid timing error.  */
  if (!NULL (Vquit_flag))
    quit_throw_to_read_command_char ();

  /* Tell alarm signal to echo right away */
  echo_now = 1;

  /* If alarm has gone off already, echo now.  */
  if (echo_flag)
    {
      echo ();
      echo_flag = 0;
    }
}

clear_waiting_for_input ()
{
  /* Tell interrupt_signal not to throw back to read_command_char,  */
  waiting_for_input = 0;
  echo_now = 0;
  input_available_clear_word = 0;
}

/* This routine is called at interrupt level in response to C-G.
 If interrupt_input, this is the handler for SIGINT.
 Otherwise, it is called from kbd_buffer_store_char,
 in handling SIGIO or SIGTINT.

 If `waiting_for_input' is non zero, then unless `echoing' is nonzero,
 immediately throw back to read_command_char.

 Otherwise it sets the Lisp variable  quit-flag  not-nil.
 This causes  eval  to throw, when it gets a chance.
 If  quit-flag  is already non-nil, it stops the job right away.  */

interrupt_signal ()
{
  char c;
  /* Must preserve main program's value of errno.  */
  int old_errno = errno;
  extern Lisp_Object Vwindow_system;

#ifdef USG
  /* USG systems forget handlers when they are used;
     must reestablish each time */
  signal (SIGINT, interrupt_signal);
  signal (SIGQUIT, interrupt_signal);
#endif /* USG */

  cancel_echoing ();

  if (!NULL (Vquit_flag) && NULL (Vwindow_system))
    {
      fflush (stdout);
      reset_sys_modes ();
      sigfree ();
#ifdef SIGTSTP			/* Support possible in later USG versions */
/*
 * On systems which can suspend the current process and return to the original
 * shell, this command causes the user to end up back at the shell.
 * The "Auto-save" and "Abort" questions are not asked until
 * the user elects to return to emacs, at which point he can save the current
 * job and either dump core or continue.
 */
      sys_suspend ();
#else
#ifdef VMS
      if (sys_suspend () == -1)
	{
	  printf ("Not running as a subprocess;\n");
	  printf ("you can continue or abort.\n");
	}
#else /* not VMS */
      /* Perhaps should really fork an inferior shell?
	 But that would not provide any way to get back
	 to the original shell, ever.  */
      printf ("No support for stopping a process on this operating system;\n");
      printf ("you can continue or abort.\n");
#endif /* not VMS */
#endif /* not SIGTSTP */
      printf ("Auto-save? (y or n) ");
      fflush (stdout);
      if (((c = getchar ()) & ~040) == 'Y')
	Fdo_auto_save (Qnil);
      while (c != '\n') c = getchar ();
#ifdef VMS
      printf ("Abort (and enter debugger)? (y or n) ");
#else /* not VMS */
      printf ("Abort (and dump core)? (y or n) ");
#endif /* not VMS */
      fflush (stdout);
      if (((c = getchar ()) & ~040) == 'Y')
	abort ();
      while (c != '\n') c = getchar ();
      printf ("Continuing...\n");
      fflush (stdout);
      init_sys_modes ();
    }
  else
    {
      /* If executing a function that wants to be interrupted out of
	     and the user has not deferred quitting by binding `inhibit-quit'
	     then quit right away.  */
      if (immediate_quit && NULL (Vinhibit_quit))
	{
	  immediate_quit = 0;
          sigfree ();
	  Fsignal (Qquit, Qnil);
	}
      else
	/* Else request quit when it's safe */
	Vquit_flag = Qt;
    }

  if (waiting_for_input && !echoing)
    quit_throw_to_read_command_char ();

  errno = old_errno;
}

/* Handle a C-g by making read_command_char return C-g.  */

quit_throw_to_read_command_char ()
{
  quit_error_check ();
  sigfree ();
  /* Prevent another signal from doing this before we finish.  */
  waiting_for_input = 0;
  input_pending = 0;
  unread_command_char = -1;
#ifdef POLL_FOR_INPUT
  if (poll_suppress_count != 1)
    abort ();
#endif
  _longjmp (getcjmp, 1);
}

DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 2, 3, 0,
  "Set mode of reading keyboard input.\n\
First arg non-nil means use input interrupts; nil means use CBREAK mode.\n\
Second arg non-nil means use ^S/^Q flow control for output to terminal\n\
 (no effect except in CBREAK mode).\n\
Optional third arg non-nil specifies character to use for quitting.\n\n\
Note that the arguments will change incompatibly in version 19.")
  (interrupt, flow, quit)
     Lisp_Object interrupt, flow, quit;
{
  reset_sys_modes ();
#ifdef SIGIO
/* Note SIGIO has been undef'd if FIONREAD is missing.  */
#ifdef NO_SOCK_SIGIO
  if (read_socket_hook)
    interrupt_input = 0;	/* No interrupts if reading from a socket.  */
  else
#endif /* NO_SOCK_SIGIO */
    interrupt_input = !NULL (interrupt);
#else /* not SIGIO */
  interrupt_input = 0;
#endif /* not SIGIO */
  flow_control = !NULL (flow);
  if (!NULL (quit))
    {
      CHECK_NUMBER (quit, 2);
      quit_char = XINT (quit);
      /* Don't let this value be out of range.  */
      quit_char &= (meta_key ? 0377 : 0177);
    }
  init_sys_modes ();
  return Qnil;
}

init_keyboard ()
{
  this_command_keys_size = 40;
  this_command_keys = (char *) xmalloc (40);

  command_loop_level = -1;	/* Correct, before outermost invocation.  */
  quit_char = Ctl ('G');
  immediate_quit = 0;
  unread_command_char = -1;
  recent_keys_index = 0;
  total_keys = 0;
  kbd_count = 0;
  kbd_ptr = kbd_buffer;
  input_pending = 0;
  force_input = 0;
  if (!noninteractive)
    {
      signal (SIGINT, interrupt_signal);
#ifdef USG
      /* On USG systems, C-g is set up for both SIGINT and SIGQUIT
	 and we can't tell which one it will give us.  */
      signal (SIGQUIT, interrupt_signal);
#endif /* USG */
/* Note SIGIO has been undef'd if FIONREAD is missing.  */
#ifdef SIGIO
      signal (SIGIO, input_available_signal);
#endif SIGIO
    }

/* Use interrupt input by default, if it works and noninterrupt input
   has deficiencies.  */

#ifdef INTERRUPT_INPUT
  interrupt_input = 1;
#else
  interrupt_input = 0;
#endif

  sigfree ();
  dribble = 0;

  if (keyboard_init_hook)
    (*keyboard_init_hook) ();

  poll_suppress_count = 1;
#ifdef POLL_FOR_INPUT
  start_polling ();
#endif
}

syms_of_keyboard ()
{
  Qself_insert_command = intern ("self-insert-command");
  staticpro (&Qself_insert_command);

  Qforward_char = intern ("forward-char");
  staticpro (&Qforward_char);

  Qbackward_char = intern ("backward-char");
  staticpro (&Qbackward_char);

  Qtop_level = intern ("top-level");
  staticpro (&Qtop_level);

  Qdisabled = intern ("disabled");
  staticpro (&Qdisabled);

  defsubr (&Sread_key_sequence);
  defsubr (&Srecursive_edit);
  defsubr (&Sinput_pending_p);
  defsubr (&Scommand_execute);
  defsubr (&Srecent_keys);
  defsubr (&Sthis_command_keys);
  defsubr (&Ssuspend_emacs);
  defsubr (&Sabort_recursive_edit);
  defsubr (&Sexit_recursive_edit);
  defsubr (&Srecursion_depth);
  defsubr (&Stop_level);
  defsubr (&Sdiscard_input);
  defsubr (&Sopen_dribble_file);
  defsubr (&Sset_input_mode);
  defsubr (&Sexecute_extended_command);

  DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook,
    "Value is called instead of any command that is disabled\n\
\(has a non-nil  disabled  property).");

  DEFVAR_BOOL ("meta-flag", &meta_key,
    "*Non-nil means treat 0200 bit in terminal input as Meta bit.");

  DEFVAR_INT ("last-command-char", &last_command_char,
    "Last terminal input character that was part of a command, as an integer.");

  DEFVAR_INT ("last-input-char", &last_input_char,
    "Last terminal input character, as an integer.");

  DEFVAR_INT ("unread-command-char", &unread_command_char,
    "Character to be read as next input from command input stream, or -1 if none.");

  DEFVAR_INT ("meta-prefix-char", &meta_prefix_char,
    "Meta-prefix character code.  Meta-foo as command input\n\
turns into this character followed by foo.");
  meta_prefix_char = 033;

  DEFVAR_LISP ("last-command", &last_command,
    "The last command executed.  Normally a symbol with a function definition,\n\
but can be whatever was found in the keymap, or whatever the variable\n\
`this-command' was set to by that command.");
  last_command = Qnil;

  DEFVAR_LISP ("this-command", &this_command,
    "The command now being executed.\n\
The command can set this variable; whatever is put here\n\
will be in  last-command  during the following command.");
  this_command = Qnil;

  DEFVAR_INT ("auto-save-interval", &auto_save_interval,
    "*Number of keyboard input characters between auto-saves.\n\
Zero means disable autosaving.");
  auto_save_interval = 300;

  DEFVAR_INT ("echo-keystrokes", &echo_keystrokes,
    "*Nonzero means echo unfinished commands after this many seconds of pause.");
  echo_keystrokes = 1;

  DEFVAR_INT ("polling-period", &polling_period,
    "*Interval between polling for input during Lisp execution.\n\
The reason for polling is to make C-g work to stop a running program.\n\
Polling is needed only when using X windows and SIGIO does not work.\n\
Polling is automatically disabled in all other cases.");
  polling_period = 2;

  DEFVAR_INT ("help-char", &help_char,
    "Character to recognize as meaning Help.\n\
When it is read, do (eval help-form), and display result if it's a string.\n\
If help-form's value is nil, this char can be read normally.");
  help_char = Ctl ('H');

  DEFVAR_LISP ("help-form", &Vhelp_form,
    "Form to execute when character help-char is read.\n\
If the form returns a string, that string is displayed.\n\
If help-form is nil, the help char is not recognized.");
  Vhelp_form = Qnil;
  
  DEFVAR_LISP ("top-level", &Vtop_level,
    "Form to evaluate when Emacs starts up.\n\
Useful to set before you dump a modified Emacs.");
  Vtop_level = Qnil;

  DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
    "String used as translate table for keyboard input, or nil.\n\
Each character is looked up in this string and the contents used instead.\n\
If string is of length N, character codes N and up are untranslated."); 
  Vkeyboard_translate_table = Qnil;
}

keys_of_keyboard ()
{
  ndefkey (Vglobal_map, Ctl ('Z'), "suspend-emacs");
  ndefkey (Vctl_x_map, Ctl ('Z'), "suspend-emacs");
  ndefkey (Vesc_map, Ctl ('C'), "exit-recursive-edit");
  ndefkey (Vglobal_map, Ctl (']'), "abort-recursive-edit");
  ndefkey (Vesc_map, 'x', "execute-extended-command");
}