keyboard.c

早期freebsd实现

/* Keyboard input; editor command loop.
   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.  */

/*** For version 19, can simplify this by making interrupt_input 1 on VMS.  */

/* Allow config.h to undefine symbols found here.  */
#include <signal.h>

#include "config.h"
#include <stdio.h>
#undef NULL
#include "termchar.h"
#include "termopts.h"
#include "termhooks.h"
#include "lisp.h"
#include "macros.h"
#include "window.h"
#include "commands.h"
#include "buffer.h"
#include <setjmp.h>
#include <errno.h>

extern int errno;

/* Get FIONREAD, if it is available.  */
#ifdef USG
#include <termio.h>
#include <fcntl.h>
#else /* not USG */
#ifndef VMS
#include <sys/ioctl.h>
#endif /* not VMS */
#endif /* not USG */

/* Allow m- file to inhibit use of FIONREAD.  */
#ifdef BROKEN_FIONREAD
#undef FIONREAD
#endif

/* Make all keyboard buffers much bigger when using X windows.  */
#ifdef HAVE_X_WINDOWS
#define BUFFER_SIZE_FACTOR 16
#else
#define BUFFER_SIZE_FACTOR 1
#endif

/* Following definition copied from eval.c */

struct backtrace
  {
    struct backtrace *next;
    Lisp_Object *function;
    Lisp_Object *args;	/* Points to vector of args. */
    int nargs;		/* length of vector */
	       /* if nargs is UNEVALLED, args points to slot holding list of unevalled args */
    char evalargs;
  };

/* Non-nil disable property on a command means
 do not execute it; call disabled-command-hook's value instead. */
Lisp_Object Qdisabled, Vdisabled_command_hook;

int recent_keys_index;	/* Index for storing next element into recent_keys */
int total_keys;		/* Total number of elements stored into recent_keys */
char recent_keys[100];	/* Holds last 100 keystrokes */

/* Buffer holding the key that invoked the current command.  */
char *this_command_keys;
int this_command_key_count;	/* Size in use.  */
int this_command_keys_size;	/* Size allocated.  */

extern struct backtrace *backtrace_list;

static jmp_buf getcjmp;	/* for longjmp to where kbd input is being done. */

int waiting_for_input;	/* True while doing kbd input */

/* True while displaying for echoing.   Delays C-g throwing. */
static int echoing;

int immediate_quit;	/* Nonzero means C-G should cause immediate error-signal. */

int help_char;		/* Character to recognize as the help char.  */

Lisp_Object Vhelp_form;	/* Form to execute when help char is typed.  */

/* Character that causes a quit.  Normally C-g.  */

int quit_char;

extern Lisp_Object global_map;

/* Current depth in recursive edits.  */

int command_loop_level;

/* Last input character read as a command.  */

int last_command_char;

/* Last input character read for any purpose.  */

int last_input_char;

/* If not -1, a character to be read as the next command input */

int unread_command_char;

/* Char to use as prefix when a meta character is typed in.
 This is bound on entry to minibuffer in case Esc is changed there.  */

int meta_prefix_char;

/* Total number of times read_command_char has returned.  */

int num_input_chars;

/* Auto-save automatically when this many characters have been typed
   since the last time.  */

static int auto_save_interval;

/* Value of num_input_chars as of last auto save.  */

int last_auto_save;

/* Last command executed by the editor command loop, not counting
   commands that set the prefix argument.  */

Lisp_Object last_command;

/* The command being executed by the command loop.
   Commands may set this, and the value set will be copied into last_command
   instead of the actual command.  */
Lisp_Object this_command;

Lisp_Object Qself_insert_command;
Lisp_Object Qforward_char;
Lisp_Object Qbackward_char;

/* read_key_sequence stores here the command definition of the
   key sequence that it reads.  */
Lisp_Object read_key_sequence_cmd;

/* Form to evaluate (if non-nil) when Emacs is started */
Lisp_Object Vtop_level;

/* User-supplied string to translate input characters through */
Lisp_Object Vkeyboard_translate_table;

FILE *dribble;			/* File in which we write all commands we read */

/* Nonzero if input is available */
int input_pending;

/* Nonzero if should obey 0200 bit in input chars as "Meta" */
int meta_key;

extern char *pending_malloc_warning;

/* Buffer for pre-read keyboard input */
unsigned char kbd_buffer [256 * BUFFER_SIZE_FACTOR];

/* Number of characters available in kbd_buffer.  */
int kbd_count;

/* Pointer to next available character in kbd_buffer.  */
unsigned char *kbd_ptr;

/* Address (if not 0) of word to zero out
 if a SIGIO interrupt happens */
long *input_available_clear_word;

/* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
   Default is 1 if INTERRUPT_INPUT is defined.  */

