Contents in 1999-06-04-13 of release-21-2.
[chise/xemacs-chise.git.1] / src / callproc.c
index 7ebeb8d..4b5a5dc 100644 (file)
@@ -28,7 +28,6 @@ Boston, MA 02111-1307, USA.  */
 #include "commands.h"
 #include "insdel.h"
 #include "lstream.h"
-#include <paths.h>
 #include "process.h"
 #include "sysdep.h"
 #include "window.h"
@@ -82,6 +81,7 @@ int synch_process_retcode;
 /* 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)
@@ -194,7 +194,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you
 
   /* 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
@@ -314,19 +314,11 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you
 
   {
     /* child_setup must clobber environ in systems with true vfork.
-       Protect it from permanent change.  */
-     REGISTER char **save_environ = environ;
-     REGISTER int fd1 = fd[1];
-     int fd_error = fd1;
-     char **env;
-
-#ifdef EMACS_BTL
-    /* when performance monitoring is on, turn it off before the vfork(),
-       as the child has no handler for the signal -- when back in the
-       parent process, turn it back on if it was really on when you "turned
-       it off" */
-    int logging_on = cadillac_stop_logging ();
-#endif /* EMACS_BTL */
+       Protect it from permanent change.  */
+    REGISTER char **save_environ = environ;
+    REGISTER int fd1 = fd[1];
+    int fd_error = fd1;
+    char **env;
 
     env = environ;
 
@@ -385,10 +377,6 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you
        child_setup (filefd, fd1, fd_error, new_argv,
                     (char *) XSTRING_DATA (current_dir));
       }
-#ifdef EMACS_BTL
-    else if (logging_on)
-      cadillac_start_logging ();
-#endif
     if (fd_error >= 0)
       close (fd_error);
 
@@ -534,9 +522,30 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you
 
 \f
 
+/* Move the file descriptor FD so that its number is not less than MIN. *
+   The original file descriptor remains open.  */
+static int
+relocate_fd (int fd, int min)
+{
+  if (fd >= min)
+    return fd;
+  else
+    {
+      int newfd = dup (fd);
+      if (newfd == -1)
+       {
+         stderr_out ("Error while setting up child: %s\n",
+                     strerror (errno));
+         _exit (1);
+       }
+      return relocate_fd (newfd, min);
+    }
+}
+
 /* This is the last thing run in a newly forked inferior
    either synchronous or asynchronous.
-   Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
+   Copy descriptors IN, OUT and ERR
+   as descriptors STDIN_FILENO, STDOUT_FILENO, and STDERR_FILENO.
    Initialize inferior's priority, pgrp, connected dir and environment.
    then exec another program based on new_argv.
 
@@ -554,8 +563,6 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you
    a decent error from within the child, this should be verified as an
    executable directory by the parent.  */
 
-static int relocate_fd (int fd, int min);
-
 #ifdef WINDOWSNT
 int
 #else
@@ -620,19 +627,11 @@ child_setup (int in, int out, int err, char **new_argv,
   }
 
   /* Set `env' to a vector of the strings in Vprocess_environment.  */
