xemacs-beta: src/callproc.c comparison

comparison src/callproc.c @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29

author	cvs
date	Mon, 13 Aug 2007 11:13:30 +0200
parents	4af0ddfb7c5b
children	b8cc9ab3f761

comparison

equal deleted inserted replaced

-:f4aeb21a5bad
+:74fd4e045ea6
 #include "syssignal.h" /* Always include before systty.h */
 #include "systty.h"
 #ifdef WINDOWSNT
 #define _P_NOWAIT 1	/* from process.h */
-#include <windows.h>
 #include "nt.h"
 #endif
 #ifdef DOS_NT
 /* When we are starting external processes we need to know whether they
 /* 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;
 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;
+Lisp_Object Vlisp_EXEC_SUFFIXES;
 static Lisp_Object
 call_process_kill (Lisp_Object fdpid)
 {
 Lisp_Object fd = Fcar (fdpid);
 }
 static Lisp_Object
 call_process_cleanup (Lisp_Object fdpid)
 {
-int fd = XINT (Fcar (fdpid));
+int fd  = XINT (Fcar (fdpid));
 int pid = XINT (Fcdr (fdpid));
 if (!call_process_exited &&
 EMACS_KILLPG (pid, SIGINT) == 0)
 {
 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
+{
+HANDLE pHandle = OpenProcess (PROCESS_ALL_ACCESS, 0, pid);
+if (pHandle == NULL)
+	warn_when_safe (Qprocess, Qwarning,
+			"cannot open process (PID %d) for cleanup", pid);
+else
+	wait_for_termination (pHandle);
+}
+#else
 wait_for_termination (pid);
+#endif
 /* "Discard" the unwind protect.  */
 XCAR (fdpid) = Qnil;
 XCDR (fdpid) = Qnil;
 unbind_to (speccount, Qnil);
 {
 /* This function can GC */
 Lisp_Object infile, buffer, current_dir, display, path;
 int fd[2];
 int filefd;
+#ifdef WINDOWSNT
+HANDLE pHandle;
+#endif
 int pid;
 char buf[16384];
 char *bufptr = buf;
 int bufsize = 16384;
 int speccount = specpdl_depth ();
 error ("Operating system cannot handle asynchronous subprocesses");
 #endif /* NO_SUBPROCESSES */
 /* Do this before building new_argv because GC in Lisp code
 *  called by various filename-hacking routines might relocate strings */
-locate_file (Vexec_path, args[0], EXEC_SUFFIXES, &path, X_OK);
+locate_file (Vexec_path, args[0], Vlisp_EXEC_SUFFIXES, &path, X_OK);
 /* 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. */
 for (i = 4; i < nargs; i++)
 {
 	CHECK_STRING (args[i]);
 	new_argv[i - 3] = (char *) XSTRING_DATA (args[i]);
 }
-new_argv[nargs - 3] = 0;
 }
+new_argv[max(nargs - 3,1)] = 0;
 if (NILP (path))
 report_file_error ("Searching for program", Fcons (args[0], Qnil));
 new_argv[0] = (char *) XSTRING_DATA (path);
 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
 			 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
 			 S_IREAD | S_IWRITE
 #else  /* not DOS_NT */
 			 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
 fork_error = Qnil;
 #ifdef WINDOWSNT
 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
+	   late once the process terminated. */
+	pHandle = OpenProcess(PROCESS_ALL_ACCESS, 0, pid);
+#if 0
+	if (pHandle == NULL)
+	  {
+	    /* #### seems to cause crash in unbind_to(...) below. APA */
+	    warn_when_safe (Qprocess, Qwarning,
+			    "cannot open process to wait for");
+	  }
+#endif
+}
+/* Close STDERR into the parent process.  We no longer need it. */
+if (fd_error >= 0)
+close (fd_error);
 #else  /* not WINDOWSNT */
 pid = fork ();
 if (pid == 0)
 {
 }
 if (!NILP (fork_error))
 signal_error (Qfile_error, fork_error);
+#ifndef WINDOWSNT
 if (pid < 0)
 {
 if (fd[0] >= 0)
 	close (fd[0]);
 report_file_error ("Doing fork", Qnil);
 }
