diff src/process.c @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 56c54cf7c5b6
children 6a378aca36af
line wrap: on
line diff
--- a/src/process.c	Mon Aug 13 09:00:04 2007 +0200
+++ b/src/process.c	Mon Aug 13 09:02:59 2007 +0200
@@ -44,6 +44,9 @@
 #include "process.h"
 #include "sysdep.h"
 #include "window.h"
+#ifdef MULE
+#include "mule-coding.h"
+#endif
 
 #include <setjmp.h>
 #include "sysfile.h"
@@ -785,6 +788,17 @@
       filedesc_stream_set_pty_flushing (XLSTREAM (p->outstream),
 					pty_max_bytes, eof_char);
     }
+#ifdef MULE
+  p->instream = make_decoding_input_stream
+    (XLSTREAM (p->instream),
+     Fget_coding_system (Vprocess_input_coding_system));
+  Lstream_set_character_mode (XLSTREAM (p->instream));
+  p->outstream = make_encoding_output_stream
+    (XLSTREAM (p->outstream),
+     Fget_coding_system (Vprocess_output_coding_system));
+  /* CODE_CNTL (&out_state[outchannel]) |= CC_END; !!####
+     What's going on here? */
+#endif /* MULE */
 }
 
 static void
@@ -1023,8 +1037,6 @@
     }
 
   p->pid = make_int (pid);
-  /* #### dmoore - why is this commented out, otherwise we leave
-     subtty = forkin, but then we close forkin just below. */
   /* p->subtty = -1; */
 
 #ifdef WINDOWSNT
@@ -1096,12 +1108,11 @@
 */
        (int nargs, Lisp_Object *args))
 {
-  /* This function can call lisp */
   /* !!#### This function has not been Mule-ized */
+  /* This function can GC */
   Lisp_Object buffer, name, program, proc, current_dir;
   Lisp_Object tem;
   int speccount = specpdl_depth ();
-  struct gcpro gcpro1, gcpro2, gcpro3;
 #ifdef VMS
   char *new_argv;
   int len;
@@ -1110,39 +1121,44 @@
 #endif
   int i;
 
-  name = args[0];
   buffer = args[1];
-  program = args[2];
-  current_dir = Qnil;
-
-  /* Protect against various file handlers doing GCs below. */
-  GCPRO3 (buffer, program, current_dir);
-
   if (!NILP (buffer))
     buffer = Fget_buffer_create (buffer);
 
-  CHECK_STRING (name);
-  CHECK_STRING (program);
+  CHECK_STRING (args[0]);    /* name */
+  CHECK_STRING (args[2]);    /* program */
 
   /* Make sure that the child will be able to chdir to the current
      buffer's current directory, or its unhandled equivalent.  We
      can't just have the child check for an error when it does the
      chdir, since it's in a vfork.
 
-     Note: these assignments and calls are like this in order to insure
-     "caller protects args" GC semantics. */
-  current_dir = current_buffer->directory;
-  current_dir = Funhandled_file_name_directory (current_dir);
-  current_dir = expand_and_dir_to_file (current_dir, Qnil);
-
+     We have to GCPRO around this because Fexpand_file_name and
+     Funhandled_file_name_directory might call a file name handling
+     function.  The argument list is protected by the caller, so all
+     we really have to worry about is buffer.  */
+  {
+    struct gcpro gcpro1, gcpro2; /* Caller gc-protects args[] */
+
+    current_dir = current_buffer->directory;
+
+    GCPRO2 (buffer, current_dir);
+
+    current_dir = 
+      expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
+			      Qnil);
 #if 0	/* This loser breaks ange-ftp */
-  /* dmoore - if you re-enable this code, you have to gcprotect
-     current_buffer through the above calls. */
-  if (NILP (Ffile_accessible_directory_p (current_dir)))
-    report_file_error ("Setting current directory",
-		       list1 (current_buffer->directory));
+    if (NILP (Ffile_accessible_directory_p (current_dir)))
+      report_file_error ("Setting current directory",
+			 list1 (current_buffer->directory));
 #endif /* 0 */
 
+    UNGCPRO;
+  }
+
+  name = args[0];
+  program = args[2];
+
 #ifdef VMS
   /* Make a one member argv with all args concatenated
      together separated by a blank.  */
@@ -1165,21 +1181,27 @@
   /* Need to add code here to check for program existence on VMS */
 
 #else /* not VMS */
