Mercurial > emacs

changeset 948:928ed74adf4f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Restored up-to-date version of this file from pogo. What is going on here?
author Jim Blandy <jimb@redhat.com>
date Fri, 07 Aug 1992 12:28:53 +0000
parents c45ba80a9da9
children fc4f68fff750
files src/callproc.c
diffstat 1 files changed, 120 insertions(+), 96 deletions(-) [+]
line wrap: on
line diff
--- a/src/callproc.c	Fri Aug 07 01:13:47 1992 +0000
+++ b/src/callproc.c	Fri Aug 07 12:28:53 1992 +0000
@@ -1,5 +1,5 @@
 /* Synchronous subprocess invocation for GNU Emacs.
-   Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -19,6 +19,7 @@
 
 
 #include <signal.h>
+#include <errno.h>
 
 #include "config.h"
 
@@ -57,16 +58,11 @@
 
 #define max(a, b) ((a) > (b) ? (a) : (b))
 
-Lisp_Object Vexec_path, Vexec_directory;
+Lisp_Object Vexec_path, Vexec_directory, Vdata_directory;
 
 Lisp_Object Vshell_file_name;
 
-#ifndef MAINTAIN_ENVIRONMENT
-/* List of strings to append to front of environment of
-   all subprocesses when they are started.  */
-
 Lisp_Object Vprocess_environment;
-#endif
 
 /* True iff we are about to fork off a synchronous process or if we
    are waiting for it.  */
@@ -101,15 +97,15 @@
  nil for BUFFER means discard it; 0 means discard and don't wait.\n\
 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
-If BUFFER is nil or 0, returns immediately with value nil.\n\
+If BUFFER is 0, returns immediately with value nil.\n\
 Otherwise waits for PROGRAM to terminate\n\
-and returns a numeric exit status or a signal name as a string.\n\
+and returns a numeric exit status or a signal description string.\n\
 If you quit, the process is killed with SIGKILL.")
   (nargs, args)
      int nargs;
      register Lisp_Object *args;
 {
-  Lisp_Object display, buffer, path;
+  Lisp_Object display, infile, buffer, path, current_dir;
   int fd[2];
   int filefd;
   register int pid;
@@ -121,34 +117,37 @@
 #if 0
   int mask;
 #endif
-  struct gcpro gcpro1;
-
-  GCPRO1 (*args);
-  gcpro1.nvars = nargs;
-
   CHECK_STRING (args[0], 0);
 
-  if (nargs <= 1 || NILP (args[1]))
-    args[1] = build_string ("/dev/null");
+  if (nargs >= 2 && ! NILP (args[1]))
+    {
+      infile = Fexpand_file_name (args[1], current_buffer->directory);
+      CHECK_STRING (infile, 1);
+    }
   else
-    args[1] = Fexpand_file_name (args[1], current_buffer->directory);
-
-  CHECK_STRING (args[1], 1);
+#ifdef VMS
+    infile = build_string ("NLA0:");
+#else
+    infile = build_string ("/dev/null");
+#endif /* not VMS */
 
-  {
-    register Lisp_Object tem;
-    buffer = tem = args[2];
-    if (nargs <= 2)
-      buffer = Qnil;
-    else if (!(EQ (tem, Qnil) || EQ (tem, Qt)
-	       || XFASTINT (tem) == 0))
-      {
-	buffer = Fget_buffer (tem);
-	CHECK_BUFFER (buffer, 2);
-      }
-  }
+  if (nargs >= 3)
+    {
+      register Lisp_Object tem;
 
-  display = nargs >= 3 ? args[3] : Qnil;
+      buffer = tem = args[2];
+      if (!(EQ (tem, Qnil)
+	    || EQ (tem, Qt)
+	    || XFASTINT (tem) == 0))
+	{
+	  buffer = Fget_buffer (tem);
+	  CHECK_BUFFER (buffer, 2);
+	}
+    }
+  else 
+    buffer = Qnil;
+
+  display = nargs >= 4 ? args[3] : Qnil;
 
   {
     register int i;
@@ -162,10 +161,10 @@
     new_argv[i - 3] = 0;
   }
 
-  filefd = open (XSTRING (args[1])->data, O_RDONLY, 0);
+  filefd = open (XSTRING (infile)->data, O_RDONLY, 0);
   if (filefd < 0)
     {
-      report_file_error ("Opening process input file", Fcons (args[1], Qnil));
+      report_file_error ("Opening process input file", Fcons (infile, Qnil));
     }
   /* Search for program; barf if not found.  */
   openp (Vexec_path, args[0], "", &path, 1);
@@ -187,19 +186,19 @@
 #endif
     }
 