int interrupt_input;

/* Nonzero while interrupts are temporarily deferred during redisplay.  */

int interrupts_deferred;

/* nonzero means use ^S/^Q for flow control.  */

int flow_control;

#ifndef BSD4_1
#define sigfree() sigsetmask (0)
#define sigholdx(sig) sigsetmask (1 << ((sig) - 1))
#define sigblockx(sig) sigblock (1 << ((sig) - 1))
#define sigunblockx(sig) sigblock (0)
#define sigpausex(sig) sigpause (0)
#endif /* not BSD4_1 */

#ifdef BSD4_1
#define SIGIO SIGTINT
/* sigfree and sigholdx are in sysdep.c */
#define sigblockx(sig) sighold (sig)
#define sigunblockx(sig) sigrelse (sig)
#define sigpausex(sig) sigpause (sig)
#endif /* BSD4_1 */

#ifndef sigmask
#define sigmask(no) (1L << ((no) - 1))
#endif

/* We are unable to use interrupts if FIONREAD is not available,
   so flush SIGIO so we won't try. */
#ifndef FIONREAD
#ifdef SIGIO
#undef SIGIO
#endif
#endif

/* If we support X Windows, and won't get an interrupt when input
   arrives from the server, poll periodically so we can detect C-g.  */
#ifdef HAVE_X_WINDOWS
#ifndef SIGIO
#define POLL_FOR_INPUT
#endif
#endif

/* Function for init_keyboard to call with no args (if nonzero).  */
void (*keyboard_init_hook) ();

static void read_avail_input ();
static void get_input_pending ();

/* Non-zero tells input_available_signal to call read_socket_hook
   even if FIONREAD returns zero.  */
static int force_input;

static int echo_keystrokes;	/* > 0 if we are to echo keystrokes */

/* Nonzero means echo each character as typed.  */
static int immediate_echo;

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

static char echobuf[100];
static char *echoptr;

/* Install the string STR as the beginning of the string of echoing,
   so that it serves as a prompt for the next character.
   Also start echoing.  */

echo_prompt (str)
     char *str;
{
  int len = strlen (str);
  if (len > sizeof echobuf - 4)
    len = sizeof echobuf - 4;
  bcopy (str, echobuf, len + 1);
  echoptr = echobuf + len;

  echo ();
}

/* Add the character C to the echo string,
   if echoing is going on.  */

echo_char (c)
     int c;
{
  extern char *push_key_description ();

  if (immediate_echo)
    {
      char *ptr = echoptr;

      if (ptr - echobuf > sizeof echobuf - 6)
	return;

      ptr = push_key_description (c, ptr);
      *ptr++ = ' ';
      if (echoptr == echobuf && c == help_char)
	{
	  strcpy (ptr, "(Type ? for further options) ");
	  ptr += strlen (ptr);
	}

      *ptr = 0;
      echoptr = ptr;

      echo ();
    }
}

/* Temporarily add a dash to the end of the echo string,
   so that it serves as a mini-prompt for the very next character.  */

echo_dash ()
{
  if (!immediate_echo && echoptr == echobuf)
    return;

  /* Put a dash at the end of the buffer temporarily,
     but make it go away when the next character is added.  */
  echoptr[0] = '-';
  echoptr[1] = 0;

  echo ();
}

/* Display the current echo string, and begin echoing if not already
   doing so.  */

echo ()
{
  if (!immediate_echo)
    {
      int i;
      immediate_echo = 1;

      for (i = 0; i < this_command_key_count; i++)
	echo_char (this_command_keys[i]);
      echo_dash ();
    }

  echoing = 1;
  message1 (echobuf);
  echoing = 0;

  if (waiting_for_input && !NULL (Vquit_flag))
    quit_throw_to_read_command_char ();
}

/* Turn off echoing, for the start of a new command.  */

cancel_echoing ()
{
  immediate_echo = 0;
  echoptr = echobuf;
}

/* When an auto-save happens, record the "time", and don't do again soon.  */
record_auto_save ()
{
  last_auto_save = num_input_chars;
}

Lisp_Object recursive_edit_unwind (), command_loop ();

DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
  "Invoke the editor command loop recursively.\n\
Do (throw 'exit nil) within the command loop to make this function return,\n\
or (throw 'exit t) to make this function signal an error.\n\
This function is called by the editor initialization\n\
to begin editing.")
  ()
{
  int count = specpdl_ptr - specpdl;

  command_loop_level++;
  update_mode_lines = 1;

  record_unwind_protect (recursive_edit_unwind,
			 (current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)
			  ? Fcurrent_buffer ()
			  : Qnil));

  recursive_edit_1 ();

  unbind_to (count);
  return Qnil;
}

