/* Synchronous subprocess invocation for GNU Emacs.
- Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 Free Software Foundation, Inc.
+ Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <signal.h>
#include <errno.h>
-#include <stdio.h>
#include <config.h>
+#include <stdio.h>
extern int errno;
extern char *strerror ();
#include <sys/file.h>
#ifdef USG5
+#define INCLUDED_FCNTL
+#include <fcntl.h>
+#endif
+
+#ifdef WINDOWSNT
+#define NOMINMAX
+#include <windows.h>
+#include <stdlib.h> /* for proper declaration of environ */
#include <fcntl.h>
+#include "nt.h"
+#define _P_NOWAIT 1 /* from process.h */
#endif
#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
+#include "msdos.h"
+#define INCLUDED_FCNTL
#include <fcntl.h>
#include <sys/stat.h>
#include <sys/param.h>
#define max(a, b) ((a) > (b) ? (a) : (b))
-#ifdef MSDOS
-Lisp_Object Vbinary_process;
-#endif
+#ifdef DOS_NT
+/* 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). Similar 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 */
Lisp_Object Vexec_path, Vexec_directory, Vdata_directory, Vdoc_directory;
Lisp_Object Vconfigure_info_directory;
Lisp_Object Vprocess_environment;
+#ifdef DOS_NT
+Lisp_Object Qbuffer_file_type;
+#endif /* DOS_NT */
+
/* True iff we are about to fork off a synchronous process or if we
are waiting for it. */
int synch_process_alive;
The program's input comes from file INFILE (nil means `/dev/null').\n\
Insert output in BUFFER before point; t means current buffer;\n\
nil for BUFFER means discard it; 0 means discard and don't wait.\n\
+BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
+REAL-BUFFER says what to do with standard output, as above,\n\
+while STDERR-FILE says what to do with standard error in the child.\n\
+STDERR-FILE may be nil (discard standard error output),\n\
+t (mix it with ordinary output), or a file name string.\n\
+\n\
Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
Remaining arguments are strings passed as command arguments to PROGRAM.\n\
-If BUFFER is 0, returns immediately with value nil.\n\
-Otherwise waits for PROGRAM to terminate\n\
+\n\
+If BUFFER is 0, `call-process' returns immediately with value nil.\n\
+Otherwise it waits for PROGRAM to terminate\n\
and returns a numeric exit status or a signal description string.\n\
If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
(nargs, args)
int fd[2];
int filefd;
register int pid;
- char buf[1024];
+ char buf[16384];
+ char *bufptr = buf;
+ int bufsize = 16384;
int count = specpdl_ptr - specpdl;
register unsigned char **new_argv
= (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
struct buffer *old = current_buffer;
+ /* File to use for stderr in the child.
+ t means use same as standard output. */
+ Lisp_Object error_file;
#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
char *outf, *tempfile;
int outfilefd;
#endif
CHECK_STRING (args[0], 0);
+ error_file = Qt;
+
#ifndef subprocesses
/* Without asynchronous processes we cannot have BUFFER == 0. */
- if (nargs >= 3 && XTYPE (args[2]) == Lisp_Int)
+ if (nargs >= 3 && INTEGERP (args[2]))
error ("Operating system cannot handle asynchronous subprocesses");
#endif /* subprocesses */
if (nargs >= 3)
{
- register Lisp_Object tem;
+ buffer = args[2];
- buffer = tem = args[2];
- if (!(EQ (tem, Qnil)
- || EQ (tem, Qt)
- || XFASTINT (tem) == 0))
+ /* If BUFFER is a list, its meaning is
+ (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
+ if (CONSP (buffer))
{
- buffer = Fget_buffer (tem);
+ if (CONSP (XCONS (buffer)->cdr))
+ error_file = Fexpand_file_name (XCONS (XCONS (buffer)->cdr)->car,
+ Qnil);
+ buffer = XCONS (buffer)->car;
+ }
+
+ if (!(EQ (buffer, Qnil)
+ || EQ (buffer, Qt)
+ || XFASTINT (buffer) == 0))
+ {
+ Lisp_Object spec_buffer;
+ spec_buffer = buffer;
+ buffer = Fget_buffer (buffer);
+ /* Mention the buffer name for a better error message. */
+ if (NILP (buffer))
+ CHECK_BUFFER (spec_buffer, 2);
CHECK_BUFFER (buffer, 2);
}
}
}
#ifdef MSDOS /* MW, July 1993 */
- /* These vars record information from process termination.
- Clear them now before process can possibly terminate,
- to avoid timing error if process terminates soon. */
- synch_process_death = 0;
- synch_process_retcode = 0;
-
if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP")))
strcpy (tempfile = alloca (strlen (outf) + 20), outf);
else
close (filefd);
report_file_error ("Opening process output file", Fcons (tempfile, Qnil));
}
+ fd[1] = outfilefd;
#endif
- if (XTYPE (buffer) == Lisp_Int)
+ if (INTEGERP (buffer))
fd[1] = open (NULL_DEVICE, O_WRONLY), fd[0] = -1;
else
{
#ifndef MSDOS
+#ifdef WINDOWSNT
+ pipe_with_inherited_out (fd);
+#else /* not WINDOWSNT */
pipe (fd);
+#endif /* not WINDOWSNT */
#endif
#if 0
/* Replaced by close_process_descs */
Protect it from permanent change. */
register char **save_environ = environ;
register int fd1 = fd[1];
+ int fd_error = fd1;
#if 0 /* Some systems don't have sigblock. */
mask = sigblock (sigmask (SIGCHLD));
synch_process_death = 0;
synch_process_retcode = 0;
+ if (NILP (error_file))
+ fd_error = open (NULL_DEVICE, O_WRONLY);
+ else if (STRINGP (error_file))
+ {
+#ifdef DOS_NT
+ fd_error = open (XSTRING (error_file)->data,
+ O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
+ S_IREAD | S_IWRITE);
+#else /* not DOS_NT */
+ fd_error = creat (XSTRING (error_file)->data, 0666);
+#endif /* not DOS_NT */
+ }
+
+ if (fd_error < 0)
+ {
+ close (filefd);
+ close (fd[0]);
+ if (fd1 >= 0)
+ close (fd1);
+ report_file_error ("Cannot open", error_file);
+ }
#ifdef MSDOS /* MW, July 1993 */
/* ??? Someone who knows MSDOG needs to check whether this properly
- closes all descriptors that it opens. */
- pid = run_msdos_command (new_argv, current_dir, filefd, outfilefd);
+ closes all descriptors that it opens.
+
+ Note that run_msdos_command() actually returns the child process
+ exit status, not its PID, so we assign it to `synch_process_retcode'
+ below. */
+ pid = run_msdos_command (new_argv, current_dir,
+ filefd, outfilefd, fd_error);
+
+ /* Record that the synchronous process exited and note its
+ termination status. */
+ synch_process_alive = 0;
+ synch_process_retcode = pid;
+ if (synch_process_retcode < 0) /* means it couldn't be exec'ed */
+ synch_process_death = strerror(errno);
+
close (outfilefd);
+ if (fd_error != outfilefd)
+ close (fd_error);
fd1 = -1; /* No harm in closing that one! */
- fd[0] = open (tempfile, NILP (Vbinary_process) ? O_TEXT : O_BINARY);
+ fd[0] = open (tempfile, NILP (Vbinary_process_output) ? O_TEXT : O_BINARY);
if (fd[0] < 0)
{
unlink (tempfile);
report_file_error ("Cannot re-open temporary file", Qnil);
}
#else /* not MSDOS */
+#ifdef WINDOWSNT
+ pid = child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir);
+#else /* not WINDOWSNT */
pid = vfork ();
if (pid == 0)
#else
setpgrp (pid, pid);
#endif /* USG */
- child_setup (filefd, fd1, fd1, new_argv, 0, current_dir);
+ child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir);
}
+#endif /* not WINDOWSNT */
#endif /* not MSDOS */
environ = save_environ;
report_file_error ("Doing vfork", Qnil);
}
- if (XTYPE (buffer) == Lisp_Int)
+ if (INTEGERP (buffer))
{
if (fd[0] >= 0)
close (fd[0]);
#endif /* not MSDOS */
- if (XTYPE (buffer) == Lisp_Buffer)
+ if (BUFFERP (buffer))
Fset_buffer (buffer);
immediate_quit = 1;
{
register int nread;
int first = 1;
+ int total_read = 0;
- while ((nread = read (fd[0], buf, sizeof buf)) > 0)
+ while (1)
{
+ /* Repeatedly read until we've filled as much as possible
+ of the buffer size we have. But don't read
+ less than 1024--save that for the next bufferful. */
+
+ nread = 0;
+ while (nread < bufsize - 1024)
+ {
+ int this_read
+ = read (fd[0], bufptr + nread, bufsize - nread);
+
+ if (this_read < 0)
+ goto give_up;
+
+ if (this_read == 0)
+ goto give_up_1;
+
+ nread += this_read;
+ }
+
+ give_up_1:
+
+ /* Now NREAD is the total amount of data in the buffer. */
+ if (nread == 0)
+ break;
+
immediate_quit = 0;
+ total_read += nread;
+
if (!NILP (buffer))
- insert (buf, nread);
+ insert (bufptr, nread);
+
+ /* Make the buffer bigger as we continue to read more data,
+ but not past 64k. */
+ if (bufsize < 64 * 1024 && total_read > 32 * bufsize)
+ {
+ bufsize *= 2;
+ bufptr = (char *) alloca (bufsize);
+ }
+
if (!NILP (display) && INTERACTIVE)
{
if (first)
immediate_quit = 1;
QUIT;
}
+ give_up: ;
}
/* Wait for it to terminate, unless it already has. */
delete_temp_file (name)
Lisp_Object name;
{
- unlink (XSTRING (name)->data);
+ /* Use Fdelete_file (indirectly) because that runs a file name handler.
+ We did that when writing the file, so we should do so when deleting. */
+ internal_delete_file (name);
}
DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
3, MANY, 0,
"Send text from START to END to a synchronous process running PROGRAM.\n\
Delete the text if fourth arg DELETE is non-nil.\n\
+\n\
Insert output in BUFFER before point; t means current buffer;\n\
nil for BUFFER means discard it; 0 means discard and don't wait.\n\
+BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
+REAL-BUFFER says what to do with standard output, as above,\n\
+while STDERR-FILE says what to do with standard error in the child.\n\
+STDERR-FILE may be nil (discard standard error output),\n\
+t (mix it with ordinary output), or a file name string.\n\
+\n\
Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
Remaining args are passed to PROGRAM at startup as command args.\n\
-If BUFFER is nil, returns immediately with value nil.\n\
-Otherwise waits for PROGRAM to terminate\n\
+\n\
+If BUFFER is nil, `call-process-region' returns immediately with value nil.\n\
+Otherwise it waits for PROGRAM to terminate\n\
and returns a numeric exit status or a signal description string.\n\
If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
(nargs, args)
int nargs;
register Lisp_Object *args;
{
- register Lisp_Object filename_string, start, end;
-#ifdef MSDOS
+ struct gcpro gcpro1;
+ Lisp_Object filename_string;
+ register Lisp_Object start, end;
+#ifdef DOS_NT
char *tempfile;
#else
char tempfile[20];
#endif
int count = specpdl_ptr - specpdl;
-#ifdef MSDOS
+#ifdef DOS_NT
char *outf = '\0';
if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP")))
*tempfile = '\0';
}
dostounix_filename (tempfile);
- if (tempfile[strlen (tempfile) - 1] != '/')
+ if (!IS_DIRECTORY_SEP (tempfile[strlen (tempfile) - 1]))
strcat (tempfile, "/");
+#ifdef WINDOWSNT
+ strcat (tempfile, "emXXXXXX");
+#else
strcat (tempfile, "detmp.XXX");
-#else /* not MSDOS */
+#endif
+#else /* not DOS_NT */
#ifdef VMS
strcpy (tempfile, "tmp:emacsXXXXXX.");
#else
strcpy (tempfile, "/tmp/emacsXXXXXX");
#endif
-#endif /* not MSDOS */
+#endif /* not DOS_NT */
mktemp (tempfile);
filename_string = build_string (tempfile);
+ GCPRO1 (filename_string);
start = args[0];
end = args[1];
- Fwrite_region (start, end, filename_string, Qnil, Qlambda);
+#ifdef DOS_NT
+ specbind (Qbuffer_file_type, Vbinary_process_input);
+ Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil);
+ unbind_to (count, Qnil);
+#else /* not DOS_NT */
+ Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil);
+#endif /* not DOS_NT */
+
record_unwind_protect (delete_temp_file, filename_string);
if (!NILP (args[3]))
args[3] = filename_string;
- return unbind_to (count, Fcall_process (nargs - 2, args + 2));
+ RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs - 2, args + 2)));
}
\f
#ifndef VMS /* VMS version is in vmsproc.c. */
instead. */
#else /* not MSDOS */
char **env;
+ char *pwd_var;
+#ifdef WINDOWSNT
+ int cpid;
+ HANDLE handles[4];
+#endif /* WINDOWSNT */
int pid = getpid ();
+#ifdef SET_EMACS_PRIORITY
{
extern int emacs_priority;
- nice (- emacs_priority);
+ if (emacs_priority < 0)
+ nice (- emacs_priority);
}
+#endif
#ifdef subprocesses
/* Close Emacs's descriptors that this process should not have. */
the superior's static variables as if the superior had done alloca
and will be cleaned up in the usual way. */
{
- register unsigned char *temp;
+ register char *temp;
register int i;
i = XSTRING (current_dir)->size;
- temp = (unsigned char *) alloca (i + 2);
+ pwd_var = (char *) alloca (i + 6);
+ temp = pwd_var + 4;
+ bcopy ("PWD=", pwd_var, 4);
bcopy (XSTRING (current_dir)->data, temp, i);
- if (temp[i - 1] != '/') temp[i++] = '/';
+ if (!IS_DIRECTORY_SEP (temp[i - 1])) temp[i++] = DIRECTORY_SEP;
temp[i] = 0;
/* We can't signal an Elisp error here; we're in a vfork. Since
are changed between the check and this chdir, but we should
at least check. */
if (chdir (temp) < 0)
- exit (errno);
+ _exit (errno);
+
+ /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
+ while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
+ temp[--i] = 0;
}
/* Set `env' to a vector of the strings in Vprocess_environment. */
new_length = 0;
for (tem = Vprocess_environment;
- (XTYPE (tem) == Lisp_Cons
- && XTYPE (XCONS (tem)->car) == Lisp_String);
+ CONSP (tem) && STRINGP (XCONS (tem)->car);
tem = XCONS (tem)->cdr)
new_length++;
- /* new_length + 1 to include terminating 0. */
- env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *));
+ /* new_length + 2 to include PWD and terminating 0. */
+ env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *));
+
+ /* If we have a PWD envvar, pass one down,
+ but with corrected value. */
+ if (getenv ("PWD"))
+ *new_env++ = pwd_var;
/* Copy the Vprocess_environment strings into new_env. */
for (tem = Vprocess_environment;
- (XTYPE (tem) == Lisp_Cons
- && XTYPE (XCONS (tem)->car) == Lisp_String);
+ CONSP (tem) && STRINGP (XCONS (tem)->car);
tem = XCONS (tem)->cdr)
{
char **ep = env;
}
*new_env = 0;
}
-
+#ifdef WINDOWSNT
+ prepare_standard_handles (in, out, err, handles);
+#else /* not WINDOWSNT */
/* 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. */
- in = relocate_fd (in, 3);
- out = relocate_fd (out, 3);
- err = relocate_fd (err, 3);
+ {
+ 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);
+ }
close (0);
close (1);
close (in);
close (out);
close (err);
+#endif /* not WINDOWSNT */
#ifdef USG
#ifndef SETPGRP_RELEASES_CTTY
something missing here;
#endif /* vipc */
+#ifdef WINDOWSNT
+ /* Spawn the child. (See ntproc.c:Spawnve). */
+ cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, 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 */
/* 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. */
environ = env;
execvp (new_argv[0], new_argv);
- write (1, "Couldn't exec the program ", 26);
+ write (1, "Can't exec program: ", 26);
write (1, new_argv[0], strlen (new_argv[0]));
+ write (1, "\n", 1);
_exit (1);
+#endif /* not WINDOWSNT */
#endif /* not MSDOS */
}
Lisp_Object entry;
entry = XCONS (scan)->car;
- if (XTYPE (entry) == Lisp_String
+ if (STRINGP (entry)
&& XSTRING (entry)->size > varlen
&& XSTRING (entry)->data[varlen] == '='
- && ! bcmp (XSTRING (entry)->data, var, varlen))
+#ifdef WINDOWSNT
+ /* NT environment variables are case insensitive. */
+ && ! strnicmp (XSTRING (entry)->data, var, varlen)
+#else /* not WINDOWSNT */
+ && ! bcmp (XSTRING (entry)->data, var, varlen)
+#endif /* not WINDOWSNT */
+ )
{
*value = (char *) XSTRING (entry)->data + (varlen + 1);
*valuelen = XSTRING (entry)->size - (varlen + 1);
Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
}
-/* This is run after init_cmdargs, so that Vinvocation_directory is valid. */
+/* This is run after init_cmdargs, when Vinstallation_directory is valid. */
init_callproc ()
{
Vinstallation_directory);
if (NILP (Fmember (tem, Vexec_path)))
{
+#ifndef DOS_NT
+ /* MSDOS uses wrapped binaries, so don't do this. */
Vexec_path = nconc2 (Vexec_path, Fcons (tem, Qnil));
Vexec_directory = Ffile_name_as_directory (tem);
+#endif /* not DOS_NT */
+ }
+
+ /* Maybe use ../etc as well as ../lib-src. */
+ if (data_dir == 0)
+ {
+ tem = Fexpand_file_name (build_string ("etc"),
+ Vinstallation_directory);
+ Vdoc_directory = Ffile_name_as_directory (tem);
+ }
+ }
- /* If we use ../lib-src, maybe use ../etc as well.
- Do so if ../etc exists and has our DOC-... file in it. */
- if (data_dir == 0)
- {
- tem = Fexpand_file_name (build_string ("etc"),
- Vinstallation_directory);
- Vdata_directory = Ffile_name_as_directory (tem);
- }
+ /* Look for the files that should be in etc. We don't use
+ Vinstallation_directory, because these files are never installed
+ near the executable, and they are never in the build
+ directory when that's different from the source directory.
+
+ Instead, if these files are not in the nominal place, we try the
+ source directory. */
+ if (data_dir == 0)
+ {
+ Lisp_Object tem, tem1, newdir;
+
+ tem = Fexpand_file_name (build_string ("GNU"), Vdata_directory);
+ tem1 = Ffile_exists_p (tem);
+ if (NILP (tem1))
+ {
+ newdir = Fexpand_file_name (build_string ("../etc/"),
+ build_string (PATH_DUMPLOADSEARCH));
+ tem = Fexpand_file_name (build_string ("GNU"), newdir);
+ tem1 = Ffile_exists_p (tem);
+ if (!NILP (tem1))
+ Vdata_directory = newdir;
}
}
syms_of_callproc ()
{
-#ifdef MSDOS
- DEFVAR_LISP ("binary-process", &Vbinary_process,
+#ifdef DOS_NT
+ Qbuffer_file_type = intern ("buffer-file-type");
+ staticpro (&Qbuffer_file_type);
+
+ DEFVAR_LISP ("binary-process-input", &Vbinary_process_input,
+ "*If non-nil then new subprocesses are assumed to take binary input.");
+ Vbinary_process_input = Qnil;
+
+ DEFVAR_LISP ("binary-process-output", &Vbinary_process_output,
"*If non-nil then new subprocesses are assumed to produce binary output.");
- Vbinary_process = Qnil;
-#endif
+ Vbinary_process_output = Qnil;
+#endif /* DOS_NT */
DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
"*File name to load inferior shells from.\n\
HCoop / bpt / emacs.git / blobdiff