+  /* Make sure that the child will be able to chdir to the current
+     buffer's current directory.  We can't just have the child check
+     for an error when it does the chdir, since it's in a vfork.  */
+  current_dir = expand_and_dir_to_file (current_buffer->directory, Qnil);
+  if (NILP (Ffile_accessible_directory_p (current_dir)))
+    report_file_error ("Setting current directory",
+		       Fcons (current_buffer->directory, Qnil));
+
   {
     /* 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];
-    char **env;
-
-#ifdef MAINTAIN_ENVIRONMENT
-    env = (char **) alloca (size_of_current_environ ());
-    get_current_environ (env);
-#else
-    env = environ;
-#endif /* MAINTAIN_ENVIRONMENT */
 
 #if 0  /* Some systems don't have sigblock.  */
     mask = sigblock (sigmask (SIGCHLD));
@@ -219,7 +218,7 @@
 #else
         setpgrp (pid, pid);
 #endif /* USG */
-	child_setup (filefd, fd1, fd1, new_argv, env, 0);
+	child_setup (filefd, fd1, fd1, new_argv, 0, current_dir);
       }
 
 #if 0
@@ -244,13 +243,17 @@
   if (XTYPE (buffer) == Lisp_Int)
     {
 #ifndef subprocesses
+      /* If Emacs has been built with asynchronous subprocess support,
+	 we don't need to do this, I think because it will then have
+	 the facilities for handling SIGCHLD.  */
       wait_without_blocking ();
 #endif /* subprocesses */
-
-      UNGCPRO;
       return Qnil;
     }
 
+  synch_process_death = 0;
+  synch_process_retcode = 0;
+
   record_unwind_protect (call_process_cleanup,
 			 Fcons (make_number (fd[0]), make_number (pid)));
 
@@ -285,8 +288,6 @@
 
   unbind_to (count, Qnil);
 
-  UNGCPRO;
-
   if (synch_process_death)
     return build_string (synch_process_death);
   return make_number (synch_process_retcode);
@@ -310,7 +311,7 @@
 Remaining args are passed to PROGRAM at startup as command args.\n\
 If BUFFER is nil, returns immediately with value nil.\n\
 Otherwise waits for PROGRAM to terminate\n\
-and returns a numeric exit status or a signal name as a string.\n\
+and returns a numeric exit status or a signal description string.\n\
 If you quit, the process is killed with SIGKILL.")
   (nargs, args)
      int nargs;
@@ -319,10 +320,6 @@
   register Lisp_Object filename_string, start, end;
   char tempfile[20];
   int count = specpdl_ptr - specpdl;
-  struct gcpro gcpro1;
-
-  GCPRO1 (*args);
-  gcpro1.nvars = 2;
 
 #ifdef VMS
   strcpy (tempfile, "tmp:emacsXXXXXX.");
@@ -343,7 +340,6 @@
   args[3] = filename_string;
   Fcall_process (nargs - 2, args + 2);
 
-  UNGCPRO;
   return unbind_to (count, Qnil);
 }
 
@@ -362,14 +358,21 @@
    ENV is the environment for the subprocess.
 
    SET_PGRP is nonzero if we should put the subprocess into a separate
-   process group.  */
+   process group.  
 
-child_setup (in, out, err, new_argv, env, set_pgrp)
+   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.  */
+
+child_setup (in, out, err, new_argv, set_pgrp, current_dir)
      int in, out, err;
      register char **new_argv;
-     char **env;
      int set_pgrp;
+     Lisp_Object current_dir;
 {
+  char **env;
+
   register int pid = getpid();
 
   setpriority (PRIO_PROCESS, pid, 0);
@@ -384,24 +387,25 @@
      If using vfork and C_ALLOCA it is safe because that changes
      the superior's static variables as if the superior had done alloca
      and will be cleaned up in the usual way.  */
+  {
+    register unsigned char *temp;
+    register int i;
 
-  if (XTYPE (current_buffer->directory) == Lisp_String)
-    {
-      register unsigned char *temp;
-      register int i;
+    i = XSTRING (current_dir)->size;
+    temp = (unsigned char *) alloca (i + 2);
+    bcopy (XSTRING (current_dir)->data, temp, i);
+    if (temp[i - 1] != '/') temp[i++] = '/';
+    temp[i] = 0;
 
-      i = XSTRING (current_buffer->directory)->size;
-      temp = (unsigned char *) alloca (i + 2);
-      bcopy (XSTRING (current_buffer->directory)->data, temp, i);
-      if (temp[i - 1] != '/') temp[i++] = '/';
-      temp[i] = 0;
-      /* Switch to that directory, and report any error.  */
-      if (chdir (temp) < 0)
-	report_file_error ("In chdir",
-			   Fcons (current_buffer->directory, Qnil));
-    }
+    /* We can't signal an Elisp error here; we're in a vfork.  Since
+       the callers check the current directory before forking, this
+       should only return an error if the directory's permissions
+       are changed between the check and this chdir, but we should
+       at least check.  */
+    if (chdir (temp) < 0)
+      exit (errno);
+  }
 
-#ifndef MAINTAIN_ENVIRONMENT
   /* Set `env' to a vector of the strings in Vprocess_environment.  */
   {
     register Lisp_Object tem;
@@ -418,7 +422,7 @@
     /* new_length + 1 to include terminating 0 */
     env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *));
 
