/* Synchronous subprocess invocation for GNU Emacs.
- Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1988, 1993 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <signal.h>
#include <errno.h>
-#include "config.h"
+#include <config.h>
+
+extern int errno;
+#ifndef VMS
+extern char *sys_errlist[];
+#endif
/* Define SIGCHLD as an alias for SIGCLD. */
#endif /* SIGCLD */
#include <sys/types.h>
-#define PRIO_PROCESS 0
+
#include <sys/file.h>
#ifdef USG5
#include <fcntl.h>
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
-#include "paths.h"
+#include <paths.h>
#include "process.h"
+#include "syssignal.h"
#ifdef VMS
extern noshare char **environ;
#define max(a, b) ((a) > (b) ? (a) : (b))
Lisp_Object Vexec_path, Vexec_directory, Vdata_directory;
+Lisp_Object Vconfigure_info_directory;
Lisp_Object Vshell_file_name;
/* If synch_process_death is zero,
this is exit code of synchronous subprocess. */
int synch_process_retcode;
+
+extern Lisp_Object Vdoc_file_name;
\f
#ifndef VMS /* VMS version is in vmsproc.c. */
+static Lisp_Object
+call_process_kill (fdpid)
+ Lisp_Object fdpid;
+{
+ close (XFASTINT (Fcar (fdpid)));
+ EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
+ synch_process_alive = 0;
+ return Qnil;
+}
+
Lisp_Object
call_process_cleanup (fdpid)
Lisp_Object fdpid;
{
- register Lisp_Object fd, pid;
- fd = Fcar (fdpid);
- pid = Fcdr (fdpid);
- close (XFASTINT (fd));
- kill (XFASTINT (pid), SIGKILL);
+ register int pid = XFASTINT (Fcdr (fdpid));
+
+ if (EMACS_KILLPG (pid, SIGINT) == 0)
+ {
+ int count = specpdl_ptr - specpdl;
+ record_unwind_protect (call_process_kill, fdpid);
+ message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
+ immediate_quit = 1;
+ QUIT;
+ wait_for_termination (pid);
+ immediate_quit = 0;
+ specpdl_ptr = specpdl + count; /* Discard the unwind protect. */
+ message1 ("Waiting for process to die...done");
+ }
synch_process_alive = 0;
+ close (XFASTINT (Fcar (fdpid)));
return Qnil;
}
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\
-If you quit, the process is killed with SIGKILL.")
+and returns a numeric exit status or a signal description string.\n\
+If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
(nargs, args)
int nargs;
register Lisp_Object *args;
{
- Lisp_Object display, infile, buffer, path, current_dir;
+ Lisp_Object infile, buffer, current_dir, display, path;
int fd[2];
int filefd;
register int pid;
CHECK_STRING (infile, 1);
}
else
- infile = build_string ("/dev/null");
+ infile = build_string (NULL_DEVICE);
+
+ if (nargs >= 3)
+ {
+ register Lisp_Object tem;
+
+ 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;
+ /* Make sure that the child will be able to chdir to the current
+ buffer's current directory, or its unhandled equivalent. We
+ can't just have the child check for an error when it does the
+ chdir, since it's in a vfork.
+
+ We have to GCPRO around this because Fexpand_file_name,
+ Funhandled_file_name_directory, and Ffile_accessible_directory_p
+ might call a file name handling function. The argument list is
+ protected by the caller, so all we really have to worry about is
+ buffer. */
{
- register Lisp_Object tem;
- if (nargs < 3)
- buffer = Qnil;
- else
- {
- buffer = tem = args[2];
- if (!(EQ (tem, Qnil) || EQ (tem, Qt)
- || XFASTINT (tem) == 0))
- {
- buffer = Fget_buffer (tem);
- CHECK_BUFFER (buffer, 2);
- }
- }
+ struct gcpro gcpro1, gcpro2, gcpro3;
+
+ current_dir = current_buffer->directory;
+
+ GCPRO3 (infile, buffer, current_dir);
+
+ current_dir =
+ expand_and_dir_to_file
+ (Funhandled_file_name_directory (current_dir), Qnil);
+ if (NILP (Ffile_accessible_directory_p (current_dir)))
+ report_file_error ("Setting current directory",
+ Fcons (current_buffer->directory, Qnil));
+
+ UNGCPRO;
}
- display = nargs >= 3 ? args[3] : Qnil;
+ display = nargs >= 4 ? args[3] : Qnil;
{
register int i;
report_file_error ("Opening process input file", Fcons (infile, Qnil));
}
/* Search for program; barf if not found. */
- openp (Vexec_path, args[0], "", &path, 1);
+ openp (Vexec_path, args[0], EXEC_SUFFIXES, &path, 1);
if (NILP (path))
{
close (filefd);
new_argv[0] = XSTRING (path)->data;
if (XTYPE (buffer) == Lisp_Int)
- fd[1] = open ("/dev/null", O_WRONLY), fd[0] = -1;
+ fd[1] = open (NULL_DEVICE, O_WRONLY), fd[0] = -1;
else
{
pipe (fd);
#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;
-
- env = environ;
#if 0 /* Some systems don't have sigblock. */
- EMACS_SIGBLOCK (sigmask (SIGCHLD), mask);
+ mask = sigblock (sigmask (SIGCHLD));
#endif
/* Record that we're about to create a synchronous process. */
synch_process_alive = 1;
+ /* These vars record information from process termination.
+ Clear them now before process can possibly terminate,
+ to avoid timing error if process terminates soon. */
+ synch_process_death = 0;
+ synch_process_retcode = 0;
+
pid = vfork ();
if (pid == 0)
#else
setpgrp (pid, pid);
#endif /* USG */
- child_setup (filefd, fd1, fd1, new_argv, env, 0, current_dir);
+ child_setup (filefd, fd1, fd1, new_argv, 0, current_dir);
}
#if 0
return Qnil;
}
- synch_process_death = 0;
- synch_process_retcode = 0;
-
record_unwind_protect (call_process_cleanup,
Fcons (make_number (fd[0]), make_number (pid)));
}
#endif
\f
-static void
+static Lisp_Object
delete_temp_file (name)
Lisp_Object name;
{
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\
-If you quit, the process is killed with SIGKILL.")
+and returns a numeric exit status or a signal description string.\n\
+If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
(nargs, args)
int nargs;
register Lisp_Object *args;
Fdelete_region (start, end);
args[3] = filename_string;
- Fcall_process (nargs - 2, args + 2);
- return unbind_to (count, Qnil);
+ return unbind_to (count, Fcall_process (nargs - 2, args + 2));
}
\f
#ifndef VMS /* VMS version is in vmsproc.c. */
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, current_dir)
+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);
+ {
+ extern int emacs_priority;
+
+ nice (- emacs_priority);
+ }
#ifdef subprocesses
/* Close Emacs's descriptors that this process should not have. */
tem = XCONS (tem)->cdr)
new_length++;
- /* new_length + 1 to include terminating 0 */
+ /* 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_environment strings into new_env. */
for (tem = Vprocess_environment;
(XTYPE (tem) == Lisp_Cons
&& XTYPE (XCONS (tem)->car) == Lisp_String);
tem = XCONS (tem)->cdr)
- *new_env++ = (char *) XSTRING (XCONS (tem)->car)->data;
+ {
+ char **ep = env;
+ char *string = (char *) XSTRING (XCONS (tem)->car)->data;
+ /* 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: ;
+ }
*new_env = 0;
}
+ /* Make sure that in, out, and err are not actually already in
+ descriptors zero, one, or two; this could happen if Emacs is
+ started with its standard in, our, or error closed, as might
+ happen under X. */
+ in = relocate_fd (in, 3);
+ out = relocate_fd (out, 3);
+ err = relocate_fd (err, 3);
+
close (0);
close (1);
close (2);
close (err);
#ifdef USG
+#ifndef SETPGRP_RELEASES_CTTY
setpgrp (); /* No arguments but equivalent in this case */
+#endif
#else
setpgrp (pid, pid);
#endif /* USG */
_exit (1);
}
+/* 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. */
+int
+relocate_fd (fd, min)
+ int fd, min;
+{
+ if (fd >= min)
+ return fd;
+ else
+ {
+ int new = dup (fd);
+ if (new == -1)
+ {
+ char *message1 = "Error while setting up child: ";
+ char *message2 = "\n";
+ write (2, message1, strlen (message1));
+ write (2, sys_errlist[errno], strlen (sys_errlist[errno]));
+ write (2, message2, strlen (message2));
+ _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 (var, varlen, value, valuelen)
char *var;
#endif /* not VMS */
\f
+/* This is run before init_cmdargs. */
+
+init_callproc_1 ()
+{
+ 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);
+}
+
+/* This is run after init_cmdargs, so that Vinvocation_directory is valid. */
+
init_callproc ()
{
+ char *data_dir = egetenv ("EMACSDATA");
+
register char * sh;
- register char **envp;
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_path = decode_env_path ("==", PATH_EXEC);
- Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
- Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
+ if (initialized && !NILP (Vinvocation_directory))
+ {
+ /* Add to the path the ../lib-src dir of the Emacs executable,
+ if that dir exists. */
+ Lisp_Object tem, tem1;
+ tem = Fexpand_file_name (build_string ("../lib-src"),
+ Vinvocation_directory);
+ tem1 = Ffile_exists_p (tem);
+ if (!NILP (tem1) && NILP (Fmember (tem, Vexec_path)))
+ {
+ Vexec_path = nconc2 (Vexec_path, Fcons (tem, Qnil));
+ Vexec_directory = Ffile_name_as_directory (tem);
+
+ /* If we use ../lib-src, maybe use ../etc as well.
+ Do so if ../etc exists and has our DOC-... file in it. */
+ if (data_dir == 0)
+ {
+ Lisp_Object tem, tem2, tem3;
+ tem = Fexpand_file_name (build_string ("../etc"),
+ Vinvocation_directory);
+ tem2 = Fexpand_file_name (Vdoc_file_name, tem);
+ tem3 = Ffile_exists_p (tem2);
+ if (!NILP (tem3))
+ Vdata_directory = Ffile_name_as_directory (tem);
+ }
+ }
+ }
tempdir = Fdirectory_file_name (Vexec_directory);
if (access (XSTRING (tempdir)->data, 0) < 0)
sh = (char *) getenv ("SHELL");
Vshell_file_name = build_string (sh ? sh : "/bin/sh");
#endif
+}
+
+set_process_environment ()
+{
+ register char **envp;
Vprocess_environment = Qnil;
#ifndef CANNOT_DUMP
"Directory of architecture-independent files that come with GNU Emacs,\n\
intended for Emacs to use.");
+ DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory,
+ "For internal use by the build procedure only.\n\
+This is the name of the directory in which the build procedure installed\n\
+Emacs's info files; the default value for Info-default-directory-list\n\
+includes this.");
+ Vconfigure_info_directory = build_string (PATH_INFO);
+
DEFVAR_LISP ("process-environment", &Vprocess_environment,
"List of environment variables for subprocesses to inherit.\n\
Each element should be a string of the form ENVVARNAME=VALUE.\n\
#ifndef VMS
defsubr (&Scall_process);
-#endif
defsubr (&Sgetenv);
+#endif
defsubr (&Scall_process_region);
}
HCoop / bpt / emacs.git / blobdiff