X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fcallproc.c;h=1ce04b012e8628aa78c66faaff5e3bb21d6c64ed;hb=975655e6b5b1526ee82b159b3eadf69888c42090;hp=b2c3061c51fbb421e1755c62065a26351ba4ca64;hpb=77dcef404dc78635f6ffa8f71a803d2bc7cc8921;p=chise%2Fxemacs-chise.git- diff --git a/src/callproc.c b/src/callproc.c index b2c3061..1ce04b0 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -43,7 +43,6 @@ Boston, MA 02111-1307, USA. */ #ifdef WINDOWSNT #define _P_NOWAIT 1 /* from process.h */ -#include #include "nt.h" #endif @@ -68,7 +67,7 @@ Lisp_Object Vprocess_environment; volatile int synch_process_alive; /* Nonzero => this is a string explaining death of synchronous subprocess. */ -CONST char *synch_process_death; +const char *synch_process_death; /* If synch_process_death is zero, this is exit code of synchronous subprocess. */ @@ -81,6 +80,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) @@ -101,7 +101,7 @@ call_process_kill (Lisp_Object fdpid) static Lisp_Object call_process_cleanup (Lisp_Object fdpid) { - int fd = XINT (Fcar (fdpid)); + int fd = XINT (Fcar (fdpid)); int pid = XINT (Fcdr (fdpid)); if (!call_process_exited && @@ -113,7 +113,18 @@ call_process_cleanup (Lisp_Object fdpid) /* #### "c-G" -- need non-consing Single-key-description */ message ("Waiting for process to die...(type C-g again to kill it instantly)"); +#ifdef WINDOWSNT + { + HANDLE pHandle = OpenProcess (PROCESS_ALL_ACCESS, 0, pid); + if (pHandle == NULL) + warn_when_safe (Qprocess, Qwarning, + "cannot open process (PID %d) for cleanup", pid); + else + wait_for_termination (pHandle); + } +#else wait_for_termination (pid); +#endif /* "Discard" the unwind protect. */ XCAR (fdpid) = Qnil; @@ -141,7 +152,7 @@ report_fork_error (char *string, Lisp_Object data) } #endif /* unused */ -DEFUN ("call-process-internal", Fcall_process_internal, 1, MANY, 0, /* +DEFUN ("old-call-process-internal", Fold_call_process_internal, 1, MANY, 0, /* Call PROGRAM synchronously in separate process, with coding-system specified. Arguments are (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS). @@ -169,12 +180,15 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you Lisp_Object infile, buffer, current_dir, display, path; int fd[2]; int filefd; +#ifdef WINDOWSNT + HANDLE pHandle; +#endif int pid; char buf[16384]; char *bufptr = buf; int bufsize = 16384; int speccount = specpdl_depth (); - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1, gcpro2, gcpro3; char **new_argv = alloca_array (char *, max (2, nargs - 2)); /* File to use for stderr in the child. @@ -193,7 +207,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 @@ -221,7 +235,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you NUNGCPRO; } - GCPRO1 (current_dir); + GCPRO2 (current_dir, path); if (nargs >= 2 && ! NILP (args[1])) { @@ -236,7 +250,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you UNGCPRO; - GCPRO2 (infile, current_dir); /* Fexpand_file_name might trash it */ + GCPRO3 (infile, current_dir, path); /* Fexpand_file_name might trash it */ if (nargs >= 3) { @@ -286,8 +300,8 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you CHECK_STRING (args[i]); new_argv[i - 3] = (char *) XSTRING_DATA (args[i]); } - new_argv[nargs - 3] = 0; } + new_argv[max(nargs - 3,1)] = 0; if (NILP (path)) report_file_error ("Searching for program", Fcons (args[0], Qnil)); @@ -334,7 +348,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you fd_error = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY); else if (STRINGP (error_file)) { - fd_error = open ((CONST char *) XSTRING_DATA (error_file), + fd_error = open ((const char *) XSTRING_DATA (error_file), #ifdef DOS_NT O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, S_IREAD | S_IWRITE @@ -358,6 +372,23 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you #ifdef WINDOWSNT pid = child_setup (filefd, fd1, fd_error, new_argv, (char *) XSTRING_DATA (current_dir)); + if (!INTP (buffer)) + { + /* OpenProcess() as soon after child_setup as possible. It's too + late once the process terminated. */ + pHandle = OpenProcess(PROCESS_ALL_ACCESS, 0, pid); +#if 0 + if (pHandle == NULL) + { + /* #### seems to cause crash in unbind_to(...) below. APA */ + warn_when_safe (Qprocess, Qwarning, + "cannot open process to wait for"); + } +#endif + } + /* Close STDERR into the parent process. We no longer need it. */ + if (fd_error >= 0) + close (fd_error); #else /* not WINDOWSNT */ pid = fork (); @@ -393,12 +424,14 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you if (!NILP (fork_error)) signal_error (Qfile_error, fork_error); +#ifndef WINDOWSNT if (pid < 0) { if (fd[0] >= 0) close (fd[0]); report_file_error ("Doing fork", Qnil); } +#endif if (INTP (buffer)) { @@ -449,7 +482,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you nread = 0; while (nread < bufsize - 1024) { - int this_read + ssize_t this_read = Lstream_read (XLSTREAM (instream), bufptr + nread, bufsize - nread); @@ -468,10 +501,12 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you if (nread == 0) break; +#if 0 #ifdef DOS_NT /* Until we pull out of MULE things like make_decoding_input_stream(), we do the following which is less elegant. --marcpa */ + /* We did. -- kkm */ { int lf_count = 0; if (NILP (Vbinary_process_output)) { @@ -479,6 +514,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you } } #endif +#endif total_read += nread; @@ -506,7 +542,11 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you QUIT; /* Wait for it to terminate, unless it already has. */ +#ifdef WINDOWSNT + wait_for_termination (pHandle); +#else wait_for_termination (pid); +#endif /* Don't kill any children that the subprocess may have left behind when exiting. */ @@ -568,7 +608,7 @@ int void #endif child_setup (int in, int out, int err, char **new_argv, - CONST char *current_dir) + const char *current_dir) { char **env; char *pwd; @@ -626,19 +666,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. */ @@ -646,20 +678,24 @@ 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; + + TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (tail), + C_STRING_ALLOCA, envvar_external, + Qfile_name); + + /* 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) @@ -672,17 +708,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); @@ -699,11 +737,11 @@ child_setup (int in, int out, int err, char **new_argv, close (STDIN_FILENO); close (STDOUT_FILENO); close (STDERR_FILENO); - + dup2 (in, STDIN_FILENO); dup2 (out, STDOUT_FILENO); dup2 (err, STDERR_FILENO); - + close (in); close (out); close (err); @@ -725,7 +763,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,7 +783,7 @@ child_setup (int in, int out, int err, char **new_argv, } static int -getenv_internal (CONST Bufbyte *var, +getenv_internal (const Bufbyte *var, Bytecount varlen, Bufbyte **value, Bytecount *valuelen) @@ -807,12 +846,12 @@ When invoked interactively, prints the value in the echo area. /* A version of getenv that consults process_environment, easily callable from C. */ char * -egetenv (CONST char *var) +egetenv (const char *var) { Bufbyte *value; Bytecount valuelen; - if (getenv_internal ((CONST Bufbyte *) var, strlen (var), &value, &valuelen)) + if (getenv_internal ((const Bufbyte *) var, strlen (var), &value, &valuelen)) return (char *) value; else return 0; @@ -823,46 +862,29 @@ 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), - Vprocess_environment); - } + Vprocess_environment = + Fcons (build_ext_string (*envp, Qfile_name), Vprocess_environment); } + { + /* 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 @@ -884,7 +906,7 @@ set_process_environment (void) void syms_of_callproc (void) { - DEFSUBR (Fcall_process_internal); + DEFSUBR (Fold_call_process_internal); DEFSUBR (Fgetenv); } @@ -915,4 +937,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); }