xemacs-beta: src/callproc.c comparison

comparison src/callproc.c @ 442:abe6d1db359e r21-2-36

Import from CVS: tag r21-2-36

author	cvs
date	Mon, 13 Aug 2007 11:35:02 +0200
parents	8de8e3f6228a
children	576fb035e263

comparison

equal deleted inserted replaced

-:72a7cfa4a488
+:abe6d1db359e
 #include "sysproc.h"
 #include "sysfile.h" /* Always include after sysproc.h */
 #include "syssignal.h" /* Always include before systty.h */
 #include "systty.h"
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 #define _P_NOWAIT 1	/* from process.h */
 #include "nt.h"
 #endif
-#ifdef DOS_NT
+#ifdef WIN32_NATIVE
 /* When we are starting external processes we need to know whether they
 take binary input (no conversion) or text input (\n is converted to
 \r\n).  Similarly for output: if newlines are written as \r\n then it's
 text process output, otherwise it's binary.  */
 Lisp_Object Vbinary_process_input;
 Lisp_Object Vbinary_process_output;
-#endif /* DOS_NT */
+#endif /* WIN32_NATIVE */
 Lisp_Object Vshell_file_name;
 /* The environment to pass to all subprocesses when they are started.
 This is in the semi-bogus format of ("VAR=VAL" "VAR2=VAL2" ... )
 /* True iff we are about to fork off a synchronous process or if we
 are waiting for it.  */
 volatile int synch_process_alive;
 /* Nonzero => this is a string explaining death of synchronous subprocess.  */
-CONST char *synch_process_death;
+const char *synch_process_death;
 /* If synch_process_death is zero,
 this is exit code of synchronous subprocess.  */
 int synch_process_retcode;
 /* Clean up when exiting Fcall_process_internal.
-On MSDOS, delete the temporary file on any kind of termination.
+On Windows, delete the temporary file on any kind of termination.
 On Unix, kill the process and any children on termination by signal.  */
 /* Nonzero if this is termination due to exit.  */
 static int call_process_exited;
 record_unwind_protect (call_process_kill, fdpid);
 /* #### "c-G" -- need non-consing Single-key-description */
 message ("Waiting for process to die...(type C-g again to kill it instantly)");
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 {
 HANDLE pHandle = OpenProcess (PROCESS_ALL_ACCESS, 0, pid);
 if (pHandle == NULL)
 	warn_when_safe (Qprocess, Qwarning,
 			"cannot open process (PID %d) for cleanup", pid);
 /* terminate this branch of the fork, without closing stdin/out/etc. */
 _exit (1);
 }
 #endif /* unused */
-DEFUN ("call-process-internal", Fcall_process_internal, 1, MANY, 0, /*
+DEFUN ("old-call-process-internal", Fold_call_process_internal, 1, MANY, 0, /*
 Call PROGRAM synchronously in separate process, with coding-system specified.
 Arguments are
 (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS).
 The program's input comes from file INFILE (nil means `/dev/null').
 Insert output in BUFFER before point; t means current buffer;
 {
 /* This function can GC */
 Lisp_Object infile, buffer, current_dir, display, path;
 int fd[2];
 int filefd;
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 HANDLE pHandle;
 #endif
 int pid;
 char buf[16384];
 char *bufptr = buf;
 int bufsize = 16384;
 int speccount = specpdl_depth ();
-struct gcpro gcpro1, gcpro2;
+struct gcpro gcpro1, gcpro2, gcpro3;
 char **new_argv = alloca_array (char *, max (2, nargs - 2));
 /* File to use for stderr in the child.
 t means use same as standard output.  */
 Lisp_Object error_file;
 Fcons (current_buffer->directory, Qnil));
 #endif /* 0 */
 NUNGCPRO;
 }