Lisp_Object
recursive_edit_1 ()
{
  int count = specpdl_ptr - specpdl;
  Lisp_Object val;

  if (command_loop_level > 0)
    {
      specbind (Qstandard_output, Qt);
      specbind (Qstandard_input, Qt);
    }

  val = command_loop ();
  if (EQ (val, Qt))
    Fsignal (Qquit, Qnil);

  unbind_to (count);
  return Qnil;
}

Lisp_Object
recursive_edit_unwind (buffer)
     Lisp_Object buffer;
{
  if (!NULL (buffer))
    Fset_buffer (buffer);
  command_loop_level--;
  update_mode_lines = 1;
  return Qnil;
}

Lisp_Object
cmd_error (data)
     Lisp_Object data;
{
  Lisp_Object errmsg, tail, errname, file_error;
  struct gcpro gcpro1;
  int i;

  Vquit_flag = Qnil;
  Vinhibit_quit = Qt;
  Vstandard_output = Qt;
  Vstandard_input = Qt;
  Vexecuting_macro = Qnil;
  echo_area_contents = 0;

  Fdiscard_input ();
  bell ();

  errname = Fcar (data);

  if (EQ (errname, Qerror))
    {
      data = Fcdr (data);
      if (!CONSP (data)) data = Qnil;
      errmsg = Fcar (data);
      file_error = Qnil;
    }
  else
    {
      errmsg = Fget (errname, Qerror_message);
      file_error = Fmemq (Qfile_error,
			  Fget (errname, Qerror_conditions));
    }

  /* Print an error message including the data items.
     This is done by printing it into a scratch buffer
     and then making a copy of the text in the buffer. */
  
  if (!CONSP (data)) data = Qnil;
  tail = Fcdr (data);
  GCPRO1 (tail);

  /* For file-error, make error message by concatenating
     all the data items.  They are all strings.  */
  if (!NULL (file_error))
    errmsg = XCONS (tail)->car, tail = XCONS (tail)->cdr;

  if (XTYPE (errmsg) == Lisp_String)
    Fprinc (errmsg, Qt);
  else
    write_string_1 ("peculiar error", -1, Qt);

  for (i = 0; CONSP (tail); tail = Fcdr (tail), i++)
    {
      write_string_1 (i ? ", " : ": ", 2, Qt);
      if (!NULL (file_error))
	Fprinc (Fcar (tail), Qt);
      else
	Fprin1 (Fcar (tail), Qt);
    }
  UNGCPRO;

  /* In -batch mode, force out the error message and newlines after it
     and then die.  */
  if (noninteractive)
    {
      message ("");
      Fkill_emacs (make_number (-1));
    }

  Vquit_flag = Qnil;

  Vinhibit_quit = Qnil;
  return make_number (0);
}

Lisp_Object command_loop_1 ();
Lisp_Object command_loop_2 ();
Lisp_Object cmd_error ();
Lisp_Object top_level_1 ();

/* Entry to editor-command-loop.
   This level has the catches for exiting/returning to editor command loop.
   It returns nil to exit recursive edit, t to abort it.  */

Lisp_Object
command_loop ()
{
  if (command_loop_level > 0 || minibuf_level > 0)
    {
      return internal_catch (Qexit, command_loop_2, Qnil);
    }
  else
    while (1)
      {
	internal_catch (Qtop_level, top_level_1, Qnil);
	internal_catch (Qtop_level, command_loop_2, Qnil);
	/* End of file in -batch run causes exit here.  */
	if (noninteractive)
	  Fkill_emacs (Qt);
      }
}

/* Here we catch errors in execution of commands within the
   editing loop, and reenter the editing loop.
   When there is an error, cmd_error runs and returns a non-nil
   value to us.  A value of nil means that cmd_loop_1 itself
   returned due to end of file (or end of kbd macro).  */

Lisp_Object
command_loop_2 ()
{
  register Lisp_Object val;
  do
    val = internal_condition_case (command_loop_1, Qerror, cmd_error);
  while (!NULL (val));
  return Qnil;
}

Lisp_Object
top_level_2 ()
{
  return Feval (Vtop_level);
}

Lisp_Object
top_level_1 ()
{
  /* On entry to the outer level, run the startup file */
  if (!NULL (Vtop_level))
    internal_condition_case (top_level_2, Qerror, cmd_error);
  else if (!NULL (Vpurify_flag))
    message ("Bare impure Emacs (standard Lisp code not loaded)");
  else
    message ("Bare Emacs (standard Lisp code not loaded)");
  return Qnil;
}

DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
  "Exit all recursive editing levels.")
  ()
{
  Fthrow (Qtop_level, Qnil);
}

DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
  "Exit from the innermost recursive edit or minibuffer.")