+  new_argv = (char **)
+    alloca ((nargs - 1) * sizeof (char *));
+
+  new_argv[0] = (char *) XSTRING_DATA (program);
+
   /* If program file name is not absolute, search our path for it */
-  if (!IS_DIRECTORY_SEP (XSTRING_BYTE (program, 0))
+  if (!IS_DIRECTORY_SEP (string_byte (XSTRING (program), 0))
       && !(XSTRING_LENGTH (program) > 1
-	  && IS_DEVICE_SEP (XSTRING_BYTE (program, 1))))
+	   && IS_DEVICE_SEP (string_byte (XSTRING (program), 1))))
     {
-      struct gcpro ngcpro1;
-      
+      struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; /* Caller protects args[] */
+      GCPRO4 (buffer, current_dir, name, program);
+
       tem = Qnil;
-      NGCPRO1 (tem);
       locate_file (Vexec_path, program, EXEC_SUFFIXES, &tem,
 		   X_OK);
+      UNGCPRO;
       if (NILP (tem))
 	report_file_error ("Searching for program", list1 (program));
-      program = Fexpand_file_name (tem, Qnil);
-      NUNGCPRO;
+      tem = Fexpand_file_name (tem, Qnil);
+      new_argv[0] = (char *) XSTRING_DATA (tem);
     }
   else
     {
@@ -1187,9 +1209,6 @@
 	error ("Specified program for new process is a directory");
     }
 
-  /* Nothing below here GCs so our string pointers shouldn't move. */
-  new_argv = (char **) alloca ((nargs - 1) * sizeof (char *));
-  new_argv[0] = (char *) XSTRING_DATA (program);
   for (i = 3; i < nargs; i++)
     {
       tem = args[i];
@@ -1219,7 +1238,6 @@
 
   create_process (proc, new_argv, (char *) XSTRING_DATA (current_dir));
 
-  UNGCPRO;
   return unbind_to (speccount, proc);
 }
 
