comparison src/process.c @ 17041:b61cbe595be5

Include charset.h and coding.h. (proc_decode_coding_system, proc_encode_coding_system): New variables. (Fstart_process, create_process, Fopen_network_stream): Setup coding systems for character code conversion. (READ_CHILD_OUTPUT): New macro. (read_process_output): Perform character code conversion of a process output. (send_process): Perform character code conversion of a text sent to a process. (Fset_process_coding_system, Fprocess_coding_system): New functions. (syms_of_process): Handle them.

17040:74d21e4a28f9

#include "systty.h"

#include "lisp.h"
#include "window.h"
#include "buffer.h"
#include "process.h"
#include "termhooks.h"
#include "termopts.h"
#include "commands.h"
#include "frame.h"

   Always -1 on systems that support FIONREAD.  */

/* Don't make static; need to access externally.  */
int proc_buffered_char[MAXDESC];

static Lisp_Object get_process ();

extern EMACS_TIME timer_check ();
extern int timers_run;

NAME is name for process.  It is modified if necessary to make it unique.\n\
BUFFER is the buffer or (buffer-name) to associate with the process.\n\
 Process output goes at end of that buffer, unless you specify\n\
 an output stream or filter function to handle the output.\n\
 BUFFER may be also nil, meaning that this process is not associated\n\
 with any buffer\n\
Third arg is program file name.  It is searched for as in the shell.\n\
Remaining arguments are strings to give program as arguments.")
  (nargs, args)
     int nargs;
     register Lisp_Object *args;

  /* Make the process marker point into the process buffer (if any).  */
  if (!NILP (buffer))
    Fset_marker (XPROCESS (proc)->mark,
		 make_number (BUF_ZV (XBUFFER (buffer))), buffer);

  create_process (proc, new_argv, current_dir);

  return unbind_to (count, proc);
}

    XPROCESS (process)->subtty = Qnil;
  else
    XSETFASTINT (XPROCESS (process)->subtty, forkin);
  XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
  XPROCESS (process)->status = Qrun;

  /* Delay interrupts until we have a chance to store
     the new fork's pid in its process structure */
#ifdef POSIX_SIGNALS
  sigemptyset (&blocked);

  XPROCESS (proc)->status = Qrun;
  FD_SET (inch, &input_wait_mask);
  FD_SET (inch, &non_keyboard_wait_mask);
  if (inch > max_process_desc)
    max_process_desc = inch;

  UNGCPRO;
  return proc;
}
#endif	/* HAVE_SOCKETS */

  Vinhibit_quit = Qt;
  update_echo_area ();
  Fsleep_for (make_number (2), Qnil);
}

/* Read pending output from the process channel,
   starting with our buffered-ahead character if we have one.
   Yield number of characters read.

   This function reads at most 1024 characters.
   If you want to read all available subprocess output,
   you must call it repeatedly until it returns zero.  */

read_process_output (proc, channel)
     Lisp_Object proc;
     register int channel;
{
  register int nchars;
#ifdef VMS
  char *chars;
#else
  char chars[1024];
#endif
  register Lisp_Object outstream;
  register struct buffer *old = current_buffer;
  register struct Lisp_Process *p = XPROCESS (proc);
  register int opoint;

#ifdef VMS
  VMS_PROC_STUFF *vs, *get_vms_process_pointer();

  vs = get_vms_process_pointer (p->pid);

  if (nchars <= 0)
    {
      start_vms_process_read (vs); /* Crank up the next read on the process */
      return 1;			/* Nothing worth printing, say we got 1 */
    }
#else /* not VMS */

  if (proc_buffered_char[channel] < 0)
    nchars = read (channel, chars, sizeof (chars));
  else
    {
      chars[0] = proc_buffered_char[channel];
      proc_buffered_char[channel] = -1;
      nchars = read (channel, chars + 1, sizeof (chars) - 1);
      if (nchars < 0)
	nchars = 1;
      else
	nchars = nchars + 1;
    }
#endif /* not VMS */

  if (nchars <= 0) return nchars;

  outstream = p->filter;
  if (!NILP (outstream))
    {
      /* We inhibit quit here instead of just catching it so that 

      if (PT <= XFASTINT (old_zv))
	XSETFASTINT (old_zv, XFASTINT (old_zv) + nchars);

      /* Insert before markers in case we are inserting where
	 the buffer's mark is, and the user's next command is Meta-y.  */
      insert_before_markers (chars, nchars);
      Fset_marker (p->mark, make_number (PT), p->buffer);

      update_mode_lines++;

      /* If the restriction isn't what it should be, set it.  */

  longjmp (send_process_frame, 1);
}

/* Send some data to process PROC.
   BUF is the beginning of the data; LEN is the number of characters.
   OBJECT is the Lisp object that the data comes from.  */

send_process (proc, buf, len, object)
     volatile Lisp_Object proc;
     char *buf;
     int len;
     Lisp_Object object;
{
  /* Use volatile to protect variables from being clobbered by longjmp.  */
  int rv;
  volatile unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
  struct gcpro gcpro1;

  GCPRO1 (object);

#ifdef VMS

  if (! NILP (XPROCESS (proc)->raw_status_low))
    update_status (XPROCESS (proc));
  if (! EQ (XPROCESS (proc)->status, Qrun))
    error ("Process %s not running", procname);

#ifdef VMS
  vs = get_vms_process_pointer (p->pid);
  if (vs == 0)
    error ("Could not find this process: %x", p->pid);

  if (XINT (start) < GPT && XINT (end) > GPT)
    move_gap (start);

  start1 = XINT (start);
  send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start),
		Fcurrent_buffer ());

  return Qnil;
}

  update_mode_lines++;  /* in case buffers use %s in mode-line-format */
  redisplay_preserve_echo_area ();

  UNGCPRO;
}

