/* Synchronous subprocess invocation for GNU Emacs.
Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1999, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
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,
#include "syssignal.h"
#include "systty.h"
#include "blockinput.h"
+#include "frame.h"
+#include "termhooks.h"
#ifdef MSDOS
#include "msdos.h"
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;
/* If synch_process_death is zero,
this is exit code of synchronous subprocess. */
int synch_process_retcode;
+
\f
/* Clean up when exiting Fcall_process.
On MSDOS, delete the temporary file on any kind of termination.
/* 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
call_process_cleanup (fdpid)
Lisp_Object fdpid;
{
-#if defined (MSDOS) || defined (MAC_OS8)
+#if defined (MSDOS)
/* for MSDOS fdpid is really (fd . tempfile) */
register Lisp_Object file;
file = Fcdr (fdpid);
emacs_close (XFASTINT (Fcar (fdpid)));
if (strcmp (SDATA (file), NULL_DEVICE) != 0)
unlink (SDATA (file));
-#else /* not MSDOS and not MAC_OS8 */
+#else /* not MSDOS */
register int pid = XFASTINT (Fcdr (fdpid));
if (call_process_exited)
char *outf, *tempfile;
int outfilefd;
#endif
-#ifdef MAC_OS8
- char *tempfile;
- int outfilefd;
-#endif
#if 0
int mask;
#endif
fd[1] = outfilefd;
#endif /* MSDOS */
-#ifdef MAC_OS8
- /* Since we don't have pipes on the Mac, create a temporary file to
- hold the output of the subprocess. */
- tempfile = (char *) alloca (SBYTES (Vtemp_file_name_pattern) + 1);
- bcopy (SDATA (Vtemp_file_name_pattern), tempfile,
- SBYTES (Vtemp_file_name_pattern) + 1);
-
- mktemp (tempfile);
-
- outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
- if (outfilefd < 0)
- {
- close (filefd);
- report_file_error ("Opening process output file",
- Fcons (build_string (tempfile), Qnil));
- }
- fd[0] = filefd;
- fd[1] = outfilefd;
-#endif /* MAC_OS8 */
-
if (INTEGERP (buffer))
fd[1] = emacs_open (NULL_DEVICE, O_WRONLY, 0), fd[0] = -1;
else
{
#ifndef MSDOS
-#ifndef MAC_OS8
- errno = 0;
- if (pipe (fd) == -1)
- {
- emacs_close (filefd);
- report_file_error ("Creating process pipe", Qnil);
- }
-#endif
#endif
#if 0
/* Replaced by close_process_descs */
report_file_error ("Cannot redirect stderr", Fcons (error_file, Qnil));
}
-#ifdef MAC_OS8
- {
- /* Call run_mac_command in sysdep.c here directly instead of doing
- a child_setup as for MSDOS and other platforms. Note that this
- code does not handle passing the environment to the synchronous
- Mac subprocess. */
- char *infn, *outfn, *errfn, *currdn;
-
- /* close these files so subprocess can write to them */
- close (outfilefd);
- if (fd_error != outfilefd)
- close (fd_error);
- fd1 = -1; /* No harm in closing that one! */
-
- infn = SDATA (infile);
- outfn = tempfile;
- if (NILP (error_file))
- errfn = NULL_DEVICE;
- else if (EQ (Qt, error_file))
- errfn = outfn;
- else
- errfn = SDATA (error_file);
- currdn = SDATA (current_dir);
- pid = run_mac_command (new_argv, currdn, infn, outfn, errfn);
-
- /* Record that the synchronous process exited and note its
- termination status. */
- synch_process_alive = 0;
- synch_process_retcode = pid;
- if (synch_process_retcode < 0) /* means it couldn't be exec'ed */
- {
- synchronize_system_messages_locale ();
- synch_process_death = strerror (errno);
- }
-
- /* Since CRLF is converted to LF within `decode_coding', we can
- always open a file with binary mode. */
- fd[0] = open (tempfile, O_BINARY);
- if (fd[0] < 0)
- {
- unlink (tempfile);
- close (filefd);
- report_file_error ("Cannot re-open temporary file", Qnil);
- }
- }
-#else /* not MAC_OS8 */
#ifdef MSDOS /* MW, July 1993 */
/* Note that on MSDOS `child_setup' actually returns the child process
exit status, not its PID, so we assign it to `synch_process_retcode'
if (fd_error >= 0)
emacs_close (fd_error);
#endif /* not MSDOS */
-#endif /* not MAC_OS8 */
environ = save_environ;
/* Enable sending signal if user quits below. */
call_process_exited = 0;
-#if defined(MSDOS) || defined(MAC_OS8)
+#if defined(MSDOS)
/* MSDOS needs different cleanup information. */
record_unwind_protect (call_process_cleanup,
Fcons (make_number (fd[0]), build_string (tempfile)));
#else
record_unwind_protect (call_process_cleanup,
Fcons (make_number (fd[0]), make_number (pid)));
-#endif /* not MSDOS and not MAC_OS8 */
+#endif /* not MSDOS */
if (BUFFERP (buffer))
static int relocate_fd ();
+static char **
+add_env (char **env, char **new_env, char *string)
+{
+ char **ep;
+ int ok = 1;
+ if (string == NULL)
+ return new_env;
+
+ /* See if this string 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 = env; ok && ep != new_env; ep++)
+ {
+ char *p = *ep, *q = string;
+ while (ok)
+ {
+ if (*q != *p)
+ break;
+ if (*q == 0)
+ /* The string is a lone variable name; keep it for now, we
+ will remove it later. It is a placeholder for a
+ variable that is not to be included in the environment. */
+ break;
+ if (*q == '=')
+ ok = 0;
+ p++, q++;
+ }
+ }
+ if (ok)
+ *new_env++ = string;
+ return new_env;
+}
+
/* 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.
/* 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;
temp[--i] = 0;
}
- /* Set `env' to a vector of the strings in Vprocess_environment. */
+ /* Set `env' to a vector of the strings in the environment. */
{
register Lisp_Object tem;
register char **new_env;
+ char **p, **q;
register int new_length;
-
+ Lisp_Object display = Qnil;
+
new_length = 0;
+
for (tem = Vprocess_environment;
- CONSP (tem) && STRINGP (XCAR (tem));
- tem = XCDR (tem))
- new_length++;
+ CONSP (tem) && STRINGP (XCAR (tem));
+ tem = XCDR (tem))
+ {
+ 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++;
+ }
+
+ /* 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 (getenv ("PWD"))
+ 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);
+ }
- /* Copy the Vprocess_environment strings into new_env. */
+ /* Overrides. */
for (tem = Vprocess_environment;
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. */
+ p = q = env;
+ while (*p != 0)
{
- char **ep = env;
- char *string = (char *) SDATA (XCAR (tem));
- /* See if this string 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;
- while (1)
- {
- if (*q == 0)
- /* The string is malformed; might as well drop it. */
- goto duplicate;
- if (*q != *p)
- break;
- if (*q == '=')
- goto duplicate;
- p++, q++;
- }
- }
- *new_env++ = string;
- duplicate: ;
+ while (*q != 0 && strchr (*q, '=') == NULL)
+ q++;
+ *p = *q++;
+ if (*p != 0)
+ p++;
}
- *new_env = 0;
}
+
+
#ifdef WINDOWSNT
prepare_standard_handles (in, out, err, handles);
set_process_dir (SDATA (current_dir));
}
static int
-getenv_internal (var, varlen, value, valuelen)
+getenv_internal_1 (var, varlen, value, valuelen, env)
char *var;
int varlen;
char **value;
int *valuelen;
+ Lisp_Object env;
{
- Lisp_Object scan;
-
- for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
+ for (; CONSP (env); env = XCDR (env))
{
- Lisp_Object entry;
-
- entry = XCAR (scan);
+ Lisp_Object entry = XCAR (env);
if (STRINGP (entry)
- && SBYTES (entry) > varlen
- && SREF (entry, varlen) == '='
+ && SBYTES (entry) >= varlen
#ifdef WINDOWSNT
/* NT environment variables are case insensitive. */
&& ! strnicmp (SDATA (entry), var, varlen)
#endif /* not WINDOWSNT */
)
{
- *value = (char *) SDATA (entry) + (varlen + 1);
- *valuelen = SBYTES (entry) - (varlen + 1);
+ 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;
+}
+
+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 DISPLAY try to get the values from the frame or the initial env. */
+ if (strcmp (var, "DISPLAY") == 0)
+ {
+ Lisp_Object display
+ = Fframe_parameter (NILP (frame) ? selected_frame : frame, Qdisplay);
+ if (STRINGP (display))
+ {
+ *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;
}
-DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 1, 0,
- doc: /* Return the value of environment variable VAR, as a string.
-VAR should be a string. Value is nil if VAR is undefined in the environment.
-This function consults the variable `process-environment' for its value. */)
- (var)
- Lisp_Object var;
+DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
+ doc: /* Get the value of environment variable VARIABLE.
+VARIABLE should be a string. Value is nil if VARIABLE is undefined in
+the environment. Otherwise, value is a string.
+
+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 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 (var);
- if (getenv_internal (SDATA (var), SBYTES (var),
- &value, &valuelen))
+ CHECK_STRING (variable);
+ 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;
}
-/* A version of getenv that consults process_environment, easily
- callable from C. */
+/* A version of getenv that consults the Lisp environment lists,
+ easily callable from C. */
char *
egetenv (var)
char *var;
char *value;
int valuelen;
- if (getenv_internal (var, strlen (var), &value, &valuelen))
+ if (getenv_internal (var, strlen (var), &value, &valuelen, Qnil))
return value;
else
return 0;
{
char *dir = getenv ("TMPDIR");
Vtemp_file_name_pattern
- = Fexpand_file_name (build_string ("emacsXXXXXX"),
- build_string (dir));
+ = Fexpand_file_name (build_string ("emacsXXXXXX"),
+ build_string (dir));
}
else
Vtemp_file_name_pattern = build_string ("/tmp/emacsXXXXXX");
}
void
-set_process_environment ()
+set_initial_environment ()
{
register char **envp;
-
- Vprocess_environment = Qnil;
#ifndef CANNOT_DUMP
if (initialized)
#endif
- for (envp = environ; *envp; envp++)
- Vprocess_environment = Fcons (build_string (*envp),
- Vprocess_environment);
+ {
+ for (envp = environ; *envp; envp++)
+ Vprocess_environment = Fcons (build_string (*envp),
+ 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);
+ }
}
void
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 environment variables for subprocesses to inherit.
+ doc: /* List of overridden environment variables for subprocesses to inherit.
Each element should be a string of the form ENVVARNAME=VALUE.
+
+Entries in this list take precedence to those in the frame-local
+environments. Therefore, let-binding `process-environment' is an easy
+way to temporarily change the value of an environment variable,
+irrespective of where it comes from. To use `process-environment' to
+remove an environment variable, include only its name in the list,
+without "=VALUE".
+
+This variable is set to nil when Emacs starts.
+
If multiple entries define the same variable, the first one always
takes precedence.
-The environment which Emacs inherits is placed in this variable
-when Emacs starts.
+
Non-ASCII characters are encoded according to the initial value of
-`locale-coding-system', i.e. the elements must normally be decoded for use.
+`locale-coding-system', i.e. the elements must normally be decoded for
+use.
+
See `setenv' and `getenv'. */);
+ Vprocess_environment = Qnil;
#ifndef VMS
defsubr (&Scall_process);
HCoop / bpt / emacs.git / blobdiff