diff src/callproc.c @ 412:697ef44129c6 r21-2-14

Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents de805c49cfc1
children
line wrap: on
line diff
--- a/src/callproc.c	Mon Aug 13 11:19:22 2007 +0200
+++ b/src/callproc.c	Mon Aug 13 11:20:41 2007 +0200
@@ -41,19 +41,20 @@
 #include "syssignal.h" /* Always include before systty.h */
 #include "systty.h"
 
-#ifdef WIN32_NATIVE
+#ifdef WINDOWSNT
 #define _P_NOWAIT 1	/* from process.h */
+#include <windows.h>
 #include "nt.h"
 #endif
 
-#ifdef WIN32_NATIVE
+#ifdef DOS_NT
 /* 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 /* WIN32_NATIVE */
+#endif /* DOS_NT */
 
 Lisp_Object Vshell_file_name;
 
@@ -67,14 +68,14 @@
 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 Windows, delete the temporary file on any kind of termination.
+   On MSDOS, 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.  */
@@ -101,7 +102,7 @@
 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 &&
@@ -113,18 +114,7 @@
     /* #### "c-G" -- need non-consing Single-key-description */
     message ("Waiting for process to die...(type C-g again to kill it instantly)");
 
-#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);
-      else
-	wait_for_termination (pHandle);
-    }
-#else
     wait_for_termination (pid);
-#endif
 
     /* "Discard" the unwind protect.  */
     XCAR (fdpid) = Qnil;
@@ -152,7 +142,7 @@
 }
 #endif /* unused */
 
-DEFUN ("old-call-process-internal", Fold_call_process_internal, 1, MANY, 0, /*
+DEFUN ("call-process-internal", Fcall_process_internal, 1, MANY, 0, /*
 Call PROGRAM synchronously in separate process, with coding-system specified.
 Arguments are
  (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS).
@@ -180,15 +170,12 @@
   Lisp_Object infile, buffer, current_dir, display, path;
   int fd[2];
   int filefd;
-#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, gcpro3;
+  struct gcpro gcpro1, gcpro2;
   char **new_argv = alloca_array (char *, max (2, nargs - 2));
 
   /* File to use for stderr in the child.
@@ -235,7 +222,7 @@
     NUNGCPRO;
   }
 
-  GCPRO2 (current_dir, path);
+  GCPRO1 (current_dir);
 
   if (nargs >= 2 && ! NILP (args[1]))
     {
@@ -250,7 +237,7 @@
 
   UNGCPRO;
 
-  GCPRO3 (infile, current_dir, path);  	/* Fexpand_file_name might trash it */
+  GCPRO2 (infile, current_dir);		/* Fexpand_file_name might trash it */
 
   if (nargs >= 3)
     {
@@ -300,8 +287,8 @@
 	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));
@@ -348,14 +335,14 @@
       fd_error = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY);
     else if (STRINGP (error_file))
       {
-	fd_error = open ((const char *) XSTRING_DATA (error_file),
-#ifdef WIN32_NATIVE
+	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 WIN32_NATIVE */
+#else  /* not DOS_NT */
 			 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
 			 CREAT_MODE
-#endif /* not WIN32_NATIVE */
+#endif /* not DOS_NT */
 			 );
       }
 
@@ -369,27 +356,10 @@
       }
 
     fork_error = Qnil;
-#ifdef WIN32_NATIVE
+#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 WIN32_NATIVE */
+#else  /* not WINDOWSNT */
     pid = fork ();
 
     if (pid == 0)
@@ -410,7 +380,7 @@
     if (fd_error >= 0)
       close (fd_error);
 
-#endif /* not WIN32_NATIVE */
+#endif /* not WINDOWSNT */
 
     environ = save_environ;
 
@@ -424,14 +394,12 @@
   if (!NILP (fork_error))
     signal_error (Qfile_error, fork_error);
 
-#ifndef WIN32_NATIVE
   if (pid < 0)
     {
       if (fd[0] >= 0)
 	close (fd[0]);
       report_file_error ("Doing fork", Qnil);
     }
-#endif
 
   if (INTP (buffer))
     {
@@ -482,7 +450,7 @@
 	nread = 0;
 	while (nread < bufsize - 1024)
 	  {
-	    ssize_t this_read
+	    int this_read
 	      = Lstream_read (XLSTREAM (instream), bufptr + nread,
 			      bufsize - nread);
 
@@ -501,12 +469,10 @@
 	if (nread == 0)
 	  break;
 
-#if 0
-#ifdef WIN32_NATIVE
+#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)) {
@@ -514,7 +480,6 @@
          }
        }
 #endif
-#endif
 
 	total_read += nread;
 
@@ -542,11 +507,7 @@
 
     QUIT;
     /* Wait for it to terminate, unless it already has.  */
-#ifdef WIN32_NATIVE
-    wait_for_termination (pHandle);
-#else
     wait_for_termination (pid);
-#endif
 
     /* Don't kill any children that the subprocess may have left behind
        when exiting.  */
@@ -602,48 +563,31 @@
    a decent error from within the child, this should be verified as an
    executable directory by the parent.  */
 
-#ifdef WIN32_NATIVE
+#ifdef WINDOWSNT
 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 WIN32_NATIVE