/* The first time this is called, assume keyboard input comes from DESC
   instead of from where we used to expect it.
   Subsequent calls mean assume input keyboard can come from DESC

  defsubr (&Scontinue_process);
  defsubr (&Sprocess_send_eof);
  defsubr (&Ssignal_process);
  defsubr (&Swaiting_for_user_input_p);
/*  defsubr (&Sprocess_connection); */
}


#else /* not subprocesses */

17041:b61cbe595be5

#include "systty.h"

#include "lisp.h"
#include "window.h"
#include "buffer.h"
#include "charset.h"
#include "coding.h"
#include "process.h"
#include "termhooks.h"
#include "termopts.h"
#include "commands.h"
#include "frame.h"

   Always -1 on systems that support FIONREAD.  */

/* Don't make static; need to access externally.  */
int proc_buffered_char[MAXDESC];

/* Table of `struct coding-system' for each process.  */
static struct coding_system proc_decode_coding_system[MAXDESC];
static struct coding_system proc_encode_coding_system[MAXDESC];

static Lisp_Object get_process ();

extern EMACS_TIME timer_check ();
extern int timers_run;

NAME is name for process.  It is modified if necessary to make it unique.\n\
BUFFER is the buffer or (buffer-name) to associate with the process.\n\
 Process output goes at end of that buffer, unless you specify\n\
 an output stream or filter function to handle the output.\n\
 BUFFER may be also nil, meaning that this process is not associated\n\
 with any buffer.\n\
Third arg is program file name.  It is searched for as in the shell.\n\
Remaining arguments are strings to give program as arguments.")
  (nargs, args)
     int nargs;
     register Lisp_Object *args;

  /* Make the process marker point into the process buffer (if any).  */
  if (!NILP (buffer))
    Fset_marker (XPROCESS (proc)->mark,
		 make_number (BUF_ZV (XBUFFER (buffer))), buffer);

  /* Setup coding systems for communicating with the process.  */
  {
    /* Qt denotes that we have not yet called Ffind_coding_system.  */
    Lisp_Object coding_systems = Qt;
    Lisp_Object val, *args2;
    struct gcpro gcpro1;

    if (NILP (val = Vcoding_system_for_read))
      {
	args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
	args2[0] = Qstart_process;
	for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
	GCPRO1 (proc);
	coding_systems = Ffind_coding_system (nargs + 1, args2);
	UNGCPRO;
	if (CONSP (coding_systems))
	  val = XCONS (coding_systems)->car;
      }
    XPROCESS (proc)->decode_coding_system = val;

    if (NILP (val = Vcoding_system_for_write))
      {
	if (EQ (coding_systems, Qt))
	  {
	    args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof args2);
	    args2[0] = Qstart_process;
	    for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
	    GCPRO1 (proc);
	    coding_systems = Ffind_coding_system (nargs + 1, args2);
	    UNGCPRO;
	  }
	if (CONSP (coding_systems))
	  val = XCONS (coding_systems)->cdr;
      }
    XPROCESS (proc)->encode_coding_system = val;
  }

  XPROCESS (proc)->decoding_buf = make_uninit_string (0);
  XPROCESS (proc)->encoding_buf = make_uninit_string (0);

  create_process (proc, new_argv, current_dir);

  return unbind_to (count, proc);
}

    XPROCESS (process)->subtty = Qnil;
  else
    XSETFASTINT (XPROCESS (process)->subtty, forkin);
  XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
  XPROCESS (process)->status = Qrun;
  setup_coding_system (XPROCESS (process)->decode_coding_system,
		       &proc_decode_coding_system[inchannel]);
  setup_coding_system (XPROCESS (process)->encode_coding_system,
		       &proc_encode_coding_system[outchannel]);

  /* Delay interrupts until we have a chance to store
     the new fork's pid in its process structure */
