]> code.delx.au - gnu-emacs/blobdiff - src/callproc.c
(indent-for-tab-command): Indent the region if
[gnu-emacs] / src / callproc.c
index ce9eb73dd5417c3ed4dd281428688b2901cdf5fc..0fa0c3a8662c39c32f5198927db7c09539fe1816 100644 (file)
@@ -6,7 +6,7 @@ This file is part of GNU Emacs.
 
 GNU Emacs is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
 any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
@@ -113,13 +113,13 @@ Lisp_Object Vtemp_file_name_pattern;
 
 Lisp_Object Vshell_file_name;
 
-Lisp_Object Vprocess_environment;
+Lisp_Object Vprocess_environment, Vinitial_environment;
 
 #ifdef DOS_NT
 Lisp_Object Qbuffer_file_type;
 #endif /* DOS_NT */
 
-/* True iff we are about to fork off a synchronous process or if we
+/* True if we are about to fork off a synchronous process or if we
    are waiting for it.  */
 int synch_process_alive;
 
@@ -141,6 +141,8 @@ int synch_process_retcode;
 /* Nonzero if this is termination due to exit.  */
 static int call_process_exited;
 
+EXFUN (Fgetenv_internal, 2);
+
 #ifndef VMS  /* VMS version is in vmsproc.c.  */
 
 static Lisp_Object
@@ -1273,9 +1275,10 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
 
   /* 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
-     and will be cleaned up in the usual way.  */
+     If using vfork and C_ALLOCA (when Emacs used to include
+     src/alloca.c) 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 char *temp;
     register int i;
@@ -1325,41 +1328,59 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
     register char **new_env;
     char **p, **q;
     register int new_length;
-    Lisp_Object local = get_frame_param (XFRAME (Fframe_with_environment (selected_frame)),
-                                         Qenvironment);
-
+    Lisp_Object display = Qnil;
+    
     new_length = 0;
 
     for (tem = Vprocess_environment;
          CONSP (tem) && STRINGP (XCAR (tem));
          tem = XCDR (tem))
-      new_length++;
+      {
+       if (strncmp (SDATA (XCAR (tem)), "DISPLAY", 7) == 0
+           && (SDATA (XCAR (tem)) [7] == '\0'
+               || SDATA (XCAR (tem)) [7] == '='))
+         /* DISPLAY is specified in process-environment.  */
+         display = Qt;
+       new_length++;
+      }
 
-    for (tem = local;
-        CONSP (tem) && STRINGP (XCAR (tem));
-        tem = XCDR (tem))
-      new_length++;
+    /* If not provided yet, use the frame's DISPLAY.  */
+    if (NILP (display))
+      {
+       Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay);
+       if (!STRINGP (tmp) && CONSP (Vinitial_environment))
+         /* If still not found, Look for DISPLAY in Vinitial_environment.  */
+         tmp = Fgetenv_internal (build_string ("DISPLAY"),
+                                 Vinitial_environment);
+       if (STRINGP (tmp))
+         {
+           display = tmp;
+           new_length++;
+         }
+      }
 
     /* new_length + 2 to include PWD and terminating 0.  */
     env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *));
-
     /* If we have a PWD envvar, pass one down,
        but with corrected value.  */
     if (egetenv ("PWD"))
       *new_env++ = pwd_var;
  
+    if (STRINGP (display))
+      {
+       int vlen = strlen ("DISPLAY=") + strlen (SDATA (display)) + 1;
+       char *vdata = (char *) alloca (vlen);
+       strcpy (vdata, "DISPLAY=");
+       strcat (vdata, SDATA (display));
+       new_env = add_env (env, new_env, vdata);
+      }
+
     /* Overrides.  */
     for (tem = Vprocess_environment;
         CONSP (tem) && STRINGP (XCAR (tem));
         tem = XCDR (tem))
       new_env = add_env (env, new_env, SDATA (XCAR (tem)));
 