@@ -1285,9 +1303,6 @@
 		      Error_behavior errb)
 {
   struct hostent *host_info_ptr;
-#ifdef TRY_AGAIN
-  int count = 0;
-#endif
 
 #ifndef HAVE_TERM
   memset (address, 0, sizeof (*address));
@@ -1295,7 +1310,6 @@
   while (1)
     {
 #ifdef TRY_AGAIN
-      if (count++ > 10) break;
       h_errno = 0;
 #endif
       /* Some systems can't handle SIGIO/SIGALARM in gethostbyname. */
@@ -1345,13 +1359,13 @@
 Open a TCP connection for a service to a host.
 Returns a subprocess-object to represent the connection.
 Input and output work as for subprocesses; `delete-process' closes it.
-Args are NAME BUFFER HOST SERVICE.
+
 NAME is name for process.  It is modified if necessary to make it unique.
 BUFFER is the buffer (or buffer-name) to associate with the process.
  Process output goes at end of that buffer, unless you specify
  an output stream or filter function to handle the output.
- BUFFER may be also nil, meaning that this process is not associated
- with any buffer
+ BUFFER may also be nil, meaning that this process is not associated
+ with any buffer.
 Third arg is name of the host to connect to, or its IP address.
 Fourth arg SERVICE is name of the service desired, or an integer
  specifying a port number to connect to.
@@ -1442,11 +1456,8 @@
 	{
 	  /* A delay here is needed on some FreeBSD systems,
 	     and it is harmless, since this retrying takes time anyway
-	     and should be infrequent.
-             `sleep-for' allowed for quitting this loop with interrupts
-             slowed down so it can't be used here.  Async timers should
-             already be disabled at this point so we can use `sleep'. */
-          sleep (1);
+	     and should be infrequent.  */
+	  Fsleep_for (make_int (1));
 	  retry++;
 	  goto loop;
 	}
@@ -1722,24 +1733,12 @@
 
       /* If the restriction isn't what it should be, set it.  */
       if (old_begv != BUF_BEGV (buf) || old_zv != BUF_ZV (buf))
-	{
-	  Fwiden(p->buffer);
-	  old_begv = bufpos_clip_to_bounds (BUF_BEG (buf),
-					    old_begv,
-					    BUF_Z (buf));
-	  old_zv = bufpos_clip_to_bounds (BUF_BEG (buf),
-					  old_zv,
-					  BUF_Z (buf));
-	  Fnarrow_to_region (make_int (old_begv), make_int (old_zv),
-			     p->buffer);
-	}
+	Fnarrow_to_region (make_int (old_begv), make_int (old_zv),
+			   p->buffer);
 
       /* Handling the process output should not deactivate the mark.  */
       zmacs_region_stays = old_zmacs_region_stays;
       buf->read_only = old_read_only;
-      old_point = bufpos_clip_to_bounds (BUF_BEGV (buf),
-					 old_point,
-					 BUF_ZV (buf));
       BUF_SET_PT (buf, old_point);
 
       UNGCPRO;
@@ -1869,10 +1868,10 @@
       deactivate_process (proc);
 #ifdef VMS
       error ("Error writing to process %s; closed it",
-	    XSTRING_DATA (p->name));
+	     XSTRING_DATA (p->name));
 #else
       error ("SIGPIPE raised on process %s; closed it",
-	    XSTRING_DATA (p->name));
+	     XSTRING_DATA (p->name));
 #endif
     }
   Lstream_flush (XLSTREAM (p->outstream));
@@ -2010,6 +2009,53 @@
   return (Qnil);
 }
 
+#ifdef MULE
+
+DEFUN ("process-input-coding-system", Fprocess_input_coding_system, 1, 1, 0, /*
+Return PROCESS's input coding system.
+*/
+       (process))
+{
+  process = get_process (process);
+  return decoding_stream_coding_system (XLSTREAM ( XPROCESS (process)->instream) );
+}
+
+DEFUN ("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0, /*
+Return PROCESS's output coding system.
+*/
+       (process))
+{
+  process = get_process (process);
+  return encoding_stream_coding_system (XLSTREAM (XPROCESS (process)->outstream));
+}
+
+DEFUN ("set-process-input-coding-system",
+       Fset_process_input_coding_system, 2, 2, 0, /*
+Set PROCESS's input coding system to CODESYS.
+*/
+       (process, codesys))
+{
+  codesys = Fget_coding_system (codesys);
+  process = get_process (process);
+  set_decoding_stream_coding_system ( XLSTREAM ( XPROCESS (process)->instream ), codesys);
+  return Qnil;
+}
+
+DEFUN ("set-process-output-coding-system",
+       Fset_process_output_coding_system, 2, 2, 0, /*
+Set PROCESS's output coding system to CODESYS.
+*/
+       (process, codesys))
+{
+  codesys = Fget_coding_system (codesys);
+  process = get_process (process);
+  set_encoding_stream_coding_system
+    ( XLSTREAM ( XPROCESS (process)->outstream), codesys);
+  return Qnil;
+}
+
+#endif /* MULE */
+
 
 /************************************************************************/
 /*                             process status                           */
@@ -2160,8 +2206,6 @@
   int i;
   struct Lisp_Process *p;
 
-  if (exited_processes_index <= 0)
-      return;
   EMACS_BLOCK_SIGNAL (SIGCHLD);
   for (i = 0; i < exited_processes_index; i++)
     {
@@ -2242,8 +2286,6 @@
 static void
 record_exited_processes (int block_sigchld)
 {
-  if (!sigchld_happened)
-      return;
   if (block_sigchld)
     EMACS_BLOCK_SIGNAL (SIGCHLD);
 
@@ -2514,9 +2556,6 @@
 	      Fset_marker (p->mark, make_int (BUF_PT (current_buffer)),
 			   p->buffer);
 
-	      opoint = bufpos_clip_to_bounds(BUF_BEGV (XBUFFER (p->buffer)),
-					     opoint,
-					     BUF_ZV (XBUFFER (p->buffer)));
 	      BUF_SET_PT (current_buffer, opoint);
 	      Fset_buffer (old);
               NUNGCPRO;
@@ -2681,10 +2720,10 @@
 
   if (network_connection_p (proc))
     error ("Network connection %s is not a subprocess",
-	  XSTRING_DATA (p->name));
+	   XSTRING_DATA (p->name));
   if (p->infd < 0)
     error ("Process %s is not active",
-	  XSTRING_DATA (p->name));
+	   XSTRING_DATA (p->name));
 
   if (!p->pty_flag)
     current_group = 0;
@@ -3284,6 +3323,12 @@
   DEFSUBR (Fprocess_send_eof);
   DEFSUBR (Fsignal_process);
 /*  DEFSUBR (Fprocess_connection); */
+#ifdef MULE
+  DEFSUBR (Fprocess_input_coding_system);
+  DEFSUBR (Fprocess_output_coding_system);
+  DEFSUBR (Fset_process_input_coding_system);
+  DEFSUBR (Fset_process_output_coding_system);
+#endif /* MULE */
 }
 
 void