#ifdef POSIX_SIGNALS
  sigemptyset (&blocked);

  XPROCESS (proc)->status = Qrun;
  FD_SET (inch, &input_wait_mask);
  FD_SET (inch, &non_keyboard_wait_mask);
  if (inch > max_process_desc)
    max_process_desc = inch;

  /* Setup coding systems for communicating with the network stream.  */
  {
    struct gcpro gcpro1;
    /* Qt denotes that we have not yet called Ffind_coding_system.  */
    Lisp_Object coding_systems = Qt;
    Lisp_Object args[5], val;

    if (NILP (val = Vcoding_system_for_read))
      {
	args[0] = Qopen_network_stream, args[1] = name,
	  args[2] = buffer, args[3] = host, args[4] = service;
	GCPRO1 (proc);
	coding_systems = Ffind_coding_system (5, args);
	UNGCPRO;
	val = (CONSP (coding_systems) ? XCONS (coding_systems)->car : Qnil);
      }
    XPROCESS (proc)->decode_coding_system = val;

    if (NILP (val = Vcoding_system_for_write))
      {
	if (EQ (coding_systems, Qt))
	  {
	    args[0] = Qopen_network_stream, args[1] = name,
	      args[2] = buffer, args[3] = host, args[4] = service;
	    GCPRO1 (proc);
	    coding_systems = Ffind_coding_system (5, args);
	    UNGCPRO;
	  }
	val = (CONSP (coding_systems) ? XCONS (coding_systems)->cdr : Qnil);
      }
    XPROCESS (proc)->encode_coding_system = val;
  }

  setup_coding_system (XPROCESS (proc)->decode_coding_system,
		       &proc_decode_coding_system[inch]);
  setup_coding_system (XPROCESS (proc)->encode_coding_system,
		       &proc_encode_coding_system[outch]);

  XPROCESS (proc)->decoding_buf = make_uninit_string (0);
  XPROCESS (proc)->encoding_buf = make_uninit_string (0);

  UNGCPRO;
  return proc;
}
#endif	/* HAVE_SOCKETS */

  Vinhibit_quit = Qt;
  update_echo_area ();
  Fsleep_for (make_number (2), Qnil);
}

#ifdef WINDOWSNT
#define READ_CHILD_OUTPUT read_child_output
#else
#define READ_CHILD_OUTPUT read
#endif

/* Read pending output from the process channel,
   starting with our buffered-ahead character if we have one.
   Yield number of decoded characters read.

   This function reads at most 1024 characters.
   If you want to read all available subprocess output,
   you must call it repeatedly until it returns zero.

   The characters read are decoded according to PROC's coding-system
   for decoding.  */

