xemacs-beta: src/process.c comparison

comparison 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

comparison

equal deleted inserted replaced

-:804d1389bcd6
+:131b0175ea99
 #include "lstream.h"
 #include "opaque.h"
 #include "process.h"
 #include "sysdep.h"
 #include "window.h"
+#ifdef MULE
+#include "mule-coding.h"
+#endif
 #include <setjmp.h>
 #include "sysfile.h"
 #include "sysproc.h"
 #include "systime.h"
 Bufbyte eof_char = get_eof_char (p);
 int pty_max_bytes = get_pty_max_bytes (p);
 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
 create_process (Lisp_Object process,
 char **new_argv, CONST char *current_dir)
 close_descriptor_pair (forkin, forkout);
 report_file_error ("Doing vfork", Qnil);
 }
 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
 register_child (pid, inchannel);
 #endif /* WINDOWSNT */
 INCODE and OUTCODE specify the coding-system objects used in input/output
 from/to the process.
 */
 (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;
 #else
 char **new_argv;
 #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 (args[0]);    /* name */
-CHECK_STRING (program);
+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
+We have to GCPRO around this because Fexpand_file_name and
-"caller protects args" GC semantics. */
+Funhandled_file_name_directory might call a file name handling
-current_dir = current_buffer->directory;
+function.  The argument list is protected by the caller, so all
-current_dir = Funhandled_file_name_directory (current_dir);
+we really have to worry about is buffer.  */
-current_dir = expand_and_dir_to_file (current_dir, Qnil);
+{
+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
+if (NILP (Ffile_accessible_directory_p (current_dir)))
-current_buffer through the above calls. */
+report_file_error ("Setting current directory",
-if (NILP (Ffile_accessible_directory_p (current_dir)))
+			 list1 (current_buffer->directory));
-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.  */
 len = XSTRING_LENGTH (program) + 2;
 strcat (new_argv, XSTRING_DATA (tem));
 }
 /* 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);
+tem = Fexpand_file_name (tem, Qnil);
-NUNGCPRO;
+new_argv[0] = (char *) XSTRING_DATA (tem);
 }
 else
 {
 if (!NILP (Ffile_directory_p (program)))
 	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];
 CHECK_STRING (tem);
 new_argv[i - 2] = (char *) XSTRING_DATA (tem);
 itself; it's all taken care of here.  */
 record_unwind_protect (start_process_unwind, proc);
 create_process (proc, new_argv, (char *) XSTRING_DATA (current_dir));
-UNGCPRO;
 return unbind_to (speccount, proc);
 }
 /* connect to an existing file descriptor.  This is very similar to
 static int
 get_internet_address (Lisp_Object host, struct sockaddr_in *address,
 		      Error_behavior errb)
 {
 struct hostent *host_info_ptr;
-#ifdef TRY_AGAIN
-int count = 0;
-#endif
 #ifndef HAVE_TERM
 memset (address, 0, sizeof (*address));
 while (1)
 {
 #ifdef TRY_AGAIN
-if (count++ > 10) break;
 h_errno = 0;
 #endif
 /* Some systems can't handle SIGIO/SIGALARM in gethostbyname. */
 slow_down_interrupts ();
 host_info_ptr = gethostbyname ((char *) XSTRING_DATA (host));
 DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 4, 0, /*
 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
+BUFFER may also be nil, meaning that this process is not associated
-with any buffer
+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.
 */
 (name, buffer, host, service))
 	goto loop;
 if (errno == EADDRINUSE && retry < 20)
 	{
 	  /* A delay here is needed on some FreeBSD systems,
 	     and it is harmless, since this retrying takes time anyway
-	     and should be infrequent.
+	     and should be infrequent.  */
-`sleep-for' allowed for quitting this loop with interrupts
+	  Fsleep_for (make_int (1));
-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);
 	  retry++;
 	  goto loop;
 	}
 close (s);
 MARK_MODELINE_CHANGED;
 /* If the restriction isn't what it should be, set it.  */
 if (old_begv != BUF_BEGV (buf) || old_zv != BUF_ZV (buf))
-	{
+	Fnarrow_to_region (make_int (old_begv), make_int (old_zv),
-	  Fwiden(p->buffer);
+			   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);
-	}
 /* 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;
 }
 #ifdef VMS
 p->tick++;
 process_tick++;
 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));
 UNGCPRO;
 }
 len = bto - bfr;
 send_process (proc, string, 0, bfr, len);
 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                           */
 /************************************************************************/
 reap_exited_processes (void)
 {
 int i;
 struct Lisp_Process *p;
-if (exited_processes_index <= 0)
-return;
 EMACS_BLOCK_SIGNAL (SIGCHLD);
 for (i = 0; i < exited_processes_index; i++)
 {
 int pid = exited_processes[i];
 WAITTYPE w = exited_processes_status[i];
 race conditions with the SIGCHLD_HAPPENED flag). */
 static void
 record_exited_processes (int block_sigchld)
 {
-if (!sigchld_happened)
-return;
 if (block_sigchld)
 EMACS_BLOCK_SIGNAL (SIGCHLD);
 while (sigchld_happened)
 {
 	      Finsert (1, &msg);
 	      current_buffer->read_only = old_read_only;
 	      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;
 	    }
 	}
 int gid;
 int no_pgrp = 0;
 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;
 /* If we are using pgrps, get a pgrp number and make it negative.  */
 DEFSUBR (Fstop_process);
 DEFSUBR (Fcontinue_process);
 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
 vars_of_process (void)
 {

Mercurial > hg > xemacs-beta

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