#include "commands.h"
#include "insdel.h"
#include "lstream.h"
-#include <paths.h>
#include "process.h"
#include "sysdep.h"
#include "window.h"
#include "syssignal.h" /* Always include before systty.h */
#include "systty.h"
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
#define _P_NOWAIT 1 /* from process.h */
-#include <windows.h>
#include "nt.h"
#endif
-#ifdef DOS_NT
+#ifdef WIN32_NATIVE
/* When we are starting external processes we need to know whether they
take binary input (no conversion) or text input (\n is converted to
\r\n). Similarly for output: if newlines are written as \r\n then it's
text process output, otherwise it's binary. */
Lisp_Object Vbinary_process_input;
Lisp_Object Vbinary_process_output;
-#endif /* DOS_NT */
+#endif /* WIN32_NATIVE */
Lisp_Object Vshell_file_name;
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. */
int synch_process_retcode;
\f
/* Clean up when exiting Fcall_process_internal.
- On MSDOS, delete the temporary file on any kind of termination.
+ On Windows, delete the temporary file on any kind of termination.
On Unix, kill the process and any children on termination by signal. */
/* 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)
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 &&
/* #### "c-G" -- need non-consing Single-key-description */
message ("Waiting for process to die...(type C-g again to kill it instantly)");
+#ifdef WIN32_NATIVE
+ {
+ 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;
}
#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).
Lisp_Object infile, buffer, current_dir, display, path;
int fd[2];
int filefd;
+#ifdef WIN32_NATIVE
+ 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.
/* 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
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. */
- NGCPRO2 (current_dir, path); /* Caller gcprotects args[] */
current_dir = current_buffer->directory;
+ NGCPRO2 (current_dir, path); /* Caller gcprotects args[] */
current_dir = Funhandled_file_name_directory (current_dir);
current_dir = expand_and_dir_to_file (current_dir, Qnil);
#if 0
NUNGCPRO;
}
- GCPRO1 (current_dir);
+ GCPRO2 (current_dir, path);
if (nargs >= 2 && ! NILP (args[1]))
{
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)
{
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 */
-
- env = environ;
+ Protect it from permanent change. */
+ REGISTER char **save_environ = environ;
+ REGISTER int fd1 = fd[1];
+ int fd_error = fd1;
/* Record that we're about to create a synchronous process. */
synch_process_alive = 1;
fd_error = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY);
else if (STRINGP (error_file))
{
- fd_error = open ((CONST char *) XSTRING_DATA (error_file),
-#ifdef DOS_NT
+ fd_error = open ((const char *) XSTRING_DATA (error_file),
+#ifdef WIN32_NATIVE
O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
S_IREAD | S_IWRITE
-#else /* not DOS_NT */
+#else /* not WIN32_NATIVE */
O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
CREAT_MODE
-#endif /* not DOS_NT */
+#endif /* not WIN32_NATIVE */
);
}
if (fd_error < 0)
{
+ int save_errno = errno;
close (filefd);
close (fd[0]);
if (fd1 >= 0)
close (fd1);
+ errno = save_errno;
report_file_error ("Cannot open", Fcons(error_file, Qnil));
}
fork_error = Qnil;
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
pid = child_setup (filefd, fd1, fd_error, new_argv,
(char *) XSTRING_DATA (current_dir));
-#else /* not WINDOWSNT */
+ 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 WIN32_NATIVE */
pid = fork ();
if (pid == 0)
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);
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_NATIVE */
environ = save_environ;
if (!NILP (fork_error))
signal_error (Qfile_error, fork_error);
+#ifndef WIN32_NATIVE
if (pid < 0)
{
+ int save_errno = errno;
if (fd[0] >= 0)
close (fd[0]);
+ errno = save_errno;
report_file_error ("Doing fork", Qnil);
}
+#endif
if (INTP (buffer))
{
{
int nread;
- int first = 1;
int total_read = 0;
Lisp_Object instream;
struct gcpro ngcpro1;
nread = 0;
while (nread < bufsize - 1024)
{
- int this_read
+ ssize_t this_read
= Lstream_read (XLSTREAM (instream), bufptr + nread,
bufsize - nread);
if (nread == 0)
break;
-#ifdef DOS_NT
+#if 0
+#ifdef WIN32_NATIVE
/* 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)) {
}
}
#endif
+#endif
total_read += nread;
if (!NILP (display) && INTERACTIVE)
{
- first = 0;
redisplay ();
}
}
QUIT;
/* Wait for it to terminate, unless it already has. */
+#ifdef WIN32_NATIVE
+ 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
+#ifdef WIN32_NATIVE
int
#else
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;
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
int cpid;
HANDLE handles[4];
-#endif /* WINDOWSNT */
+#endif /* WIN32_NATIVE */
#ifdef SET_EMACS_PRIORITY
if (emacs_priority != 0)
nice (- emacs_priority);
#endif
-#if !defined (NO_SUBPROCESSES) && !defined (WINDOWSNT)
+ /* Under Windows, we are not in a child process at all, so we should
+ not close handles inherited from the parent -- we are the parent
+ and doing so will screw up all manner of things! Similarly, most
+ of the rest of the cleanup done in this function is not done
+ under Windows.
+
+ #### This entire child_setup() function is an utter and complete
+ piece of shit. I would rewrite it, at the very least splitting
+ out the Windows and non-Windows stuff into two completely
+ different functions; but instead I'm trying to make it go away
+ entirely, using the Lisp definition in process.el. What's left
+ is to fix up the routines in event-msw.c (and in event-Xt.c and
+ event-tty.c) to allow for stream devices to be handled correctly.
+ There isn't much to do, in fact, and I'll fix it shortly. That
+ way, the Lisp definition can be used non-interactively too. */
+#if !defined (NO_SUBPROCESSES) && !defined (WIN32_NATIVE)
/* Close Emacs's descriptors that this process should not have. */
close_process_descs ();
#endif /* not NO_SUBPROCESSES */
+#ifndef WIN32_NATIVE
close_load_descs ();
+#endif
/* Note that use of alloca is always safe here. It's obvious for systems
that do not have true vfork or that have true (stack) alloca.
}
/* 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;
+
+ 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)
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
+
+#ifdef WIN32_NATIVE
prepare_standard_handles (in, out, err, handles);
set_process_dir (current_dir);
-#else /* not WINDOWSNT */
+#else /* not WIN32_NATIVE */
/* 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, 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 */
+#endif /* not WIN32_NATIVE */
#ifdef vipc
something missing here;
#endif /* vipc */
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
/* 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);
reset_standard_handles (in, out, err, handles);
return cpid;
-#else /* not WINDOWSNT */
+#else /* not WIN32_NATIVE */
/* execvp does not accept an environment arg so the only way
to pass this environment is to set environ. Our caller
is responsible for restoring the ambient value of environ. */
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;
- }
+#endif /* not WIN32_NATIVE */
}
static int
-getenv_internal (CONST Bufbyte *var,
+getenv_internal (const Bufbyte *var,
Bytecount varlen,
Bufbyte **value,
Bytecount *valuelen)
if (STRINGP (entry)
&& XSTRING_LENGTH (entry) > varlen
&& XSTRING_BYTE (entry, varlen) == '='
-#ifdef WINDOWSNT
+#ifdef WIN32_NATIVE
/* NT environment variables are case insensitive. */
&& ! memicmp (XSTRING_DATA (entry), var, varlen)
-#else /* not WINDOWSNT */
+#else /* not WIN32_NATIVE */
&& ! memcmp (XSTRING_DATA (entry), var, varlen)
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_NATIVE */
)
{
*value = XSTRING_DATA (entry) + (varlen + 1);
/* A version of getenv that consults process_environment, easily
callable from C. */
char *
-egetenv (CONST char *var)
+egetenv (const char *var)
{
+ /* This cannot GC -- 7-28-00 ben */
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;
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);
}
-#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");
-
-#else /* not WINDOWSNT */
-
- sh = (char *) egetenv ("SHELL");
- Vshell_file_name = build_string (sh ? sh : "/bin/sh");
-
+ {
+ /* Initialize shell-file-name from environment variables or best guess. */
+#ifdef WIN32_NATIVE
+ const char *shell = egetenv ("COMSPEC");
+ if (!shell) shell = "\\WINNT\\system32\\cmd.exe";
+#else /* not WIN32_NATIVE */
+ const char *shell = egetenv ("SHELL");
+ if (!shell) shell = "/bin/sh";
#endif
+
+ Vshell_file_name = build_string (shell);
+ }
}
#if 0
void
syms_of_callproc (void)
{
- DEFSUBR (Fcall_process_internal);
+ DEFSUBR (Fold_call_process_internal);
DEFSUBR (Fgetenv);
}
vars_of_callproc (void)
{
/* This function can GC */
-#ifdef DOS_NT
+#ifdef WIN32_NATIVE
DEFVAR_LISP ("binary-process-input", &Vbinary_process_input /*
*If non-nil then new subprocesses are assumed to take binary input.
*/ );
*If non-nil then new subprocesses are assumed to produce binary output.
*/ );
Vbinary_process_output = Qnil;
-#endif /* DOS_NT */
+#endif /* WIN32_NATIVE */
DEFVAR_LISP ("shell-file-name", &Vshell_file_name /*
*File name to load inferior shells from.
The environment which Emacs inherits is placed in this variable
when Emacs starts.
*/ );
+
+ Vlisp_EXEC_SUFFIXES = build_string (EXEC_SUFFIXES);
+ staticpro (&Vlisp_EXEC_SUFFIXES);
}