-GCPRO1 (current_dir);
+GCPRO2 (current_dir, path);
 if (nargs >= 2 && ! NILP (args[1]))
 {
 struct gcpro ngcpro1;
 NGCPRO1 (current_buffer->directory);
 else
 infile = build_string (NULL_DEVICE);
 UNGCPRO;
-GCPRO2 (infile, current_dir);		/* Fexpand_file_name might trash it */
+GCPRO3 (infile, current_dir, path);  	/* Fexpand_file_name might trash it */
 if (nargs >= 3)
 {
 buffer = args[2];
 if (NILP (error_file))
 fd_error = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY);
 else if (STRINGP (error_file))
 {
-	fd_error = open ((CONST char *) XSTRING_DATA (error_file),
+	fd_error = open ((const char *) XSTRING_DATA (error_file),
-#ifdef DOS_NT
+#ifdef WIN32_NATIVE
 			 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
 			 S_IREAD | S_IWRITE
-#else  /* not DOS_NT */
+#else  /* not WIN32_NATIVE */
 			 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
 			 CREAT_MODE
-#endif /* not DOS_NT */
+#endif /* not WIN32_NATIVE */
 			 );
 }
 if (fd_error < 0)
 {
+	int save_errno = errno;
 	close (filefd);
 	close (fd[0]);
 	if (fd1 >= 0)
 	  close (fd1);
+	errno = save_errno;
 	report_file_error ("Cannot open", Fcons(error_file, Qnil));
 }
 fork_error = Qnil;
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 pid = child_setup (filefd, fd1, fd_error, new_argv,
 (char *) XSTRING_DATA (current_dir));
 if (!INTP (buffer))
 {
 	/* OpenProcess() as soon after child_setup as possible.  It's too
 #endif
 }
 /* Close STDERR into the parent process.  We no longer need it. */
 if (fd_error >= 0)
 close (fd_error);
-#else  /* not WINDOWSNT */
+#else  /* not WIN32_NATIVE */
 pid = fork ();
 if (pid == 0)
 {
 	if (fd[0] >= 0)
 		     (char *) XSTRING_DATA (current_dir));
 }
 if (fd_error >= 0)
 close (fd_error);
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_NATIVE */
 environ = save_environ;
 /* Close most of our fd's, but not fd[0]
 since we will use that to read input from.  */
 }
 if (!NILP (fork_error))
 signal_error (Qfile_error, fork_error);
-#ifndef WINDOWSNT
+#ifndef WIN32_NATIVE
 if (pid < 0)
 {
+int save_errno = errno;
 if (fd[0] >= 0)
 	close (fd[0]);
+errno = save_errno;
 report_file_error ("Doing fork", Qnil);
 }
 #endif
 if (INTP (buffer))
 	/* Now NREAD is the total amount of data in the buffer.  */
 	if (nread == 0)
 	  break;
 #if 0
-#ifdef DOS_NT
+#ifdef WIN32_NATIVE
 /* Until we pull out of MULE things like
 	  make_decoding_input_stream(), we do the following which is
 	  less elegant. --marcpa */
 	/* We did. -- kkm */
 {
 Lstream_close (XLSTREAM (instream));
 NUNGCPRO;
 QUIT;
 /* Wait for it to terminate, unless it already has.  */
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 wait_for_termination (pHandle);
 #else
 wait_for_termination (pid);
 #endif
 CURRENT_DIR is an elisp string giving the path of the current
 directory the subprocess should have.  Since we can't really signal
 a decent error from within the child, this should be verified as an
 executable directory by the parent.  */
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 int
 #else
 void
 #endif
 child_setup (int in, int out, int err, char **new_argv,
-	     CONST char *current_dir)
+	     const char *current_dir)
 {
 char **env;
 char *pwd;
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 int cpid;
 HANDLE handles[4];
-#endif /* WINDOWSNT */
+#endif /* WIN32_NATIVE */
 #ifdef SET_EMACS_PRIORITY
 if (emacs_priority != 0)
 nice (- emacs_priority);
 #endif
-#if !defined (NO_SUBPROCESSES) && !defined (WINDOWSNT)
+/* Under Windows, we are not in a child process at all, so we should
+not close handles inherited from the parent -- we are the parent
+and doing so will screw up all manner of things!  Similarly, most
+of the rest of the cleanup done in this function is not done
+under Windows.
+#### This entire child_setup() function is an utter and complete
+piece of shit.  I would rewrite it, at the very least splitting
+out the Windows and non-Windows stuff into two completely
+different functions; but instead I'm trying to make it go away
+entirely, using the Lisp definition in process.el.  What's left
+is to fix up the routines in event-msw.c (and in event-Xt.c and
+event-tty.c) to allow for stream devices to be handled correctly.
+There isn't much to do, in fact, and I'll fix it shortly.  That
+way, the Lisp definition can be used non-interactively too. */
+#if !defined (NO_SUBPROCESSES) && !defined (WIN32_NATIVE)
 /* Close Emacs's descriptors that this process should not have.  */
 close_process_descs ();
 #endif /* not NO_SUBPROCESSES */
+#ifndef WIN32_NATIVE
 close_load_descs ();
+#endif
 /* Note that use of alloca is always safe here.  It's obvious for systems
 that do not have true vfork or that have true (stack) alloca.
 If using vfork and C_ALLOCA it is safe because that changes
 the superior's static variables as if the superior had done alloca
 duplicate: ;
 }
 *new_env = 0;
 }
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 prepare_standard_handles (in, out, err, handles);
 set_process_dir (current_dir);
-#else  /* not WINDOWSNT */
+#else  /* not WIN32_NATIVE */
 /* Make sure that in, out, and err are not actually already in
 descriptors zero, one, or two; this could happen if Emacs is
 started with its standard in, out, or error closed, as might
 happen under X.  */
 in  = relocate_fd (in,  3);
 {
 int fd;
 for (fd=3; fd<=64; fd++)
 close (fd);
 }
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_NATIVE */
 #ifdef vipc
 something missing here;
 #endif /* vipc */
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 /* Spawn the child.  (See ntproc.c:Spawnve).  */
-cpid = spawnve (_P_NOWAIT, new_argv[0], (CONST char* CONST*)new_argv,
+cpid = spawnve (_P_NOWAIT, new_argv[0], (const char* const*)new_argv,
-		  (CONST char* CONST*)env);
+		  (const char* const*)env);
 if (cpid == -1)
 /* An error occurred while trying to spawn the process.  */
 report_file_error ("Spawning child process", Qnil);
 reset_standard_handles (in, out, err, handles);
 return cpid;
-#else /* not WINDOWSNT */
+#else /* not WIN32_NATIVE */
 /* execvp does not accept an environment arg so the only way
 to pass this environment is to set environ.  Our caller
 is responsible for restoring the ambient value of environ.  */
 environ = env;
 execvp (new_argv[0], new_argv);
 stdout_out ("Can't exec program %s\n", new_argv[0]);
 _exit (1);
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_NATIVE */
 }
 static int
-getenv_internal (CONST Bufbyte *var,
+getenv_internal (const Bufbyte *var,
 		 Bytecount varlen,
 		 Bufbyte **value,
 		 Bytecount *valuelen)
 {
 Lisp_Object scan;
 Lisp_Object entry = XCAR (scan);
 if (STRINGP (entry)
 	  && XSTRING_LENGTH (entry) > varlen
 	  && XSTRING_BYTE (entry, varlen) == '='
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
 	  /* NT environment variables are case insensitive.  */
 	  && ! memicmp (XSTRING_DATA (entry), var, varlen)
-#else  /* not WINDOWSNT */
+#else  /* not WIN32_NATIVE */
 	  && ! memcmp (XSTRING_DATA (entry), var, varlen)
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_NATIVE */
 	  )
 	{
 	  *value    = XSTRING_DATA   (entry) + (varlen + 1);
 	  *valuelen = XSTRING_LENGTH (entry) - (varlen + 1);
 	  return 1;
 }
 /* A version of getenv that consults process_environment, easily
 callable from C.  */
 char *
-egetenv (CONST char *var)
+egetenv (const char *var)
 {
+/* This cannot GC -- 7-28-00 ben */
 Bufbyte *value;
 Bytecount valuelen;
-if (getenv_internal ((CONST Bufbyte *) var, strlen (var), &value, &valuelen))
+if (getenv_internal ((const Bufbyte *) var, strlen (var), &value, &valuelen))
 return (char *) value;
 else
 return 0;
 }
 	Fcons (build_ext_string (*envp, Qfile_name), Vprocess_environment);
 }
 {
 /* Initialize shell-file-name from environment variables or best guess. */
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
-CONST char *shell = egetenv ("COMSPEC");
+const char *shell = egetenv ("COMSPEC");
 if (!shell) shell = "\\WINNT\\system32\\cmd.exe";
-#else /* not WINDOWSNT */
+#else /* not WIN32_NATIVE */
-CONST char *shell = egetenv ("SHELL");
+const char *shell = egetenv ("SHELL");
 if (!shell) shell = "/bin/sh";
 #endif
 Vshell_file_name = build_string (shell);
 }
 #endif /* unused */
 void
 syms_of_callproc (void)
 {
-DEFSUBR (Fcall_process_internal);
+DEFSUBR (Fold_call_process_internal);
 DEFSUBR (Fgetenv);
 }
 void
 vars_of_callproc (void)
 {
 /* This function can GC */
-#ifdef DOS_NT
+#ifdef WIN32_NATIVE
 DEFVAR_LISP ("binary-process-input", &Vbinary_process_input /*
 *If non-nil then new subprocesses are assumed to take binary input.
 */ );
 Vbinary_process_input = Qnil;
 DEFVAR_LISP ("binary-process-output", &Vbinary_process_output /*
 *If non-nil then new subprocesses are assumed to produce binary output.
 */ );
 Vbinary_process_output = Qnil;
-#endif /* DOS_NT */
+#endif /* WIN32_NATIVE */
 DEFVAR_LISP ("shell-file-name", &Vshell_file_name /*
 *File name to load inferior shells from.
 Initialized from the SHELL environment variable.
 */ );

Mercurial > hg > xemacs-beta

comparison src/callproc.c @ 442:abe6d1db359e r21-2-36