-/* Synchronous subprocess invocation for XEmacs.
+/* Old synchronous subprocess invocation for XEmacs.
Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc.
This file is part of XEmacs.
/* Synched up with: Mule 2.0, FSF 19.30. */
/* Partly sync'ed with 19.36.4 */
+
+/* #### This ENTIRE file is only used in batch mode.
+
+ We only need two things to get rid of both this and ntproc.c:
+
+ -- my `stderr-proc' ws, which adds support for a separate stderr
+ in asynch. subprocesses. (it's a feature in `old-call-process-internal'.)
+ -- a noninteractive event loop that supports processes.
+*/
+
#include <config.h>
#include "lisp.h"
#include "systime.h"
#include "sysproc.h"
+#include "sysdir.h"
#include "sysfile.h" /* Always include after sysproc.h */
+#include "sysdir.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 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).
The program's input comes from file INFILE (nil means `/dev/null').
Insert output in BUFFER before point; t means current buffer;
nil for BUFFER means discard it; 0 means discard and don't wait.
+If BUFFER is a string, then find or create a buffer with that name,
+then insert the output in that buffer, before point.
BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
REAL-BUFFER says what to do with standard output, as above,
while STDERR-FILE says what to do with standard error in the child.
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.
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)
{
|| ZEROP (buffer)))
{
Lisp_Object spec_buffer = buffer;
- buffer = Fget_buffer (buffer);
+ buffer = Fget_buffer_create (buffer);
/* Mention the buffer name for a better error message. */
if (NILP (buffer))
CHECK_BUFFER (spec_buffer);
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
+ }
+#else /* not WIN32_NATIVE */
pid = fork ();
if (pid == 0)
child_setup (filefd, fd1, fd_error, new_argv,
(char *) XSTRING_DATA (current_dir));
}
- if (fd_error >= 0)
- close (fd_error);
-
-#endif /* not WINDOWSNT */
+#endif /* not WIN32_NATIVE */
environ = save_environ;
+ /* Close STDERR into the parent process. We no longer need it. */
+ if (fd_error >= 0)
+ close (fd_error);
+
/* Close most of our fd's, but not fd[0]
since we will use that to read input from. */
close (filefd);
- if (fd1 >= 0)
+ if ((fd1 >= 0) && (fd1 != fd_error))
close (fd1);
}
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)
{
- ssize_t this_read
+ Lstream_data_count 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
close (out);
close (err);
- /* I can't think of any reason why child processes need any more
- than the standard 3 file descriptors. It would be cleaner to
+ /* Close non-process-related file descriptors. It would be cleaner to
close just the ones that need to be, but the following brute
force approach is certainly effective, and not too slow. */
+
{
int fd;
- for (fd=3; fd<=64; fd++)
+
+ for (fd = 3; fd < MAXDESC; 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], (CONST char* CONST*)new_argv,
- (CONST char* CONST*)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");
- if (!shell) shell = "\\WINNT\\system32\\cmd.exe";
-#else /* not WINDOWSNT */
- CONST char *shell = egetenv ("SHELL");
+#ifdef WIN32_NATIVE
+ const char *shell = egetenv ("SHELL");
+ if (!shell) shell = egetenv ("COMSPEC");
+ /* Should never happen! */
+ if (!shell) shell = (GetVersion () & 0x80000000 ? "command" : "cmd");
+#else /* not WIN32_NATIVE */
+ const char *shell = egetenv ("SHELL");
if (!shell) shell = "/bin/sh";
#endif
+#if 0 /* defined (WIN32_NATIVE) */
+ /* BAD BAD BAD. We do not wanting to be passing an XEmacs-created
+ SHELL var down to some inferior Cygwin process, which might get
+ screwed up.
+
+ There are a few broken apps (eterm/term.el, eterm/tshell.el,
+ os-utils/terminal.el, texinfo/tex-mode.el) where this will
+ cause problems. Those broken apps don't look at
+ shell-file-name, instead just at explicit-shell-file-name,
+ ESHELL and SHELL. They are apparently attempting to borrow
+ what `M-x shell' uses, but that latter also looks at
+ shell-file-name. What we want is for all of these apps to look
+ at shell-file-name, so that the user can change the value of
+ shell-file-name and everything will work out hunky-dorey.
+ */
+
+ if (!egetenv ("SHELL"))
+ {
+ CBufbyte *faux_var = alloca_array (CBufbyte, 7 + strlen (shell));
+ sprintf (faux_var, "SHELL=%s", shell);
+ Vprocess_environment = Fcons (build_string (faux_var),
+ Vprocess_environment);
+ }
+#endif /* 0 */
+
Vshell_file_name = build_string (shell);
}
}
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.
projects / chise / xemacs-chise.git.1 / blobdiff