+#ifdef WINDOWSNT
   int cpid;
   HANDLE handles[4];
-#endif /* WIN32_NATIVE */
+#endif /* WINDOWSNT */
 
 #ifdef SET_EMACS_PRIORITY
   if (emacs_priority != 0)
     nice (- emacs_priority);
 #endif
 
-  /* 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)
+#if !defined (NO_SUBPROCESSES) && !defined (WINDOWSNT)
   /* 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.
@@ -701,10 +645,9 @@
     {
       char **ep = env;
       char *envvar_external;
+      Bufbyte *envvar_internal = XSTRING_DATA (XCAR (tail));
 
-      TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (tail),
-			  C_STRING_ALLOCA, envvar_external,
-			  Qfile_name);
+      GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (envvar_internal, envvar_external);
 
       /* See if envvar_external duplicates any string already in the env.
 	 If so, don't put it in.
@@ -738,10 +681,10 @@
     *new_env = 0;
   }
 
-#ifdef WIN32_NATIVE
+#ifdef WINDOWSNT
   prepare_standard_handles (in, out, err, handles);
   set_process_dir (current_dir);
-#else  /* not WIN32_NATIVE */
+#else  /* not WINDOWSNT */
   /* 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
@@ -772,22 +715,22 @@
     for (fd=3; fd<=64; fd++)
       close (fd);
   }
-#endif /* not WIN32_NATIVE */
+#endif /* not WINDOWSNT */
 
 #ifdef vipc
   something missing here;
 #endif /* vipc */
 
-#ifdef WIN32_NATIVE
+#ifdef WINDOWSNT
   /* Spawn the child.  (See ntproc.c:Spawnve).  */
-  cpid = spawnve (_P_NOWAIT, new_argv[0], (const char* const*)new_argv,
-		  (const char* const*)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;
-#else /* not WIN32_NATIVE */
+#else /* not WINDOWSNT */
   /* 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.  */
@@ -796,11 +739,11 @@
 
   stdout_out ("Can't exec program %s\n", new_argv[0]);
   _exit (1);
-#endif /* not WIN32_NATIVE */
+#endif /* not WINDOWSNT */
 }
 
 static int
-getenv_internal (const Bufbyte *var,
+getenv_internal (CONST Bufbyte *var,
 		 Bytecount varlen,
 		 Bufbyte **value,
 		 Bytecount *valuelen)
@@ -814,12 +757,12 @@
       if (STRINGP (entry)
 	  && XSTRING_LENGTH (entry) > varlen
 	  && XSTRING_BYTE (entry, varlen) == '='
-#ifdef WIN32_NATIVE
+#ifdef WINDOWSNT
 	  /* NT environment variables are case insensitive.  */
 	  && ! memicmp (XSTRING_DATA (entry), var, varlen)
-#else  /* not WIN32_NATIVE */
+#else  /* not WINDOWSNT */
 	  && ! memcmp (XSTRING_DATA (entry), var, varlen)
-#endif /* not WIN32_NATIVE */
+#endif /* not WINDOWSNT */
 	  )
 	{
 	  *value    = XSTRING_DATA   (entry) + (varlen + 1);
@@ -863,12 +806,12 @@
 /* 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;
@@ -886,17 +829,19 @@
     char **envp;
     Vprocess_environment = Qnil;
     for (envp = environ; envp && *envp; envp++)
-      Vprocess_environment =
-	Fcons (build_ext_string (*envp, Qfile_name), Vprocess_environment);
+      {
+	Vprocess_environment = Fcons (build_ext_string (*envp, FORMAT_OS),
+				      Vprocess_environment);
+      }
   }
 
   {
     /* Initialize shell-file-name from environment variables or best guess. */
-#ifdef WIN32_NATIVE
-    const char *shell = egetenv ("COMSPEC");
+#ifdef WINDOWSNT
+    CONST char *shell = egetenv ("COMSPEC");
     if (!shell) shell = "\\WINNT\\system32\\cmd.exe";
-#else /* not WIN32_NATIVE */
-    const char *shell = egetenv ("SHELL");
+#else /* not WINDOWSNT */
+    CONST char *shell = egetenv ("SHELL");
     if (!shell) shell = "/bin/sh";
 #endif
 
@@ -923,7 +868,7 @@
 void
 syms_of_callproc (void)
 {
-  DEFSUBR (Fold_call_process_internal);
+  DEFSUBR (Fcall_process_internal);
   DEFSUBR (Fgetenv);
 }
 
@@ -931,7 +876,7 @@
 vars_of_callproc (void)
 {
   /* This function can GC */
-#ifdef WIN32_NATIVE
+#ifdef DOS_NT
   DEFVAR_LISP ("binary-process-input", &Vbinary_process_input /*
 *If non-nil then new subprocesses are assumed to take binary input.
 */ );
@@ -941,7 +886,7 @@
 *If non-nil then new subprocesses are assumed to produce binary output.
 */ );
   Vbinary_process_output = Qnil;
-#endif /* WIN32_NATIVE */
+#endif /* DOS_NT */
 
   DEFVAR_LISP ("shell-file-name", &Vshell_file_name /*
 *File name to load inferior shells from.