read_process_output (proc, channel)
     Lisp_Object proc;
     register int channel;
{
  register int nchars;
  char *chars;
#ifdef VMS
  int chars_allocated = 0;	/* If 1, `chars' should be freed later.  */
#else
  char buf[1024];
#endif
  register Lisp_Object outstream;
  register struct buffer *old = current_buffer;
  register struct Lisp_Process *p = XPROCESS (proc);
  register int opoint;
  struct coding_system *coding = &proc_decode_coding_system[channel];
  int chars_in_decoding_buf = 0; /* If 1, `chars' points
				    XSTRING (p->decoding_buf)->data.  */

#ifdef VMS
  VMS_PROC_STUFF *vs, *get_vms_process_pointer();

  vs = get_vms_process_pointer (p->pid);

  if (nchars <= 0)
    {
      start_vms_process_read (vs); /* Crank up the next read on the process */
      return 1;			/* Nothing worth printing, say we got 1 */
    }
  if (coding->carryover_size)
    {
      /* The data carried over in the previous decoding should be
         prepended to the new data read to decode all together.  */
      char *buf = (char *) xmalloc (nchars + coding->carryover_size);

      bcopy (coding->carryover, buf, coding->carryover_size);
      bcopy (chars, buf + coding->carryover_size, nchars);
      chars = buf;
      chars_allocated = 1;
    }
#else /* not VMS */

  if (coding->carryover_size)
    /* The data carried over in the previous decoding should be
       prepended to the new data read to decode all together.  */
    bcopy (coding->carryover, buf, coding->carryover_size);

  if (proc_buffered_char[channel] < 0)
    nchars = READ_CHILD_OUTPUT (channel, buf + coding->carryover_size,
				(sizeof buf) - coding->carryover_size);
  else
    {
      buf[coding->carryover_size] = proc_buffered_char[channel];
      proc_buffered_char[channel] = -1;
      nchars = READ_CHILD_OUTPUT (channel, buf + coding->carryover_size + 1,
				    (sizeof buf) - coding->carryover_size - 1);
      if (nchars < 0)
	nchars = 1;
      else
	nchars = nchars + 1;
    }
  chars = buf;
#endif /* not VMS */

  /* At this point, NCHARS holds number of characters just received
     (including the one in proc_buffered_char[channel]).  */
  if (nchars <= 0) return nchars;

  /* Now set NCHARS how many bytes we must decode.  */
  nchars += coding->carryover_size;

  if (CODING_REQUIRE_CONVERSION (coding))
    {
      int require = decoding_buffer_size (coding, nchars);
      int consumed, produced;
      
      if (XSTRING (p->decoding_buf)->size < require)
	p->decoding_buf = make_uninit_string (require);
      produced = decode_coding (coding, chars, XSTRING (p->decoding_buf)->data,
				nchars, XSTRING (p->decoding_buf)->size,
				&consumed);

      /* New coding-system might be found by `decode_coding'.  */
      if (!EQ (p->decode_coding_system, coding->symbol))
	{
	  p->decode_coding_system = coding->symbol;
	  setup_coding_system (coding->symbol,
			       &proc_decode_coding_system[channel]);
	  /* If coding-system for encoding is not yet decided, we set it
	     as the same as coding-system for decoding.  */
	  if (NILP (p->encode_coding_system))
	    {
	      p->encode_coding_system = coding->symbol;
	      setup_coding_system (coding->symbol,
				   &proc_encode_coding_system[channel]);
	    }
	}
#ifdef VMS
      /*  Now we don't need the contents of `chars'.  */
      if (chars_allocated)
	free (chars);
#endif
      if (produced == 0)
	return 0;
      chars = XSTRING (p->decoding_buf)->data;
      nchars = produced;
      chars_in_decoding_buf = 1;
    }
#ifdef VMS
  else if (chars_allocated)
    {
      /* Although we don't have to decode the received data, we must
         move it to an area which we don't have to free.  */
      if (! STRINGP (p->decoding_buf)
	  || XSTRING (p->decoding_buf)->size < nchars)
	p->decoding_buf = make_uninit_string (nchars);
      bcopy (chars, XSTRING (p->decoding_buf)->data, nchars);
      free (chars);
      chars = XSTRING (p->decoding_buf)->data;
      chars_in_decoding_buf = 1;
    }
#endif

  outstream = p->filter;
  if (!NILP (outstream))
    {
      /* We inhibit quit here instead of just catching it so that 

      if (PT <= XFASTINT (old_zv))
	XSETFASTINT (old_zv, XFASTINT (old_zv) + nchars);

      /* Insert before markers in case we are inserting where
	 the buffer's mark is, and the user's next command is Meta-y.  */
      if (chars_in_decoding_buf)
	insert_from_string_before_markers (p->decoding_buf, 0, nchars, 0);
      else
	insert_before_markers (chars, nchars);
      Fset_marker (p->mark, make_number (PT), p->buffer);

      update_mode_lines++;

      /* If the restriction isn't what it should be, set it.  */

  longjmp (send_process_frame, 1);
}

/* Send some data to process PROC.
   BUF is the beginning of the data; LEN is the number of characters.
   OBJECT is the Lisp object that the data comes from.

   The data is encoded by PROC's coding-system for encoding before it
   is sent.  But if the data ends at the middle of multi-byte
   representation, that incomplete sequence of bytes are sent without
   being encoded.  Should we store them in a buffer to prepend them to
   the data send later?  */

send_process (proc, buf, len, object)
     volatile Lisp_Object proc;
     char *buf;
     int len;
     Lisp_Object object;
{
  /* Use volatile to protect variables from being clobbered by longjmp.  */
  int rv;
  volatile unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
  struct coding_system *coding;
  struct gcpro gcpro1;

  GCPRO1 (object);

#ifdef VMS

  if (! NILP (XPROCESS (proc)->raw_status_low))
    update_status (XPROCESS (proc));
  if (! EQ (XPROCESS (proc)->status, Qrun))
    error ("Process %s not running", procname);
  if (XINT (XPROCESS (proc)->outfd) < 0)
    error ("Output file descriptor of %s is closed", procname);

  coding = &proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
  if (CODING_REQUIRE_CONVERSION (coding))
    {
      int require = encoding_buffer_size (coding, len);
      int offset, dummy;
      char *temp_buf = NULL;

      /* Remember the offset of data because a string or a buffer may
         be relocated.  Setting OFFSET to -1 means we don't have to
         care relocation.  */
      offset = (BUFFERP (object)
		? BUF_PTR_CHAR_POS (XBUFFER (object), (unsigned char *) buf)
		: (STRINGP (object)
		   ? offset = buf - (char *) XSTRING (object)->data
		   : -1));

      if (coding->carryover_size > 0)
	{
	  temp_buf = (char *) xmalloc (len + coding->carryover_size);

	  if (offset >= 0)
	    {
	      if (BUFFERP (object))
		buf = (char *) BUF_CHAR_ADDRESS (XBUFFER (object), offset);
	      else if (STRINGP (object))
		buf = offset + (char *) XSTRING (object)->data;
	      /* Now we don't have to care relocation.  */
	      offset = -1;
	    }
	  bcopy (coding->carryover, temp_buf, coding->carryover_size);
	  bcopy (buf, temp_buf + coding->carryover_size, len);
	  buf = temp_buf;
	}

      if (XSTRING (XPROCESS (proc)->encoding_buf)->size < require)
	{
	  XPROCESS (proc)->encoding_buf = make_uninit_string (require);

	  if (offset >= 0)
	    {
	      if (BUFFERP (object))
		buf = (char *) BUF_CHAR_ADDRESS (XBUFFER (object), offset);
	      else if (STRINGP (object))
		buf = offset + (char *) XSTRING (object)->data;
	    }
	}
      object = XPROCESS (proc)->encoding_buf;
      len = encode_coding (coding, buf, XSTRING (object)->data,
			   len, XSTRING (object)->size, &dummy);
      buf = XSTRING (object)->data;
      if (temp_buf)
	xfree (temp_buf);
    }

#ifdef VMS
  vs = get_vms_process_pointer (p->pid);
  if (vs == 0)
    error ("Could not find this process: %x", p->pid);

  if (XINT (start) < GPT && XINT (end) > GPT)
    move_gap (start);

  start1 = XINT (start);
  send_process (proc, POS_ADDR (start1), XINT (end) - XINT (start),
		Fcurrent_buffer ());

  return Qnil;
}

  update_mode_lines++;  /* in case buffers use %s in mode-line-format */
  redisplay_preserve_echo_area ();

  UNGCPRO;
}


