#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));
REGISTER char **save_environ = environ;
REGISTER int fd1 = fd[1];
int fd_error = fd1;
- char **env;
-
- env = environ;
/* 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)
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. */
a decent error from within the child, this should be verified as an
executable directory by the parent. */
-#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.
{
char **ep = env;
char *envvar_external;
- Bufbyte *envvar_internal = XSTRING_DATA (XCAR (tail));
- GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (envvar_internal, 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.
*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
for (fd=3; fd<=64; 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 */
+#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;
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
- CONST char *shell = egetenv ("COMSPEC");
+#ifdef WIN32_NATIVE
+ const char *shell = egetenv ("COMSPEC");
if (!shell) shell = "\\WINNT\\system32\\cmd.exe";
-#else /* not WINDOWSNT */
- CONST char *shell = egetenv ("SHELL");
+#else /* not WIN32_NATIVE */
+ const char *shell = egetenv ("SHELL");
if (!shell) shell = "/bin/sh";
#endif
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);
}