X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fcallproc.c;h=4b5a5dc992d61b139b6cf64510f8c1d5f8e633b3;hb=1c97bf160520f9e0b193236a902eb4b73d59d134;hp=7ebeb8db1a186cf611daf5582c7411897a39f573;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910;p=chise%2Fxemacs-chise.git.1 diff --git a/src/callproc.c b/src/callproc.c index 7ebeb8d..4b5a5dc 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -28,7 +28,6 @@ Boston, MA 02111-1307, USA. */ #include "commands.h" #include "insdel.h" #include "lstream.h" -#include #include "process.h" #include "sysdep.h" #include "window.h" @@ -82,6 +81,7 @@ int synch_process_retcode; /* Nonzero if this is termination due to exit. */ static int call_process_exited; +Lisp_Object Vlisp_EXEC_SUFFIXES; static Lisp_Object call_process_kill (Lisp_Object fdpid) @@ -194,7 +194,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you /* Do this before building new_argv because GC in Lisp code * called by various filename-hacking routines might relocate strings */ - locate_file (Vexec_path, args[0], EXEC_SUFFIXES, &path, X_OK); + locate_file (Vexec_path, args[0], Vlisp_EXEC_SUFFIXES, &path, X_OK); /* Make sure that the child will be able to chdir to the current buffer's current directory, or its unhandled equivalent. We @@ -314,19 +314,11 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you { /* 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]; - int fd_error = fd1; - char **env; - -#ifdef EMACS_BTL - /* when performance monitoring is on, turn it off before the vfork(), - as the child has no handler for the signal -- when back in the - parent process, turn it back on if it was really on when you "turned - it off" */ - int logging_on = cadillac_stop_logging (); -#endif /* EMACS_BTL */ + Protect it from permanent change. */ + REGISTER char **save_environ = environ; + REGISTER int fd1 = fd[1]; + int fd_error = fd1; + char **env; env = environ; @@ -385,10 +377,6 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you child_setup (filefd, fd1, fd_error, new_argv, (char *) XSTRING_DATA (current_dir)); } -#ifdef EMACS_BTL - else if (logging_on) - cadillac_start_logging (); -#endif if (fd_error >= 0) close (fd_error); @@ -534,9 +522,30 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you +/* Move the file descriptor FD so that its number is not less than MIN. * + The original file descriptor remains open. */ +static int +relocate_fd (int fd, int min) +{ + if (fd >= min) + return fd; + else + { + int newfd = dup (fd); + if (newfd == -1) + { + stderr_out ("Error while setting up child: %s\n", + strerror (errno)); + _exit (1); + } + return relocate_fd (newfd, min); + } +} + /* 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. + Copy descriptors IN, OUT and ERR + as descriptors STDIN_FILENO, STDOUT_FILENO, and STDERR_FILENO. Initialize inferior's priority, pgrp, connected dir and environment. then exec another program based on new_argv. @@ -554,8 +563,6 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you a decent error from within the child, this should be verified as an executable directory by the parent. */ -static int relocate_fd (int fd, int min); - #ifdef WINDOWSNT int #else @@ -620,19 +627,11 @@ child_setup (int in, int out, int err, char **new_argv, } /* Set `env' to a vector of the strings in Vprocess_environment. */ + /* + 2 to include PWD and terminating 0. */ + env = alloca_array (char *, XINT (Flength (Vprocess_environment)) + 2); { - REGISTER Lisp_Object tem; - REGISTER char **new_env; - REGISTER int new_length = 0; - - for (tem = Vprocess_environment; - (CONSP (tem) - && STRINGP (XCAR (tem))); - tem = XCDR (tem)) - new_length++; - - /* new_length + 2 to include PWD and terminating 0. */ - env = new_env = alloca_array (char *, new_length + 2); + REGISTER Lisp_Object tail; + char **new_env = env; /* If we have a PWD envvar and we know the real current directory, pass one down, but with corrected value. */ @@ -640,20 +639,23 @@ child_setup (int in, int out, int err, char **new_argv, *new_env++ = pwd; /* Copy the Vprocess_environment strings into new_env. */ - for (tem = Vprocess_environment; - (CONSP (tem) - && STRINGP (XCAR (tem))); - tem = XCDR (tem)) + for (tail = Vprocess_environment; + CONSP (tail) && STRINGP (XCAR (tail)); + tail = XCDR (tail)) { char **ep = env; - char *string = (char *) XSTRING_DATA (XCAR (tem)); - /* See if this string duplicates any string already in the env. + char *envvar_external; + Bufbyte *envvar_internal = XSTRING_DATA (XCAR (tail)); + + GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (envvar_internal, envvar_external); + + /* See if envvar_external 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; + char *p = *ep, *q = envvar_external; while (1) { if (*q == 0) @@ -666,17 +668,19 @@ child_setup (int in, int out, int err, char **new_argv, p++, q++; } } - if (pwd && !strncmp ("PWD=", string, 4)) + if (pwd && !strncmp ("PWD=", envvar_external, 4)) { *new_env++ = pwd; pwd = 0; } else - *new_env++ = string; + *new_env++ = envvar_external; + duplicate: ; } *new_env = 0; } + #ifdef WINDOWSNT prepare_standard_handles (in, out, err, handles); set_process_dir (current_dir); @@ -685,28 +689,18 @@ child_setup (int in, int out, int err, char **new_argv, descriptors zero, one, or two; this could happen if Emacs is started with its standard in, out, or error closed, as might happen under X. */ - { - int oin = in, oout = out; - - /* We have to avoid relocating the same descriptor twice! */ - - in = relocate_fd (in, 3); - - if (out == oin) out = in; - else out = relocate_fd (out, 3); - - if (err == oin) err = in; - else if (err == oout) err = out; - else err = relocate_fd (err, 3); - } + in = relocate_fd (in, 3); + out = relocate_fd (out, 3); + err = relocate_fd (err, 3); - close (0); - close (1); - close (2); + /* Set the standard input/output channels of the new process. */ + close (STDIN_FILENO); + close (STDOUT_FILENO); + close (STDERR_FILENO); - dup2 (in, 0); - dup2 (out, 1); - dup2 (err, 2); + dup2 (in, STDIN_FILENO); + dup2 (out, STDOUT_FILENO); + dup2 (err, STDERR_FILENO); close (in); close (out); @@ -719,9 +713,7 @@ child_setup (int in, int out, int err, char **new_argv, { int fd; for (fd=3; fd<=64; fd++) - { - close(fd); - } + close (fd); } #endif /* not WINDOWSNT */ @@ -731,7 +723,8 @@ child_setup (int in, int out, int err, char **new_argv, #ifdef WINDOWSNT /* Spawn the child. (See ntproc.c:Spawnve). */ - cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env); + cpid = spawnve (_P_NOWAIT, new_argv[0], (CONST char* CONST*)new_argv, + (CONST char* CONST*)env); if (cpid == -1) /* An error occurred while trying to spawn the process. */ report_file_error ("Spawning child process", Qnil); @@ -744,35 +737,11 @@ child_setup (int in, int out, int err, char **new_argv, environ = env; execvp (new_argv[0], new_argv); - stdout_out ("Cant't exec program %s\n", new_argv[0]); + stdout_out ("Can't exec program %s\n", new_argv[0]); _exit (1); #endif /* not WINDOWSNT */ } -/* 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. */ -static int -relocate_fd (int fd, int min) -{ - if (fd >= min) - return fd; - else - { - int new = dup (fd); - if (new == -1) - { - stderr_out ("Error while setting up child: %s\n", - strerror (errno)); - _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 (CONST Bufbyte *var, Bytecount varlen, @@ -853,13 +822,12 @@ void init_callproc (void) { /* This function can GC */ - REGISTER char *sh; - Vprocess_environment = Qnil; - /* jwz: always initialize Vprocess_environment, so that egetenv() works - in temacs. */ { + /* jwz: always initialize Vprocess_environment, so that egetenv() + works in temacs. */ char **envp; + Vprocess_environment = Qnil; for (envp = environ; envp && *envp; envp++) { Vprocess_environment = Fcons (build_ext_string (*envp, FORMAT_OS), @@ -867,32 +835,18 @@ init_callproc (void) } } + { + /* Initialize shell-file-name from environment variables or best guess. */ #ifdef WINDOWSNT - /* Sync with FSF Emacs 19.34.6 note: this is not in 19.34.6. --marcpa */ - /* - ** If NT then we look at COMSPEC for the shell program. - */ - sh = egetenv ("COMSPEC"); - /* - ** If COMSPEC has been set, then convert the - ** DOS formatted name into a UNIX format. Then - ** create a LISP object. - */ - if (sh) - Vshell_file_name = build_string (sh); - /* - ** Odd, no COMSPEC, so let's default to our - ** best guess for NT. - */ - else - Vshell_file_name = build_string ("\\WINNT\\system32\\cmd.exe"); - + CONST char *shell = egetenv ("COMSPEC"); + if (!shell) shell = "\\WINNT\\system32\\cmd.exe"; #else /* not WINDOWSNT */ - - sh = (char *) egetenv ("SHELL"); - Vshell_file_name = build_string (sh ? sh : "/bin/sh"); - + CONST char *shell = egetenv ("SHELL"); + if (!shell) shell = "/bin/sh"; #endif + + Vshell_file_name = build_string (shell); + } } #if 0 @@ -945,4 +899,7 @@ Each element should be a string of the form ENVVARNAME=VALUE. The environment which Emacs inherits is placed in this variable when Emacs starts. */ ); + + Vlisp_EXEC_SUFFIXES = build_string (EXEC_SUFFIXES); + staticpro (&Vlisp_EXEC_SUFFIXES); }