DEFUN ("set-process-coding-system", Fset_process_coding_system,
       Sset_process_coding_system, 1, 3, 0,
  "Set coding-systems of PROCESS to DECODING (input from the process) and\n\
ENCODING (output to the process).")
  (proc, decoding, encoding)
     register Lisp_Object proc, decoding, encoding;
{
  register struct Lisp_Process *p;

  CHECK_PROCESS (proc, 0);
  p = XPROCESS (proc);
  if (XINT (p->infd) < 0)
    error ("Input file descriptor of %s closed", XSTRING (p->name)->data);
  if (XINT (p->outfd) < 0)
    error ("Output file descriptor of %s closed", XSTRING (p->name)->data);

  p->decode_coding_system = Fcheck_coding_system (decoding);
  p->encode_coding_system = Fcheck_coding_system (encoding);
  setup_coding_system (decoding,
		       &proc_decode_coding_system[XINT (p->infd)]);
  setup_coding_system (encoding,
		       &proc_encode_coding_system[XINT (p->outfd)]);

  return Qnil;
}

DEFUN ("process-coding-system",
       Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
  "Return a cons of coding-system for decoding and encoding of PROCESS.")
  (proc)
     register Lisp_Object proc;
{
  CHECK_PROCESS (proc, 0);
  return Fcons (XPROCESS (proc)->decode_coding_system,
		XPROCESS (proc)->encode_coding_system);
}

/* The first time this is called, assume keyboard input comes from DESC
   instead of from where we used to expect it.
   Subsequent calls mean assume input keyboard can come from DESC

  defsubr (&Scontinue_process);
  defsubr (&Sprocess_send_eof);
  defsubr (&Ssignal_process);
  defsubr (&Swaiting_for_user_input_p);
/*  defsubr (&Sprocess_connection); */
  defsubr (&Sset_process_coding_system);
  defsubr (&Sprocess_coding_system);
}


#else /* not subprocesses */