-    /* Copy the env strings into new_env.  */
+    /* Copy the Vprocess_alist strings into new_env.  */
     for (tem = Vprocess_environment;
 	 (XTYPE (tem) == Lisp_Cons
 	  && XTYPE (XCONS (tem)->car) == Lisp_String);
@@ -426,7 +430,6 @@
       *new_env++ = (char *) XSTRING (XCONS (tem)->car)->data;
     *new_env = 0;
   }
-#endif /* Not MAINTAIN_ENVIRONMENT */
 
   close (0);
   close (1);
@@ -439,6 +442,11 @@
   close (out);
   close (err);
 
+#ifdef USG
+  setpgrp ();			/* No arguments but equivalent in this case */
+#else
+  setpgrp (pid, pid);
+#endif /* USG */
   setpgrp_of_tty (pid);
 
 #ifdef vipc
@@ -468,7 +476,7 @@
   for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr)
     {
       Lisp_Object entry = XCONS (scan)->car;
-
+      
       if (XTYPE (entry) == Lisp_String
 	  && XSTRING (entry)->size > varlen
 	  && XSTRING (entry)->data[varlen] == '='
@@ -502,10 +510,10 @@
 }
 
 /* A version of getenv that consults process_environment, easily
-      callable from C.  */
+   callable from C.  */
 char *
 egetenv (var)
-          char *var;
+     char *var;
 {
   char *value;
   int valuelen;
@@ -522,32 +530,45 @@
 {
   register char * sh;
   register char **envp;
-  Lisp_Object execdir;
+  Lisp_Object tempdir;
 
-  /* Turn PATH_EXEC into a path.  `==' is just a string which we know
-     will not be the name of an environment variable.  */
-  Vexec_path = decode_env_path ("==", PATH_EXEC);
+  {
+    char *data_dir = egetenv ("EMACSDATA");
+    
+    Vdata_directory =
+      Ffile_name_as_directory
+	(build_string (data_dir ? data_dir : PATH_DATA));
+  }
+
+  /* Check the EMACSPATH environment variable, defaulting to the
+     PATH_EXEC path from paths.h.  */
+  Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
   Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
   Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
 
-  execdir = Fdirectory_file_name (Vexec_directory);
-  if (access (XSTRING (execdir)->data, 0) < 0)
+  tempdir = Fdirectory_file_name (Vexec_directory);
+  if (access (XSTRING (tempdir)->data, 0) < 0)
     {
-      printf ("Warning: executable/documentation dir (%s) does not exist.\n",
+      printf ("Warning: arch-dependent data dir (%s) does not exist.\n",
 	      XSTRING (Vexec_directory)->data);
       sleep (2);
     }
 
+  tempdir = Fdirectory_file_name (Vdata_directory);
+  if (access (XSTRING (tempdir)->data, 0) < 0)
+    {
+      printf ("Warning: arch-independent data dir (%s) does not exist.\n",
+	      XSTRING (Vdata_directory)->data);
+      sleep (2);
+    }
+
 #ifdef VMS
   Vshell_file_name = build_string ("*dcl*");
 #else
-  sh = (char *) egetenv ("SHELL");
+  sh = (char *) getenv ("SHELL");
   Vshell_file_name = build_string (sh ? sh : "/bin/sh");
 #endif
 
-#ifndef MAINTAIN_ENVIRONMENT
-  /* The equivalent of this operation was done
-     in init_environ in environ.c if MAINTAIN_ENVIRONMENT */
   Vprocess_environment = Qnil;
 #ifndef CANNOT_DUMP
   if (initialized)
@@ -555,7 +576,6 @@
     for (envp = environ; *envp; envp++)
       Vprocess_environment = Fcons (build_string (*envp),
 				    Vprocess_environment);
-#endif /* MAINTAIN_ENVIRONMENT */
 }
 
 syms_of_callproc ()
@@ -569,18 +589,22 @@
 Each element is a string (directory name) or nil (try default directory).");
 
   DEFVAR_LISP ("exec-directory", &Vexec_directory,
-    "Directory that holds programs that come with GNU Emacs,\n\
-intended for Emacs to invoke.");
+    "Directory of architecture-dependent files that come with GNU Emacs,\n\
+especially executable programs intended for Emacs to invoke.");
 
-#ifndef MAINTAIN_ENVIRONMENT
+  DEFVAR_LISP ("data-directory", &Vdata_directory,
+    "Directory of architecture-independent files that come with GNU Emacs,\n\
+intended for Emacs to use.");
+
   DEFVAR_LISP ("process-environment", &Vprocess_environment,
-    "List of strings to append to environment of subprocesses that are started.\n\
-Each string should have the format ENVVARNAME=VALUE.");
-#endif
+    "List of environment variables for subprocesses to inherit.\n\
+Each element should be a string of the form ENVVARNAME=VALUE.\n\
+The environment which Emacs inherits is placed in this variable\n\
+when Emacs starts.");
 
 #ifndef VMS
   defsubr (&Scall_process);
 #endif
+  defsubr (&Sgetenv);
   defsubr (&Scall_process_region);
-  defsubr (&Sgetenv);
 }