+  /* + 2 to include PWD and terminating 0.  */
+  env = alloca_array (char *, XINT (Flength (Vprocess_environment)) + 2);
   {
-    REGISTER Lisp_Object tem;
-    REGISTER char **new_env;
-    REGISTER int new_length = 0;
-
-    for (tem = Vprocess_environment;
-        (CONSP (tem)
-         && STRINGP (XCAR (tem)));
-        tem = XCDR (tem))
-      new_length++;
-
-    /* new_length + 2 to include PWD and terminating 0.  */
-    env = new_env = alloca_array (char *, new_length + 2);
+    REGISTER Lisp_Object tail;
+    char **new_env = env;
 
     /* If we have a PWD envvar and we know the real current directory,
        pass one down, but with corrected value.  */
@@ -640,20 +639,23 @@ child_setup (int in, int out, int err, char **new_argv,
       *new_env++ = pwd;
 
     /* Copy the Vprocess_environment strings into new_env.  */
-    for (tem = Vprocess_environment;
-        (CONSP (tem)
-         && STRINGP (XCAR (tem)));
-        tem = XCDR (tem))
+    for (tail = Vprocess_environment;
+        CONSP (tail) && STRINGP (XCAR (tail));
+        tail = XCDR (tail))
     {
       char **ep = env;
-      char *string = (char *) XSTRING_DATA (XCAR (tem));
-      /* See if this string duplicates any string already in the env.
+      char *envvar_external;
+      Bufbyte *envvar_internal = XSTRING_DATA (XCAR (tail));
+
+      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.
         When an env var has multiple definitions,
         we keep the definition that comes first in process-environment.  */
       for (; ep != new_env; ep++)
        {
-         char *p = *ep, *q = string;
+         char *p = *ep, *q = envvar_external;
          while (1)
            {
              if (*q == 0)
@@ -666,17 +668,19 @@ child_setup (int in, int out, int err, char **new_argv,
              p++, q++;
            }
        }
-      if (pwd && !strncmp ("PWD=", string, 4))
+      if (pwd && !strncmp ("PWD=", envvar_external, 4))
        {
          *new_env++ = pwd;
          pwd = 0;
        }
       else
-        *new_env++ = string;
+        *new_env++ = envvar_external;
+
     duplicate: ;
     }
     *new_env = 0;
   }
+
 #ifdef WINDOWSNT
   prepare_standard_handles (in, out, err, handles);
   set_process_dir (current_dir);
@@ -685,28 +689,18 @@ child_setup (int in, int out, int err, char **new_argv,
      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.  */
-  {
-    int oin = in, oout = out;
-
-    /* We have to avoid relocating the same descriptor twice!  */
-
-    in = relocate_fd (in, 3);
-
-    if (out == oin) out = in;
-    else            out = relocate_fd (out, 3);
-
-    if      (err == oin)  err = in;
-    else if (err == oout) err = out;
-    else                  err = relocate_fd (err, 3);
-  }
+  in  = relocate_fd (in,  3);
+  out = relocate_fd (out, 3);
+  err = relocate_fd (err, 3);
 
-  close (0);
-  close (1);
-  close (2);
+  /* Set the standard input/output channels of the new process.  */
+  close (STDIN_FILENO);
+  close (STDOUT_FILENO);
+  close (STDERR_FILENO);
 
-  dup2 (in,  0);
-  dup2 (out, 1);
-  dup2 (err, 2);
+  dup2 (in,  STDIN_FILENO);
+  dup2 (out, STDOUT_FILENO);
+  dup2 (err, STDERR_FILENO);
 
   close (in);
   close (out);
@@ -719,9 +713,7 @@ child_setup (int in, int out, int err, char **new_argv,
   {
     int fd;
     for (fd=3; fd<=64; fd++)
-      {
-        close(fd);
-      }
+      close (fd);
   }
 #endif /* not WINDOWSNT */
 
@@ -731,7 +723,8 @@ child_setup (int in, int out, int err, char **new_argv,
 
 #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);
@@ -744,35 +737,11 @@ child_setup (int in, int out, int err, char **new_argv,
   environ = env;
   execvp (new_argv[0], new_argv);
 
-  stdout_out ("Cant't exec program %s\n", new_argv[0]);
+  stdout_out ("Can't exec program %s\n", new_argv[0]);
   _exit (1);
 #endif /* not WINDOWSNT */
 }
 
-/* Move the file descriptor FD so that its number is not less than MIN.
-   If the file descriptor is moved at all, the original is freed.  */
-static int
-relocate_fd (int fd, int min)
-{
-  if (fd >= min)
-    return fd;
-  else
-    {
-      int new = dup (fd);
-      if (new == -1)
-       {
-         stderr_out ("Error while setting up child: %s\n",
-                     strerror (errno));
-         _exit (1);
-       }
-      /* Note that we hold the original FD open while we recurse,
-        to guarantee we'll get a new FD if we need it.  */
-      new = relocate_fd (new, min);
-      close (fd);
-      return new;
-    }
-}
-
 static int
 getenv_internal (CONST Bufbyte *var,
                 Bytecount varlen,
@@ -853,13 +822,12 @@ void
 init_callproc (void)
 {
   /* This function can GC */
-  REGISTER char *sh;
 
-  Vprocess_environment = Qnil;
-  /* jwz: always initialize Vprocess_environment, so that egetenv() works
-     in temacs. */
   {
+    /* jwz: always initialize Vprocess_environment, so that egetenv()
+       works in temacs. */
     char **envp;
+    Vprocess_environment = Qnil;
     for (envp = environ; envp && *envp; envp++)
       {
        Vprocess_environment = Fcons (build_ext_string (*envp, FORMAT_OS),
@@ -867,32 +835,18 @@ init_callproc (void)
       }
   }
 
+  {
+    /* Initialize shell-file-name from environment variables or best guess. */
 #ifdef WINDOWSNT
-  /* Sync with FSF Emacs 19.34.6 note: this is not in 19.34.6. --marcpa */
-  /*
-  ** If NT then we look at COMSPEC for the shell program.
-  */
-  sh = egetenv ("COMSPEC");
-  /*
-  ** If COMSPEC has been set, then convert the
-  ** DOS formatted name into a UNIX format. Then
-  ** create a LISP object.
-  */
-  if (sh)
-    Vshell_file_name = build_string (sh);
-  /*
-  ** Odd, no COMSPEC, so let's default to our
-  ** best guess for NT.
-  */
-  else
-    Vshell_file_name = build_string ("\\WINNT\\system32\\cmd.exe");
-
+    CONST char *shell = egetenv ("COMSPEC");
+    if (!shell) shell = "\\WINNT\\system32\\cmd.exe";
 #else /* not WINDOWSNT */
-
-  sh = (char *) egetenv ("SHELL");
-  Vshell_file_name = build_string (sh ? sh : "/bin/sh");
-
+    CONST char *shell = egetenv ("SHELL");
+    if (!shell) shell = "/bin/sh";
 #endif
+
+    Vshell_file_name = build_string (shell);
+  }
 }
 
 #if 0
@@ -945,4 +899,7 @@ 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);
 }