-    /* Local part of environment.  */
-    for (tem = local;
-         CONSP (tem) && STRINGP (XCAR (tem));
-         tem = XCDR (tem))
-      new_env = add_env (env, new_env, SDATA (XCAR (tem)));
-
     *new_env = 0;
 
     /* Remove variable names without values.  */
@@ -1373,6 +1394,8 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
           p++;
       }
   }
+
+  
 #ifdef WINDOWSNT
   prepare_standard_handles (in, out, err, handles);
   set_process_dir (SDATA (current_dir));
@@ -1486,74 +1509,72 @@ relocate_fd (fd, minfd)
 }
 
 static int
-getenv_internal (var, varlen, value, valuelen, frame)
+getenv_internal_1 (var, varlen, value, valuelen, env)
      char *var;
      int varlen;
      char **value;
      int *valuelen;
-     Lisp_Object frame;
+     Lisp_Object env;
 {
-  Lisp_Object scan;
-
-  if (NILP (frame))
+  for (; CONSP (env); env = XCDR (env))
     {
-      /* Try to find VAR in Vprocess_environment first.  */
-      for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
-        {
-          Lisp_Object entry = XCAR (scan);
-          if (STRINGP (entry)
-              && SBYTES (entry) >= varlen
+      Lisp_Object entry = XCAR (env);
+      if (STRINGP (entry)
+         && SBYTES (entry) >= varlen
 #ifdef WINDOWSNT
-              /* NT environment variables are case insensitive.  */
-              && ! strnicmp (SDATA (entry), var, varlen)
+         /* NT environment variables are case insensitive.  */
+         && ! strnicmp (SDATA (entry), var, varlen)
 #else  /* not WINDOWSNT */
-              && ! bcmp (SDATA (entry), var, varlen)
+         && ! bcmp (SDATA (entry), var, varlen)
 #endif /* not WINDOWSNT */
-              )
-            {
-              if (SBYTES (entry) > varlen && SREF (entry, varlen) == '=')
-                {
-                  *value = (char *) SDATA (entry) + (varlen + 1);
-                  *valuelen = SBYTES (entry) - (varlen + 1);
-                  return 1;
-                }
-              else if (SBYTES (entry) == varlen)
-                {
-                  /* Lone variable names in Vprocess_environment mean that
-                     variable should be removed from the environment. */
-                  return 0;
-                }
-            }
-        }
-      frame = selected_frame;
+         )
+       {
+         if (SBYTES (entry) > varlen && SREF (entry, varlen) == '=')
+           {
+             *value = (char *) SDATA (entry) + (varlen + 1);
+             *valuelen = SBYTES (entry) - (varlen + 1);
+             return 1;
+           }
+         else if (SBYTES (entry) == varlen)
+           {
+             /* Lone variable names in Vprocess_environment mean that
+                variable should be removed from the environment. */
+             *value = NULL;
+             return 1;
+           }
+       }
     }
+  return 0;
+}
 
