changeset 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.

--- a/src/process.c	Thu Feb 20 06:53:20 1997 +0000
+++ b/src/process.c	Thu Feb 20 06:53:55 1997 +0000
@@ -98,6 +98,8 @@
 #include "lisp.h"
 #include "window.h"
 #include "buffer.h"
+#include "charset.h"
+#include "coding.h"
 #include "process.h"
 #include "termhooks.h"
 #include "termopts.h"
@@ -246,6 +248,10 @@
 /* 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 ();
@@ -1018,7 +1024,7 @@
  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\
+ 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)
@@ -1148,6 +1154,46 @@
     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);
@@ -1310,6 +1356,10 @@
     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 */
@@ -1821,6 +1871,47 @@
   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;
 }
@@ -2447,28 +2538,41 @@
   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 characters read.
+   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.  */
+   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
-  char *chars;
+  int chars_allocated = 0;	/* If 1, `chars' should be freed later.  */
 #else
-  char chars[1024];
+  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();
@@ -2490,24 +2594,100 @@
       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 (channel, chars, sizeof (chars));
+    nchars = READ_CHILD_OUTPUT (channel, buf + coding->carryover_size,
+				(sizeof buf) - coding->carryover_size);
   else
     {
-      chars[0] = proc_buffered_char[channel];
+      buf[coding->carryover_size] = proc_buffered_char[channel];
       proc_buffered_char[channel] = -1;
-      nchars = read (channel, chars + 1, sizeof (chars) - 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))
     {
@@ -2624,7 +2804,10 @@
 
       /* 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);
+      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++;
@@ -2671,7 +2854,13 @@
 
 /* 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.  */
+   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;
@@ -2682,6 +2871,7 @@
   /* 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);
@@ -2695,6 +2885,62 @@
     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);
@@ -2853,7 +3099,7 @@
     move_gap (start);
 
   start1 = XINT (start);
-  send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start),
+  send_process (proc, POS_ADDR (start1), XINT (end) - XINT (start),
 		Fcurrent_buffer ());
 
   return Qnil;
@@ -3715,6 +3961,44 @@
 
   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.
@@ -3874,6 +4158,8 @@
   defsubr (&Ssignal_process);
   defsubr (&Swaiting_for_user_input_p);
 /*  defsubr (&Sprocess_connection); */
+  defsubr (&Sset_process_coding_system);
+  defsubr (&Sprocess_coding_system);
 }