X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/4f0b9d499478e7f2726daba7a4d2f35b50ad3301..08b0527265bf9b87f47403191a3d5c0877f86b4b:/src/callproc.c diff --git a/src/callproc.c b/src/callproc.c index 779d16faaa..8d43ffe67f 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1,5 +1,5 @@ /* 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. @@ -21,7 +21,12 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include #include -#include "config.h" +#include + +extern int errno; +#ifndef VMS +extern char *sys_errlist[]; +#endif /* Define SIGCHLD as an alias for SIGCLD. */ @@ -30,7 +35,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #endif /* SIGCLD */ #include -#define PRIO_PROCESS 0 + #include #ifdef USG5 #include @@ -47,8 +52,9 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "lisp.h" #include "commands.h" #include "buffer.h" -#include "paths.h" +#include #include "process.h" +#include "syssignal.h" #ifdef VMS extern noshare char **environ; @@ -59,6 +65,7 @@ extern 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; @@ -74,19 +81,41 @@ char *synch_process_death; /* If synch_process_death is zero, this is exit code of synchronous subprocess. */ int synch_process_retcode; + +extern Lisp_Object Vdoc_file_name; #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; } @@ -100,12 +129,12 @@ Remaining arguments are strings passed as command arguments to PROGRAM.\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 description string.\n\ -If you quit, the process is killed with SIGKILL.") +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; @@ -125,11 +154,7 @@ If you quit, the process is killed with SIGKILL.") CHECK_STRING (infile, 1); } else -#ifdef VMS - infile = build_string ("NLA0:"); -#else - infile = build_string ("/dev/null"); -#endif /* not VMS */ + infile = build_string (NULL_DEVICE); if (nargs >= 3) { @@ -147,6 +172,33 @@ If you quit, the process is killed with SIGKILL.") 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. */ + { + 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 >= 4 ? args[3] : Qnil; { @@ -167,7 +219,7 @@ If you quit, the process is killed with SIGKILL.") 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); @@ -176,7 +228,7 @@ If you quit, the process is killed with SIGKILL.") 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); @@ -186,14 +238,6 @@ If you quit, the process is killed with SIGKILL.") #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. */ @@ -207,6 +251,12 @@ If you quit, the process is killed with SIGKILL.") /* 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) @@ -251,9 +301,6 @@ If you quit, the process is killed with SIGKILL.") return Qnil; } - synch_process_death = 0; - synch_process_retcode = 0; - record_unwind_protect (call_process_cleanup, Fcons (make_number (fd[0]), make_number (pid))); @@ -294,7 +341,7 @@ If you quit, the process is killed with SIGKILL.") } #endif -static void +static Lisp_Object delete_temp_file (name) Lisp_Object name; { @@ -312,7 +359,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 description string.\n\ -If you quit, the process is killed with SIGKILL.") +If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.") (nargs, args) int nargs; register Lisp_Object *args; @@ -338,9 +385,8 @@ If you quit, the process is killed with SIGKILL.") 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)); } #ifndef VMS /* VMS version is in vmsproc.c. */ @@ -423,18 +469,50 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir) 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 Vprocess_alist 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); @@ -447,7 +525,9 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir) close (err); #ifdef USG +#ifndef SETPGRP_RELEASES_CTTY setpgrp (); /* No arguments but equivalent in this case */ +#endif #else setpgrp (pid, pid); #endif /* USG */ @@ -468,6 +548,34 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir) _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; @@ -530,25 +638,59 @@ egetenv (var) #endif /* not VMS */ -init_callproc () -{ - register char * sh; - register char **envp; - Lisp_Object tempdir; +/* This is run before init_cmdargs. */ - { - char *data_dir = egetenv ("EMACSDATA"); +init_callproc_1 () +{ + char *data_dir = egetenv ("EMACSDATA"); - Vdata_directory = - Ffile_name_as_directory - (build_string (data_dir ? data_dir : PATH_DATA)); - } + 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; + Lisp_Object tempdir; + + 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) @@ -572,6 +714,11 @@ init_callproc () 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 @@ -600,6 +747,13 @@ especially executable programs intended for Emacs to invoke."); "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\ @@ -608,7 +762,7 @@ when Emacs starts."); #ifndef VMS defsubr (&Scall_process); -#endif defsubr (&Sgetenv); +#endif defsubr (&Scall_process_region); }