/* 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.
#include <signal.h>
+#include <errno.h>
#include "config.h"
#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. */
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;
#if 0
int mask;
#endif
- struct gcpro gcpro1;
-
- GCPRO1 (*args);
- gcpro1.nvars = nargs;
-
CHECK_STRING (args[0], 0);
- if (nargs <= 1 || NULL (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);
+ infile = build_string ("/dev/null");
{
register Lisp_Object tem;
- buffer = tem = args[2];
- if (nargs <= 2)
+ if (nargs < 3)
buffer = Qnil;
- else if (!(EQ (tem, Qnil) || EQ (tem, Qt)
- || XFASTINT (tem) == 0))
+ else
{
- buffer = Fget_buffer (tem);
- CHECK_BUFFER (buffer, 2);
+ buffer = tem = args[2];
+ if (!(EQ (tem, Qnil) || EQ (tem, Qt)
+ || XFASTINT (tem) == 0))
+ {
+ buffer = Fget_buffer (tem);
+ CHECK_BUFFER (buffer, 2);
+ }
}
}
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);
- if (NULL (path))
+ if (NILP (path))
{
close (filefd);
report_file_error ("Searching for program", Fcons (args[0], Qnil));
#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 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));
#else
setpgrp (pid, pid);
#endif /* USG */
- child_setup (filefd, fd1, fd1, new_argv, env, 0);
+ child_setup (filefd, fd1, fd1, new_argv, env, 0, current_dir);
}
#if 0
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)));
while ((nread = read (fd[0], buf, sizeof buf)) > 0)
{
immediate_quit = 0;
- if (!NULL (buffer))
+ if (!NILP (buffer))
insert (buf, nread);
- if (!NULL (display) && INTERACTIVE)
+ if (!NILP (display) && INTERACTIVE)
redisplay_preserve_echo_area ();
immediate_quit = 1;
QUIT;
unbind_to (count, Qnil);
- UNGCPRO;
-
if (synch_process_death)
return build_string (synch_process_death);
return make_number (synch_process_retcode);
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.");
Fwrite_region (start, end, filename_string, Qnil, Qlambda);
record_unwind_protect (delete_temp_file, filename_string);
- if (!NULL (args[3]))
+ if (!NILP (args[3]))
Fdelete_region (start, end);
args[3] = filename_string;
Fcall_process (nargs - 2, args + 2);
- UNGCPRO;
return unbind_to (count, Qnil);
}
\f
ENV is the environment for the subprocess.
SET_PGRP is nonzero if we should put the subprocess into a separate
- process group. */
+ process group.
+
+ 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, env, set_pgrp)
+child_setup (in, out, err, new_argv, env, set_pgrp, current_dir)
int in, out, err;
register char **new_argv;
char **env;
int set_pgrp;
+ Lisp_Object current_dir;
{
register int pid = getpid();
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_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));
- }
+ 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;
+
+ /* 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;
*new_env++ = (char *) XSTRING (XCONS (tem)->car)->data;
*new_env = 0;
}
-#endif /* Not MAINTAIN_ENVIRONMENT */
close (0);
close (1);
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
_exit (1);
}
+static int
+getenv_internal (var, varlen, value, valuelen)
+ char *var;
+ int varlen;
+ char **value;
+ int *valuelen;
+{
+ Lisp_Object scan;
+
+ 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] == '='
+ && ! bcmp (XSTRING (entry)->data, var, varlen))
+ {
+ *value = (char *) XSTRING (entry)->data + (varlen + 1);
+ *valuelen = XSTRING (entry)->size - (varlen + 1);
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, 0,
+ "Return the value of environment variable VAR, as a string.\n\
+VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
+This function consults the variable ``process-environment'' for its value.")
+ (var)
+ Lisp_Object var;
+{
+ char *value;
+ int valuelen;
+
+ CHECK_STRING (var, 0);
+ if (getenv_internal (XSTRING (var)->data, XSTRING (var)->size,
+ &value, &valuelen))
+ return make_string (value, valuelen);
+ else
+ return Qnil;
+}
+
+/* A version of getenv that consults process_environment, easily
+ callable from C. */
+char *
+egetenv (var)
+{
+ char *value;
+ int valuelen;
+
+ if (getenv_internal (var, strlen (var), &value, &valuelen))
+ return value;
+ else
+ return 0;
+}
+
#endif /* not VMS */
\f
init_callproc ()
{
register char * sh;
register char **envp;
- Lisp_Object execdir;
+ Lisp_Object tempdir;
+
+ Vdata_directory = Ffile_name_as_directory (build_string (PATH_DATA));
/* Turn PATH_EXEC into a path. `==' is just a string which we know
will not be the name of an environment variable. */
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)
for (envp = environ; *envp; envp++)
Vprocess_environment = Fcons (build_string (*envp),
Vprocess_environment);
-#endif /* MAINTAIN_ENVIRONMENT */
}
syms_of_callproc ()
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.");
+
+ DEFVAR_LISP ("data-directory", &Vdata_directory,
+ "Directory of architecture-independent files that come with GNU Emacs,\n\
+intended for Emacs to use.");
-#ifndef MAINTAIN_ENVIRONMENT
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);
}