#include "commands.h"
#include "insdel.h"
#include "lstream.h"
-#include <paths.h>
#include "process.h"
#include "sysdep.h"
#include "window.h"
/* 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)
{
int fd = XINT (Fcar (fdpid));
int pid = XINT (Fcdr (fdpid));
+#ifdef WINDOWSNT
+ HANDLE pHandle;
+#endif
if (!call_process_exited &&
EMACS_KILLPG (pid, SIGINT) == 0)
/* #### "c-G" -- need non-consing Single-key-description */
message ("Waiting for process to die...(type C-g again to kill it instantly)");
+#ifdef WINDOWSNT
+ pHandle = OpenProcess(PROCESS_ALL_ACCESS, 0, pid);
+ if (pHandle == NULL)
+ {
+ warn_when_safe (Qprocess, Qwarning,
+ "cannot open process (PID %d) for cleanup", pid);
+ }
+ wait_for_termination (pHandle);
+#else
wait_for_termination (pid);
+#endif
/* "Discard" the unwind protect. */
XCAR (fdpid) = Qnil;
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;
/* 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
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));
{
/* 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;
#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 ();
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);
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))
{
nread = 0;
while (nread < bufsize - 1024)
{
- int this_read
+ ssize_t this_read
= Lstream_read (XLSTREAM (instream), bufptr + nread,
bufsize - nread);
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. */
\f
+/* 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.
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
}
/* 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. */
*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)
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);
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);
{
int fd;
for (fd=3; fd<=64; fd++)
- {
- close(fd);
- }
+ close (fd);
}
#endif /* not WINDOWSNT */
#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);
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,
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),
}
}
+ {
+ /* 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
The environment which Emacs inherits is placed in this variable
when Emacs starts.
*/ );
+
+ Vlisp_EXEC_SUFFIXES = build_string (EXEC_SUFFIXES);
+ staticpro (&Vlisp_EXEC_SUFFIXES);
}