+#endif
 if (INTP (buffer))
 {
 if (fd[0] >= 0)
 	close (fd[0]);
 	   less than 1024--save that for the next bufferfull.  */
 	nread = 0;
 	while (nread < bufsize - 1024)
 	  {
-	    int this_read
+	    ssize_t this_read
 	      = Lstream_read (XLSTREAM (instream), bufptr + nread,
 			      bufsize - nread);
 	    if (this_read < 0)
 	      goto give_up;
 	/* Now NREAD is the total amount of data in the buffer.  */
 	if (nread == 0)
 	  break;
+#if 0
 #ifdef DOS_NT
 /* Until we pull out of MULE things like
 	  make_decoding_input_stream(), we do the following which is
 	  less elegant. --marcpa */
+	/* We did. -- kkm */
 {
 	 int lf_count = 0;
 	 if (NILP (Vbinary_process_output)) {
 	   nread = crlf_to_lf(nread, bufptr, &lf_count);
 }
 }
+#endif
 #endif
 	total_read += nread;
 	if (!NILP (buffer))
 Lstream_close (XLSTREAM (instream));
 NUNGCPRO;
 QUIT;
 /* Wait for it to terminate, unless it already has.  */
+#ifdef WINDOWSNT
+wait_for_termination (pHandle);
+#else
 wait_for_termination (pid);
+#endif
 /* Don't kill any children that the subprocess may have left behind
 when exiting.  */
 call_process_exited = 1;
 unbind_to (speccount, Qnil);
 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
 int cpid;
 	 CONSP (tail) && STRINGP (XCAR (tail));
 	 tail = XCDR (tail))
 {
 char **ep = env;
 char *envvar_external;
-Bufbyte *envvar_internal = XSTRING_DATA (XCAR (tail));
+TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (tail),
-GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (envvar_internal, envvar_external);
+			  C_STRING_ALLOCA, envvar_external,
+			  Qfile_name);
 /* See if envvar_external duplicates any string already in the env.
 	 If so, don't put it in.
 	 When an env var has multiple definitions,
 	 we keep the definition that comes first in process-environment.  */
 something missing here;
 #endif /* vipc */
 #ifdef WINDOWSNT
 /* Spawn the child.  (See ntproc.c:Spawnve).  */
-cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
+cpid = spawnve (_P_NOWAIT, new_argv[0], (const char* const*)new_argv,
+		  (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;
 _exit (1);
 #endif /* not WINDOWSNT */
 }
 static int
-getenv_internal (CONST Bufbyte *var,
+getenv_internal (const Bufbyte *var,
 		 Bytecount varlen,
 		 Bufbyte **value,
 		 Bytecount *valuelen)
 {
 Lisp_Object scan;
 }
 /* A version of getenv that consults process_environment, easily
 callable from C.  */
 char *
-egetenv (CONST char *var)
+egetenv (const char *var)
 {
 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;
 }
 /* jwz: always initialize Vprocess_environment, so that egetenv()
 works in temacs. */
 char **envp;
 Vprocess_environment = Qnil;
 for (envp = environ; envp && *envp; envp++)
-{
+Vprocess_environment =
-	Vprocess_environment = Fcons (build_ext_string (*envp, FORMAT_OS),
+	Fcons (build_ext_string (*envp, Qfile_name), Vprocess_environment);
-				      Vprocess_environment);
-}
 }
 {
 /* Initialize shell-file-name from environment variables or best guess. */
 #ifdef WINDOWSNT
-CONST char *shell = egetenv ("COMSPEC");
+const char *shell = egetenv ("COMSPEC");
 if (!shell) shell = "\\WINNT\\system32\\cmd.exe";
 #else /* not WINDOWSNT */
-CONST char *shell = egetenv ("SHELL");
+const char *shell = egetenv ("SHELL");
 if (!shell) shell = "/bin/sh";
 #endif
 Vshell_file_name = build_string (shell);
 }
 List of environment variables for subprocesses to inherit.
 Each element should be a string of the form ENVVARNAME=VALUE.
 The environment which Emacs inherits is placed in this variable
 when Emacs starts.
 */ );
-}
+Vlisp_EXEC_SUFFIXES = build_string (EXEC_SUFFIXES);
+staticpro (&Vlisp_EXEC_SUFFIXES);
+}

Mercurial > hg > xemacs-beta

comparison src/callproc.c @ 398:74fd4e045ea6 r21-2-29