-  /* Find the environment in which to search the variable. */
-  CHECK_FRAME (frame);
-  frame = Fframe_with_environment (frame);
+static int
+getenv_internal (var, varlen, value, valuelen, frame)
+     char *var;
+     int varlen;
+     char **value;
+     int *valuelen;
+     Lisp_Object frame;
+{
+  /* Try to find VAR in Vprocess_environment first.  */
+  if (getenv_internal_1 (var, varlen, value, valuelen,
+                        Vprocess_environment))
+    return *value ? 1 : 0;
 
-  for (scan = get_frame_param (XFRAME (frame), Qenvironment);
-       CONSP (scan);
-       scan = XCDR (scan))
+  /* For DISPLAY try to get the values from the frame or the initial env.  */
+  if (strcmp (var, "DISPLAY") == 0)
     {
-      Lisp_Object entry;
-
-      entry = XCAR (scan);
-      if (STRINGP (entry)
-          && SBYTES (entry) > varlen
-          && SREF (entry, varlen) == '='
-#ifdef WINDOWSNT
-          /* NT environment variables are case insensitive.  */
-          && ! strnicmp (SDATA (entry), var, varlen)
-#else  /* not WINDOWSNT */
-          && ! bcmp (SDATA (entry), var, varlen)
-#endif /* not WINDOWSNT */
-          )
+      Lisp_Object display
+       = Fframe_parameter (NILP (frame) ? selected_frame : frame, Qdisplay);
+      if (STRINGP (display))
        {
-         *value    = (char *) SDATA (entry) + (varlen + 1);
-         *valuelen = SBYTES (entry) - (varlen + 1);
+         *value    = (char *) SDATA (display);
+         *valuelen = SBYTES (display);
          return 1;
        }
+      /* If still not found, Look for DISPLAY in Vinitial_environment.  */
+      if (getenv_internal_1 (var, varlen, value, valuelen,
+                            Vinitial_environment))
+       return *value ? 1 : 0;
     }
 
   return 0;
@@ -1568,18 +1589,28 @@ This function searches `process-environment' for VARIABLE.  If it is
 not found there, then it continues the search in the environment list
 of the selected frame.
 
-If optional parameter FRAME is non-nil, then this function will ignore
-`process-environment' and will simply look up the variable in that
-frame's environment.  */)
-     (variable, frame)
-     Lisp_Object variable, frame;
+If optional parameter ENV is a list, then search this list instead of
+`process-environment', and return t when encountering a negative entry.
+
+If it is a frame, then this function will ignore `process-environment' and
+will simply look up the variable in that frame's environment.  */)
+     (variable, env)
+     Lisp_Object variable, env;
 {
   char *value;
   int valuelen;
 
   CHECK_STRING (variable);
-  if (getenv_internal (SDATA (variable), SBYTES (variable),
-                      &value, &valuelen, frame))
+  if (CONSP (env))
+    {
+      if (getenv_internal_1 (SDATA (variable), SBYTES (variable),
+                            &value, &valuelen, env))
+       return value ? make_string (value, valuelen) : Qt;
+      else
+       return Qnil;
+    }
+  else if (getenv_internal (SDATA (variable), SBYTES (variable),
+                           &value, &valuelen, env))
     return make_string (value, valuelen);
   else
     return Qnil;
@@ -1737,14 +1768,17 @@ void
 set_initial_environment ()
 {
   register char **envp;
-  Lisp_Object env = Qnil;
 #ifndef CANNOT_DUMP
   if (initialized)
 #endif
     {
       for (envp = environ; *envp; envp++)
-        env = Fcons (build_string (*envp), env);
-      store_frame_param (SELECTED_FRAME(), Qenvironment, env);
+       Vprocess_environment = Fcons (build_string (*envp),
+                                     Vprocess_environment);
+      store_frame_param (SELECTED_FRAME(), Qenvironment, Vprocess_environment);
+      /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent
+        to use `delete' and friends on process-environment.  */
+      Vinitial_environment = Fcopy_sequence (Vprocess_environment);
     }
 }
 
@@ -1804,6 +1838,12 @@ If this variable is nil, then Emacs is unable to use a shared directory.  */);
 This is used by `call-process-region'.  */);
   /* This variable is initialized in init_callproc.  */
 
+  DEFVAR_LISP ("initial-environment", &Vinitial_environment,
+              doc: /* List of environment variables inherited from the parent process.
+Each element should be a string of the form ENVVARNAME=VALUE.
+The elements must normally be decoded (using `locale-coding-system') for use.  */);
+  Vinitial_environment = Qnil;
+
   DEFVAR_LISP ("process-environment", &Vprocess_environment,
               doc: /* List of overridden environment variables for subprocesses to inherit.
 Each element should be a string of the form ENVVARNAME=VALUE.