X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/4431e6d9b30062407a60897db58356a36cedf49f..2bfa3d3e1fb347ba76bddf77f3e288049635821d:/src/callproc.c
diff --git a/src/callproc.c b/src/callproc.c
index f0aa822234..56bdc7de0e 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -1,6 +1,7 @@
/* Synchronous subprocess invocation for GNU Emacs.
- Copyright (C) 1985-1988, 1993-1995, 1999-2013
- Free Software Foundation, Inc.
+
+Copyright (C) 1985-1988, 1993-1995, 1999-2014 Free Software Foundation,
+Inc.
This file is part of GNU Emacs.
@@ -31,6 +32,7 @@ along with GNU Emacs. If not, see . */
#ifdef WINDOWSNT
#define NOMINMAX
+#include /* for fcntl */
#include
#include "w32.h"
#define _P_NOWAIT 1 /* from process.h */
@@ -67,9 +69,10 @@ along with GNU Emacs. If not, see . */
/* Pattern used by call-process-region to make temp files. */
static Lisp_Object Vtemp_file_name_pattern;
-/* The next two variables are valid only while record-unwind-protect
- is in place during call-process for a synchronous subprocess. At
- other times, their contents are irrelevant. Doing this via static
+/* The next two variables are used while record-unwind-protect is in place
+ during call-process for a subprocess for which record_deleted_pid has
+ not yet been called. At other times, synch_process_pid is zero and
+ synch_process_tempfile's contents are irrelevant. Doing this via static
C variables is more convenient than putting them into the arguments
of record-unwind-protect, as they need to be updated at randomish
times in the code, and Lisp cannot always store these values as
@@ -79,26 +82,53 @@ static Lisp_Object Vtemp_file_name_pattern;
/* If nonzero, a process-ID that has not been reaped. */
static pid_t synch_process_pid;
-/* If nonnegative, a file descriptor that has not been closed. */
-static int synch_process_fd;
+static Lisp_Object synch_process_tempfile;
+
+/* Indexes of file descriptors that need closing on call_process_kill. */
+enum
+ {
+ /* The subsidiary process's stdout and stderr. stdin is handled
+ separately, in either Fcall_process_region or create_temp_file. */
+ CALLPROC_STDOUT, CALLPROC_STDERR,
+
+ /* How to read from a pipe (or substitute) from the subsidiary process. */
+ CALLPROC_PIPEREAD,
+
+ /* A bound on the number of file descriptors. */
+ CALLPROC_FDS
+ };
+
+static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int *, Lisp_Object *);
-/* Block SIGCHLD. */
+/* Return the current buffer's working directory, or the home
+ directory if it's unreachable, as a string suitable for a system call.
+ Signal an error if the result would not be an accessible directory. */
-void
-block_child_signal (void)
+Lisp_Object
+encode_current_directory (void)
{
- sigset_t blocked;
- sigemptyset (&blocked);
- sigaddset (&blocked, SIGCHLD);
- pthread_sigmask (SIG_BLOCK, &blocked, 0);
-}
+ Lisp_Object dir;
+ struct gcpro gcpro1;
-/* Unblock SIGCHLD. */
+ dir = BVAR (current_buffer, directory);
+ GCPRO1 (dir);
-void
-unblock_child_signal (void)
-{
- pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
+ dir = Funhandled_file_name_directory (dir);
+
+ /* If the file name handler says that dir is unreachable, use
+ a sensible default. */
+ if (NILP (dir))
+ dir = build_string ("~");
+
+ dir = expand_and_dir_to_file (dir, Qnil);
+
+ if (STRING_MULTIBYTE (dir))
+ dir = ENCODE_FILE (dir);
+ if (! file_accessible_directory_p (SSDATA (dir)))
+ report_file_error ("Setting current directory",
+ BVAR (current_buffer, directory));
+
+ return dir;
}
/* If P is reapable, record it as a deleted process and kill it.
@@ -106,86 +136,83 @@ unblock_child_signal (void)
reaped on receipt of the first SIGCHLD after the critical section. */
void
-record_kill_process (struct Lisp_Process *p)
+record_kill_process (struct Lisp_Process *p, Lisp_Object tempfile)
{
- block_child_signal ();
+#ifndef MSDOS
+ sigset_t oldset;
+ block_child_signal (&oldset);
if (p->alive)
{
+ record_deleted_pid (p->pid, tempfile);
p->alive = 0;
- record_deleted_pid (p->pid);
kill (- p->pid, SIGKILL);
}
- unblock_child_signal ();
+ unblock_child_signal (&oldset);
+#endif /* !MSDOS */
}
-/* Clean up when exiting call_process_cleanup. */
+/* Clean up files, file descriptors and processes created by Fcall_process. */
-static Lisp_Object
-call_process_kill (Lisp_Object ignored)
+static void
+delete_temp_file_ptr (Lisp_Object *name_ptr)
{
- if (synch_process_fd >= 0)
- emacs_close (synch_process_fd);
+ Lisp_Object name = *name_ptr;
+ if (! NILP (name))
+ unlink (SSDATA (name));
+}
+
+static void
+call_process_kill (void *ptr)
+{
+ int *callproc_fd = ptr;
+ int i;
+ for (i = 0; i < CALLPROC_FDS; i++)
+ if (0 <= callproc_fd[i])
+ emacs_close (callproc_fd[i]);
if (synch_process_pid)
{
struct Lisp_Process proc;
proc.alive = 1;
proc.pid = synch_process_pid;
- record_kill_process (&proc);
+ record_kill_process (&proc, synch_process_tempfile);
+ synch_process_pid = 0;
}
-
- return Qnil;
+ else if (STRINGP (synch_process_tempfile))
+ delete_temp_file_ptr (&synch_process_tempfile);
}
-/* Clean up when exiting Fcall_process.
- On MSDOS, delete the temporary file on any kind of termination.
- On Unix, kill the process and any children on termination by signal. */
+/* Clean up when exiting Fcall_process: restore the buffer, and
+ kill the subsidiary process group if the process still exists. */
-static Lisp_Object
-call_process_cleanup (Lisp_Object arg)
+static void
+call_process_cleanup (Lisp_Object buffer)
{
-#ifdef MSDOS
- Lisp_Object buffer = Fcar (arg);
- Lisp_Object file = Fcdr (arg);
-#else
- Lisp_Object buffer = arg;
-#endif
-
Fset_buffer (buffer);
#ifndef MSDOS
- /* If the process still exists, kill its process group. */
if (synch_process_pid)
{
- ptrdiff_t count = SPECPDL_INDEX ();
kill (-synch_process_pid, SIGINT);
- record_unwind_protect (call_process_kill, make_number (0));
message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
immediate_quit = 1;
QUIT;
wait_for_termination (synch_process_pid, 0, 1);
synch_process_pid = 0;
immediate_quit = 0;
- specpdl_ptr = specpdl + count; /* Discard the unwind protect. */
message1 ("Waiting for process to die...done");
}
-#endif
-
- if (synch_process_fd >= 0)
- emacs_close (synch_process_fd);
+#endif /* !MSDOS */
+}
-#ifdef MSDOS
- /* FILE is "" when we didn't actually create a temporary file in
- call-process. */
- if (!(strcmp (SDATA (file), NULL_DEVICE) == 0 || SREF (file, 0) == '\0'))
- unlink (SDATA (file));
+#ifdef DOS_NT
+static mode_t const default_output_mode = S_IREAD | S_IWRITE;
+#else
+static mode_t const default_output_mode = 0666;
#endif
- return Qnil;
-}
-
DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
doc: /* Call PROGRAM synchronously in separate process.
The remaining arguments are optional.
@@ -215,11 +242,49 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object infile, buffer, current_dir, path;
+ Lisp_Object infile, encoded_infile;
+ int filefd;
+ struct gcpro gcpro1;
+ dynwind_begin ();
+
+ if (nargs >= 2 && ! NILP (args[1]))
+ {
+ infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory));
+ CHECK_STRING (infile);
+ }
+ else
+ infile = build_string (NULL_DEVICE);
+
+ GCPRO1 (infile);
+ encoded_infile = STRING_MULTIBYTE (infile) ? ENCODE_FILE (infile) : infile;
+
+ filefd = emacs_open (SSDATA (encoded_infile), O_RDONLY, 0);
+ if (filefd < 0)
+ report_file_error ("Opening process input file", infile);
+ record_unwind_protect_ptr (close_file_ptr_unwind, &filefd);
+ UNGCPRO;
+ Lisp_Object tem0 = call_process (nargs, args, &filefd, NULL);
+ dynwind_end ();
+ return tem0;
+}
+
+/* Like Fcall_process (NARGS, ARGS), except use FILEFD as the input file.
+
+ If TEMPFILE_INDEX is nonnegative, it is the specpdl index of an
+ unwinder that is intended to remove the input temporary file; in
+ this case NARGS must be at least 2 and ARGS[1] is the file's name.
+
+ At entry, the specpdl stack top entry must be close_file_unwind (FILEFD). */
+
+static Lisp_Object
+call_process (ptrdiff_t nargs, Lisp_Object *args, int *filefd, Lisp_Object *tempfile_ptr)
+{
+ Lisp_Object buffer, current_dir, path;
bool display_p;
- int fd0, fd1, filefd;
+ int fd0;
+ int callproc_fd[CALLPROC_FDS];
int status;
- ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t i;
USE_SAFE_ALLOCA;
char **new_argv;
@@ -228,19 +293,24 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
Lisp_Object error_file;
Lisp_Object output_file = Qnil;
#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
- char *outf, *tempfile = NULL;
- int outfilefd;
+ char *tempfile = NULL;
int pid;
#else
+ sigset_t oldset;
pid_t pid;
#endif
int child_errno;
- int fd_output = -1;
+ int fd_output, fd_error;
struct coding_system process_coding; /* coding-system of process output */
struct coding_system argument_coding; /* coding-system of arguments */
/* Set to the return value of Ffind_operation_coding_system. */
Lisp_Object coding_systems;
- bool output_to_buffer = 1;
+ bool discard_output;
+
+ dynwind_begin ();
+
+ if (synch_process_pid)
+ error ("call-process invoked recursively");
/* Qt denotes that Ffind_operation_coding_system is not yet called. */
coding_systems = Qt;
@@ -259,7 +329,6 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
/* Decide the coding-system for giving arguments. */
{
Lisp_Object val, *args2;
- ptrdiff_t i;
/* If arguments are supplied, we may have to encode them. */
if (nargs >= 5)
@@ -298,24 +367,16 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
}
}
- if (nargs >= 2 && ! NILP (args[1]))
- {
- infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory));
- CHECK_STRING (infile);
- }
+ if (nargs < 3)
+ buffer = Qnil;
else
- infile = build_string (NULL_DEVICE);
-
- if (nargs >= 3)
{
buffer = args[2];
/* If BUFFER is a list, its meaning is (BUFFER-FOR-STDOUT
FILE-FOR-STDERR), unless the first element is :file, in which case see
the next paragraph. */
- if (CONSP (buffer)
- && (! SYMBOLP (XCAR (buffer))
- || strcmp (SSDATA (SYMBOL_NAME (XCAR (buffer))), ":file")))
+ if (CONSP (buffer) && !EQ (XCAR (buffer), QCfile))
{
if (CONSP (XCDR (buffer)))
{
@@ -332,9 +393,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
}
/* If the buffer is (still) a list, it might be a (:file "file") spec. */
- if (CONSP (buffer)
- && SYMBOLP (XCAR (buffer))
- && ! strcmp (SSDATA (SYMBOL_NAME (XCAR (buffer))), ":file"))
+ if (CONSP (buffer) && EQ (XCAR (buffer), QCfile))
{
output_file = Fexpand_file_name (XCAR (XCDR (buffer)),
BVAR (current_buffer, directory));
@@ -342,9 +401,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
buffer = Qnil;
}
- if (!(EQ (buffer, Qnil)
- || EQ (buffer, Qt)
- || INTEGERP (buffer)))
+ if (! (NILP (buffer) || EQ (buffer, Qt) || INTEGERP (buffer)))
{
Lisp_Object spec_buffer;
spec_buffer = buffer;
@@ -355,8 +412,6 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
CHECK_BUFFER (buffer);
}
}
- else
- buffer = Qnil;
/* Make sure that the child will be able to chdir to the current
buffer's current directory, or its unhandled equivalent. We
@@ -369,28 +424,12 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
protected by the caller, so all we really have to worry about is
buffer. */
{
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-
- current_dir = BVAR (current_buffer, directory);
-
- GCPRO5 (infile, buffer, current_dir, error_file, output_file);
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- current_dir = Funhandled_file_name_directory (current_dir);
- if (NILP (current_dir))
- /* If the file name handler says that current_dir is unreachable, use
- a sensible default. */
- current_dir = build_string ("~/");
- current_dir = expand_and_dir_to_file (current_dir, Qnil);
- current_dir = Ffile_name_as_directory (current_dir);
+ current_dir = encode_current_directory ();
- if (NILP (Ffile_accessible_directory_p (current_dir)))
- report_file_error ("Setting current directory",
- Fcons (BVAR (current_buffer, directory), Qnil));
+ GCPRO4 (buffer, current_dir, error_file, output_file);
- if (STRING_MULTIBYTE (infile))
- infile = ENCODE_FILE (infile);
- if (STRING_MULTIBYTE (current_dir))
- current_dir = ENCODE_FILE (current_dir);
if (STRINGP (error_file) && STRING_MULTIBYTE (error_file))
error_file = ENCODE_FILE (error_file);
if (STRINGP (output_file) && STRING_MULTIBYTE (output_file))
@@ -400,43 +439,25 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
- filefd = emacs_open (SSDATA (infile), O_RDONLY, 0);
- if (filefd < 0)
- report_file_error ("Opening process input file",
- Fcons (DECODE_FILE (infile), Qnil));
-
- if (STRINGP (output_file))
- {
-#ifdef DOS_NT
- fd_output = emacs_open (SSDATA (output_file),
- O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
- S_IREAD | S_IWRITE);
-#else /* not DOS_NT */
- fd_output = creat (SSDATA (output_file), 0666);
-#endif /* not DOS_NT */
- if (fd_output < 0)
- {
- output_file = DECODE_FILE (output_file);
- report_file_error ("Opening process output file",
- Fcons (output_file, Qnil));
- }
- if (STRINGP (error_file) || NILP (error_file))
- output_to_buffer = 0;
- }
+ for (i = 0; i < CALLPROC_FDS; i++)
+ callproc_fd[i] = -1;
+#ifdef MSDOS
+ synch_process_tempfile = make_number (0);
+#endif
+ record_unwind_protect_ptr (call_process_kill, callproc_fd);
/* Search for program; barf if not found. */
{
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ int ok;
- GCPRO4 (infile, buffer, current_dir, error_file);
- openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK));
+ GCPRO3 (buffer, current_dir, error_file);
+ ok = openp (Vexec_path, args[0], Vexec_suffixes, &path,
+ make_number (X_OK), false);
UNGCPRO;
+ if (ok < 0)
+ report_file_error ("Searching for program", args[0]);
}
- if (NILP (path))
- {
- emacs_close (filefd);
- report_file_error ("Searching for program", Fcons (args[0], Qnil));
- }
/* If program file name starts with /: for quoting a magic name,
discard that. */
@@ -447,9 +468,9 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
new_argv = SAFE_ALLOCA ((nargs > 4 ? nargs - 2 : 2) * sizeof *new_argv);
{
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- GCPRO5 (infile, buffer, current_dir, path, error_file);
+ GCPRO4 (buffer, current_dir, path, error_file);
if (nargs > 4)
{
ptrdiff_t i;
@@ -474,259 +495,230 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
UNGCPRO;
}
-#ifdef MSDOS /* MW, July 1993 */
+ discard_output = INTEGERP (buffer) || (NILP (buffer) && NILP (output_file));
- /* If we're redirecting STDOUT to a file, that file is already open
- on fd_output. */
- if (fd_output < 0)
+#ifdef MSDOS
+ if (! discard_output && ! STRINGP (output_file))
{
- if ((outf = egetenv ("TMPDIR")))
- strcpy (tempfile = alloca (strlen (outf) + 20), outf);
- else
- {
- tempfile = alloca (20);
- *tempfile = '\0';
- }
- dostounix_filename (tempfile, 0);
+ char const *tmpdir = egetenv ("TMPDIR");
+ char const *outf = tmpdir ? tmpdir : "";
+ tempfile = alloca (strlen (outf) + 20);
+ strcpy (tempfile, outf);
+ dostounix_filename (tempfile);
if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
strcat (tempfile, "/");
- strcat (tempfile, "detmp.XXX");
+ strcat (tempfile, "emXXXXXX");
mktemp (tempfile);
- outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
- if (outfilefd < 0) {
- emacs_close (filefd);
- report_file_error ("Opening process output file",
- Fcons (build_string (tempfile), Qnil));
- }
+ if (!*tempfile)
+ report_file_error ("Opening process output file", Qnil);
+ output_file = build_string (tempfile);
+ synch_process_tempfile = output_file;
}
- else
- outfilefd = fd_output;
- fd0 = filefd;
- fd1 = outfilefd;
-#endif /* MSDOS */
+#endif
- if (INTEGERP (buffer))
+ if (discard_output)
{
- fd0 = -1;
- fd1 = emacs_open (NULL_DEVICE, O_WRONLY, 0);
+ fd_output = emacs_open (NULL_DEVICE, O_WRONLY, 0);
+ if (fd_output < 0)
+ report_file_error ("Opening null device", Qnil);
+ }
+ else if (STRINGP (output_file))
+ {
+ fd_output = emacs_open (SSDATA (output_file),
+ O_WRONLY | O_CREAT | O_TRUNC | O_TEXT,
+ default_output_mode);
+ if (fd_output < 0)
+ {
+ int open_errno = errno;
+ output_file = DECODE_FILE (output_file);
+ report_file_errno ("Opening process output file",
+ output_file, open_errno);
+ }
}
else
{
-#ifndef MSDOS
int fd[2];
- if (pipe (fd) == -1)
+ if (emacs_pipe (fd) != 0)
+ report_file_error ("Creating process pipe", Qnil);
+ callproc_fd[CALLPROC_PIPEREAD] = fd[0];
+ fd_output = fd[1];
+ }
+ callproc_fd[CALLPROC_STDOUT] = fd_output;
+
+ fd_error = fd_output;
+
+ if (STRINGP (error_file) || (NILP (error_file) && !discard_output))
+ {
+ fd_error = emacs_open ((STRINGP (error_file)
+ ? SSDATA (error_file)
+ : NULL_DEVICE),
+ O_WRONLY | O_CREAT | O_TRUNC | O_TEXT,
+ default_output_mode);
+ if (fd_error < 0)
{
- int pipe_errno = errno;
- emacs_close (filefd);
- errno = pipe_errno;
- report_file_error ("Creating process pipe", Qnil);
+ int open_errno = errno;
+ report_file_errno ("Cannot redirect stderr",
+ (STRINGP (error_file)
+ ? DECODE_FILE (error_file)
+ : build_string (NULL_DEVICE)),
+ open_errno);
}
- fd0 = fd[0];
- fd1 = fd[1];
-#endif
+ callproc_fd[CALLPROC_STDERR] = fd_error;
}
- {
- int fd_error = fd1;
+#ifdef MSDOS /* MW, July 1993 */
+ /* Note that on MSDOS `child_setup' actually returns the child process
+ exit status, not its PID, so assign it to status below. */
+ pid = child_setup (*filefd, fd_output, fd_error, new_argv, 0, current_dir);
- if (fd_output >= 0)
- fd1 = fd_output;
+ if (pid < 0)
+ {
+ child_errno = errno;
+ dynwind_end ();
+ synchronize_system_messages_locale ();
+ return
+ code_convert_string_norecord (build_string (strerror (child_errno)),
+ Vlocale_coding_system, 0);
+ }
+ status = pid;
- if (NILP (error_file))
- fd_error = emacs_open (NULL_DEVICE, O_WRONLY, 0);
- else if (STRINGP (error_file))
+ for (i = 0; i < CALLPROC_FDS; i++)
+ if (0 <= callproc_fd[i])
{
-#ifdef DOS_NT
- fd_error = emacs_open (SSDATA (error_file),
- O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
- S_IREAD | S_IWRITE);
-#else /* not DOS_NT */
- fd_error = creat (SSDATA (error_file), 0666);
-#endif /* not DOS_NT */
+ emacs_close (callproc_fd[i]);
+ callproc_fd[i] = -1;
}
+ emacs_close (*filefd);
+ *filefd = -1;
- if (fd_error < 0)
- {
- emacs_close (filefd);
- if (fd0 != filefd)
- emacs_close (fd0);
- if (fd1 >= 0)
- emacs_close (fd1);
-#ifdef MSDOS
- unlink (tempfile);
-#endif
- if (NILP (error_file))
- error_file = build_string (NULL_DEVICE);
- else if (STRINGP (error_file))
- error_file = DECODE_FILE (error_file);
- report_file_error ("Cannot redirect stderr", Fcons (error_file, Qnil));
- }
+ if (tempfile)
+ {
+ /* Since CRLF is converted to LF within `decode_coding', we
+ can always open a file with binary mode. */
+ callproc_fd[CALLPROC_PIPEREAD] = emacs_open (tempfile,
+ O_RDONLY | O_BINARY, 0);
+ if (callproc_fd[CALLPROC_PIPEREAD] < 0)
+ {
+ int open_errno = errno;
+ report_file_errno ("Cannot re-open temporary file",
+ build_string (tempfile), open_errno);
+ }
+ }
-#ifdef MSDOS /* MW, July 1993 */
- /* Note that on MSDOS `child_setup' actually returns the child process
- exit status, not its PID, so assign it to status below. */
- pid = child_setup (filefd, outfilefd, fd_error, new_argv, 0, current_dir);
- child_errno = errno;
-
- emacs_close (outfilefd);
- if (fd_error != outfilefd)
- emacs_close (fd_error);
- if (pid < 0)
- {
- synchronize_system_messages_locale ();
- return
- code_convert_string_norecord (build_string (strerror (child_errno)),
- Vlocale_coding_system, 0);
- }
- status = pid;
- fd1 = -1; /* No harm in closing that one! */
- if (tempfile)
- {
- /* Since CRLF is converted to LF within `decode_coding', we
- can always open a file with binary mode. */
- fd0 = emacs_open (tempfile, O_RDONLY | O_BINARY, 0);
- if (fd0 < 0)
- {
- unlink (tempfile);
- emacs_close (filefd);
- report_file_error ("Cannot re-open temporary file",
- Fcons (build_string (tempfile), Qnil));
- }
- }
- else
- fd0 = -1; /* We are not going to read from tempfile. */
#endif /* MSDOS */
- /* Do the unwind-protect now, even though the pid is not known, so
- that no storage allocation is done in the critical section.
- The actual PID will be filled in during the critical section. */
- synch_process_pid = 0;
- synch_process_fd = fd0;
+ /* Do the unwind-protect now, even though the pid is not known, so
+ that no storage allocation is done in the critical section.
+ The actual PID will be filled in during the critical section. */
+ record_unwind_protect (call_process_cleanup, Fcurrent_buffer ());
-#ifdef MSDOS
- /* MSDOS needs different cleanup information. */
- record_unwind_protect (call_process_cleanup,
- Fcons (Fcurrent_buffer (),
- build_string (tempfile ? tempfile : "")));
-#else
- record_unwind_protect (call_process_cleanup, Fcurrent_buffer ());
+#ifndef MSDOS
- block_input ();
- block_child_signal ();
+ block_input ();
+ block_child_signal (&oldset);
#ifdef WINDOWSNT
- pid = child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir);
- /* We need to record the input file of this child, for when we are
- called from call-process-region to create an async subprocess.
- That's because call-process-region's unwind procedure will
- attempt to delete the temporary input file, which will fail
- because that file is still in use. Recording it with the child
- will allow us to delete the file when the subprocess exits.
- The second part of this is in delete_temp_file, q.v. */
- if (pid > 0 && INTEGERP (buffer) && nargs >= 2 && !NILP (args[1]))
- record_infile (pid, xstrdup (SSDATA (infile)));
+ pid = child_setup (*filefd, fd_output, fd_error, new_argv, 0, current_dir);
#else /* not WINDOWSNT */
- /* vfork, and prevent local vars from being clobbered by the vfork. */
+ /* vfork, and prevent local vars from being clobbered by the vfork. */
+ {
+ Lisp_Object volatile buffer_volatile = buffer;
+ Lisp_Object volatile coding_systems_volatile = coding_systems;
+ Lisp_Object volatile current_dir_volatile = current_dir;
+ bool volatile display_p_volatile = display_p;
+ int volatile fd_error_volatile = fd_error;
+ int *volatile filefd_volatile = filefd;
+ char **volatile new_argv_volatile = new_argv;
+ int volatile callproc_fd_volatile[CALLPROC_FDS];
+ for (i = 0; i < CALLPROC_FDS; i++)
+ callproc_fd_volatile[i] = callproc_fd[i];
+
+ pid = vfork ();
+
+ buffer = buffer_volatile;
+ coding_systems = coding_systems_volatile;
+ current_dir = current_dir_volatile;
+ display_p = display_p_volatile;
+ fd_error = fd_error_volatile;
+ filefd = filefd_volatile;
+ new_argv = new_argv_volatile;
+
+ for (i = 0; i < CALLPROC_FDS; i++)
+ callproc_fd[i] = callproc_fd_volatile[i];
+ fd_output = callproc_fd[CALLPROC_STDOUT];
+ }
+
+ if (pid == 0)
{
- Lisp_Object volatile buffer_volatile = buffer;
- Lisp_Object volatile coding_systems_volatile = coding_systems;
- Lisp_Object volatile current_dir_volatile = current_dir;
- bool volatile display_p_volatile = display_p;
- bool volatile output_to_buffer_volatile = output_to_buffer;
- bool volatile sa_must_free_volatile = sa_must_free;
- int volatile fd1_volatile = fd1;
- int volatile fd_error_volatile = fd_error;
- int volatile fd_output_volatile = fd_output;
- int volatile filefd_volatile = filefd;
- ptrdiff_t volatile count_volatile = count;
- ptrdiff_t volatile sa_count_volatile = sa_count;
- char **volatile new_argv_volatile = new_argv;
-
- pid = vfork ();
- child_errno = errno;
+ unblock_child_signal (&oldset);
- buffer = buffer_volatile;
- coding_systems = coding_systems_volatile;
- current_dir = current_dir_volatile;
- display_p = display_p_volatile;
- output_to_buffer = output_to_buffer_volatile;
- sa_must_free = sa_must_free_volatile;
- fd1 = fd1_volatile;
- fd_error = fd_error_volatile;
- fd_output = fd_output_volatile;
- filefd = filefd_volatile;
- count = count_volatile;
- sa_count = sa_count_volatile;
- new_argv = new_argv_volatile;
-
- fd0 = synch_process_fd;
- }
+ setsid ();
- if (pid == 0)
- {
- unblock_child_signal ();
+ /* Emacs ignores SIGPIPE, but the child should not. */
+ signal (SIGPIPE, SIG_DFL);
+ /* Likewise for SIGPROF. */
+#ifdef SIGPROF
+ signal (SIGPROF, SIG_DFL);
+#endif
+
+ child_setup (*filefd, fd_output, fd_error, new_argv, 0, current_dir);
+ }
- if (fd0 >= 0)
- emacs_close (fd0);
+#endif /* not WINDOWSNT */
- setsid ();
+ child_errno = errno;
- /* Emacs ignores SIGPIPE, but the child should not. */
- signal (SIGPIPE, SIG_DFL);
+ if (pid > 0)
+ {
+ synch_process_pid = pid;
- child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir);
- }
+ if (INTEGERP (buffer))
+ {
+ if (tempfile_ptr)
+ {
+ record_deleted_pid (pid, *tempfile_ptr);
+ *tempfile_ptr = Qnil;
+ }
+ else
+ {
+ record_deleted_pid (pid, Qnil);
+ }
+ synch_process_pid = 0;
+ }
+ }
-#endif /* not WINDOWSNT */
+ unblock_child_signal (&oldset);
+ unblock_input ();
- child_errno = errno;
+ if (pid < 0)
+ report_file_errno ("Doing vfork", Qnil, child_errno);
- if (pid > 0)
+ /* Close our file descriptors, except for callproc_fd[CALLPROC_PIPEREAD]
+ since we will use that to read input from. */
+ for (i = 0; i < CALLPROC_FDS; i++)
+ if (i != CALLPROC_PIPEREAD && 0 <= callproc_fd[i])
{
- if (INTEGERP (buffer))
- record_deleted_pid (pid);
- else
- synch_process_pid = pid;
+ emacs_close (callproc_fd[i]);
+ callproc_fd[i] = -1;
}
+ emacs_close (*filefd);
+ *filefd = -1;
- unblock_child_signal ();
- unblock_input ();
-
- /* The MSDOS case did this already. */
- if (fd_error >= 0)
- emacs_close (fd_error);
#endif /* not MSDOS */
- /* Close most of our file descriptors, but not fd0
- since we will use that to read input from. */
- emacs_close (filefd);
- if (fd_output >= 0)
- emacs_close (fd_output);
- if (fd1 >= 0 && fd1 != fd_error)
- emacs_close (fd1);
- }
-
- if (pid < 0)
+ if (INTEGERP (buffer))
{
- errno = child_errno;
- report_file_error ("Doing vfork", Qnil);
+ dynwind_end ();
+ return Qnil;
}
- if (INTEGERP (buffer))
- return unbind_to (count, Qnil);
-
if (BUFFERP (buffer))
Fset_buffer (buffer);
- if (NILP (buffer))
- {
- /* If BUFFER is nil, we must read process output once and then
- discard it, so setup coding system but with nil. */
- setup_coding_system (Qnil, &process_coding);
- process_coding.dst_multibyte = 0;
- }
- else
+ fd0 = callproc_fd[CALLPROC_PIPEREAD];
+
+ if (0 <= fd0)
{
Lisp_Object val, *args2;
@@ -762,26 +754,24 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
setup_coding_system (val, &process_coding);
process_coding.dst_multibyte
= ! NILP (BVAR (current_buffer, enable_multibyte_characters));
+ process_coding.src_multibyte = 0;
}
- process_coding.src_multibyte = 0;
immediate_quit = 1;
QUIT;
- if (output_to_buffer)
+ if (0 <= fd0)
{
enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 };
enum { CALLPROC_BUFFER_SIZE_MAX = 4 * CALLPROC_BUFFER_SIZE_MIN };
char buf[CALLPROC_BUFFER_SIZE_MAX];
int bufsize = CALLPROC_BUFFER_SIZE_MIN;
int nread;
- bool first = 1;
EMACS_INT total_read = 0;
int carryover = 0;
bool display_on_the_fly = display_p;
- struct coding_system saved_coding;
+ struct coding_system saved_coding = process_coding;
- saved_coding = process_coding;
while (1)
{
/* Repeatedly read until we've filled as much as possible
@@ -812,58 +802,58 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
/* Now NREAD is the total amount of data in the buffer. */
immediate_quit = 0;
- if (!NILP (buffer))
- {
- if (NILP (BVAR (current_buffer, enable_multibyte_characters))
- && ! CODING_MAY_REQUIRE_DECODING (&process_coding))
- insert_1_both (buf, nread, nread, 0, 1, 0);
- else
- { /* We have to decode the input. */
- Lisp_Object curbuf;
- ptrdiff_t count1 = SPECPDL_INDEX ();
-
- XSETBUFFER (curbuf, current_buffer);
- /* We cannot allow after-change-functions be run
- during decoding, because that might modify the
- buffer, while we rely on process_coding.produced to
- faithfully reflect inserted text until we
- TEMP_SET_PT_BOTH below. */
- specbind (Qinhibit_modification_hooks, Qt);
- decode_coding_c_string (&process_coding,
- (unsigned char *) buf, nread, curbuf);
- unbind_to (count1, Qnil);
- if (display_on_the_fly
- && CODING_REQUIRE_DETECTION (&saved_coding)
- && ! CODING_REQUIRE_DETECTION (&process_coding))
- {
- /* We have detected some coding system. But,
- there's a possibility that the detection was
- done by insufficient data. So, we give up
- displaying on the fly. */
- if (process_coding.produced > 0)
- del_range_2 (process_coding.dst_pos,
- process_coding.dst_pos_byte,
- process_coding.dst_pos
- + process_coding.produced_char,
- process_coding.dst_pos_byte
- + process_coding.produced, 0);
- display_on_the_fly = 0;
- process_coding = saved_coding;
- carryover = nread;
- /* This is to make the above condition always
- fails in the future. */
- saved_coding.common_flags
- &= ~CODING_REQUIRE_DETECTION_MASK;
- continue;
- }
-
- TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
- PT_BYTE + process_coding.produced);
- carryover = process_coding.carryover_bytes;
- if (carryover > 0)
- memcpy (buf, process_coding.carryover,
- process_coding.carryover_bytes);
+ if (!nread)
+ ;
+ else if (NILP (BVAR (current_buffer, enable_multibyte_characters))
+ && ! CODING_MAY_REQUIRE_DECODING (&process_coding))
+ insert_1_both (buf, nread, nread, 0, 1, 0);
+ else
+ { /* We have to decode the input. */
+ Lisp_Object curbuf;
+
+ dynwind_begin ();
+ XSETBUFFER (curbuf, current_buffer);
+ /* FIXME: Call signal_after_change! */
+ prepare_to_modify_buffer (PT, PT, NULL);
+ /* We cannot allow after-change-functions be run
+ during decoding, because that might modify the
+ buffer, while we rely on process_coding.produced to
+ faithfully reflect inserted text until we
+ TEMP_SET_PT_BOTH below. */
+ specbind (Qinhibit_modification_hooks, Qt);
+ decode_coding_c_string (&process_coding,
+ (unsigned char *) buf, nread, curbuf);
+ dynwind_end ();
+ if (display_on_the_fly
+ && CODING_REQUIRE_DETECTION (&saved_coding)
+ && ! CODING_REQUIRE_DETECTION (&process_coding))
+ {
+ /* We have detected some coding system, but the
+ detection may have been via insufficient data.
+ So give up displaying on the fly. */
+ if (process_coding.produced > 0)
+ del_range_2 (process_coding.dst_pos,
+ process_coding.dst_pos_byte,
+ (process_coding.dst_pos
+ + process_coding.produced_char),
+ (process_coding.dst_pos_byte
+ + process_coding.produced),
+ 0);
+ display_on_the_fly = 0;
+ process_coding = saved_coding;
+ carryover = nread;
+ /* Make the above condition always fail in the future. */
+ saved_coding.common_flags
+ &= ~CODING_REQUIRE_DETECTION_MASK;
+ continue;
}
+
+ TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
+ PT_BYTE + process_coding.produced);
+ carryover = process_coding.carryover_bytes;
+ if (carryover > 0)
+ memcpy (buf, process_coding.carryover,
+ process_coding.carryover_bytes);
}
if (process_coding.mode & CODING_MODE_LAST_BLOCK)
@@ -877,12 +867,9 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
if (display_p)
{
- if (first)
- prepare_menu_bars ();
- first = 0;
redisplay_preserve_echo_area (1);
/* This variable might have been set to 0 for code
- detection. In that case, we set it back to 1 because
+ detection. In that case, set it back to 1 because
we should have already detected a coding system. */
display_on_the_fly = 1;
}
@@ -901,7 +888,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
#ifndef MSDOS
/* Wait for it to terminate, unless it already has. */
- wait_for_termination (pid, &status, !output_to_buffer);
+ wait_for_termination (pid, &status, fd0 < 0);
#endif
immediate_quit = 0;
@@ -911,7 +898,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
synch_process_pid = 0;
SAFE_FREE ();
- unbind_to (count, Qnil);
+ dynwind_end ();
if (WIFSIGNALED (status))
{
@@ -931,66 +918,21 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
return make_number (WEXITSTATUS (status));
}
-static Lisp_Object
-delete_temp_file (Lisp_Object name)
-{
- /* Suppress jka-compr handling, etc. */
- ptrdiff_t count = SPECPDL_INDEX ();
- specbind (intern ("file-name-handler-alist"), Qnil);
-#ifdef WINDOWSNT
- /* If this is called when the subprocess didn't exit yet, the
- attempt to delete its input file will fail. In that case, we
- schedule the file for deletion when the subprocess exits. This
- is the 2nd part of handling this situation; see the call to
- record_infile in call-process above, for the first part. */
- if (!internal_delete_file (name))
- {
- Lisp_Object encoded_file = ENCODE_FILE (name);
-
- record_pending_deletion (SSDATA (encoded_file));
- }
-#else
- internal_delete_file (name);
-#endif
- unbind_to (count, Qnil);
- return Qnil;
-}
-
-DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
- 3, MANY, 0,
- doc: /* Send text from START to END to a synchronous process running PROGRAM.
-The remaining arguments are optional.
-Delete the text if fourth arg DELETE is non-nil.
-
-Insert output in BUFFER before point; t means current buffer; nil for
- BUFFER means discard it; 0 means discard and don't wait; and `(:file
- FILE)', where FILE is a file name string, means that it should be
- written to that file (if the file already exists it is overwritten).
-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.
-STDERR-FILE may be nil (discard standard error output),
-t (mix it with ordinary output), or a file name string.
-
-Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
-Remaining args are passed to PROGRAM at startup as command args.
-
-If BUFFER is 0, `call-process-region' returns immediately with value nil.
-Otherwise it waits for PROGRAM to terminate
-and returns a numeric exit status or a signal description string.
-If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
-
-usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
+/* Create a temporary file suitable for storing the input data of
+ call-process-region. NARGS and ARGS are the same as for
+ call-process-region. Store into *FILENAME_STRING_PTR a Lisp string
+ naming the file, and return a file descriptor for reading.
+ Unwind-protect the file, so that the file descriptor will be closed
+ and the file removed when the caller unwinds the specpdl stack. */
+
+static void
+create_temp_file (ptrdiff_t nargs, Lisp_Object *args,
+ Lisp_Object *filename_string_ptr, int *fdp)
{
+ int fd;
struct gcpro gcpro1;
Lisp_Object filename_string;
- register Lisp_Object start, end;
- ptrdiff_t count = SPECPDL_INDEX ();
- /* Qt denotes we have not yet called Ffind_operation_coding_system. */
- Lisp_Object coding_systems;
- Lisp_Object val, *args2;
- ptrdiff_t i;
+ Lisp_Object val, start, end;
Lisp_Object tmpdir;
if (STRINGP (Vtemporary_file_directory))
@@ -1012,10 +954,9 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
}
{
- USE_SAFE_ALLOCA;
Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
- Lisp_Object encoded_tem;
char *tempfile;
+ ptrdiff_t count;
#ifdef WINDOWSNT
/* Cannot use the result of Fexpand_file_name, because it
@@ -1032,39 +973,18 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
}
#endif
- encoded_tem = ENCODE_FILE (pattern);
- tempfile = SAFE_ALLOCA (SBYTES (encoded_tem) + 1);
- memcpy (tempfile, SDATA (encoded_tem), SBYTES (encoded_tem) + 1);
- coding_systems = Qt;
-
-#ifdef HAVE_MKSTEMP
- {
- int fd;
-
- block_input ();
- fd = mkstemp (tempfile);
- unblock_input ();
- if (fd == -1)
- report_file_error ("Failed to open temporary file",
- Fcons (build_string (tempfile), Qnil));
- else
- close (fd);
- }
-#else
- errno = 0;
- mktemp (tempfile);
- if (!*tempfile)
- {
- if (!errno)
- errno = EEXIST;
- report_file_error ("Failed to open temporary file using pattern",
- Fcons (pattern, Qnil));
- }
-#endif
-
- filename_string = build_string (tempfile);
+ filename_string = Fcopy_sequence (ENCODE_FILE (pattern));
GCPRO1 (filename_string);
- SAFE_FREE ();
+ tempfile = SSDATA (filename_string);
+
+ fd = mkostemp (tempfile, O_CLOEXEC);
+ if (fd < 0)
+ report_file_error ("Failed to open temporary file using pattern",
+ pattern);
+ *fdp = fd;
+ *filename_string_ptr = filename_string;
+ record_unwind_protect (delete_temp_file_ptr, filename_string_ptr);
+ record_unwind_protect_ptr (close_file_ptr_unwind, fdp);
}
start = args[0];
@@ -1076,10 +996,12 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
val = Qraw_text;
else
{
+ Lisp_Object coding_systems;
+ Lisp_Object *args2;
USE_SAFE_ALLOCA;
SAFE_NALLOCA (args2, 1, nargs + 1);
args2[0] = Qcall_process_region;
- for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
+ memcpy (args2 + 1, args, nargs * sizeof *args);
coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
SAFE_FREE ();
@@ -1087,21 +1009,85 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
val = complement_process_encoding_system (val);
{
- ptrdiff_t count1 = SPECPDL_INDEX ();
+ dynwind_begin ();
specbind (intern ("coding-system-for-write"), val);
/* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
happen to get a ".Z" suffix. */
specbind (intern ("file-name-handler-alist"), Qnil);
- Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil);
+ write_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil, fd);
- unbind_to (count1, Qnil);
+ dynwind_end ();
}
+ if (lseek (fd, 0, SEEK_SET) < 0)
+ report_file_error ("Setting file position", filename_string);
+
/* Note that Fcall_process takes care of binding
coding-system-for-read. */
- record_unwind_protect (delete_temp_file, filename_string);
+ UNGCPRO;
+}
+
+DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
+ 3, MANY, 0,
+ doc: /* Send text from START to END to a synchronous process running PROGRAM.
+The remaining arguments are optional.
+Delete the text if fourth arg DELETE is non-nil.
+
+Insert output in BUFFER before point; t means current buffer; nil for
+ BUFFER means discard it; 0 means discard and don't wait; and `(:file
+ FILE)', where FILE is a file name string, means that it should be
+ written to that file (if the file already exists it is overwritten).
+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.
+STDERR-FILE may be nil (discard standard error output),
+t (mix it with ordinary output), or a file name string.
+
+Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
+Remaining args are passed to PROGRAM at startup as command args.
+
+If BUFFER is 0, `call-process-region' returns immediately with value nil.
+Otherwise it waits for PROGRAM to terminate
+and returns a numeric exit status or a signal description string.
+If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
+
+usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
+ (ptrdiff_t nargs, Lisp_Object *args)
+{
+ struct gcpro gcpro1;
+ Lisp_Object infile, val;
+ dynwind_begin ();
+ Lisp_Object start = args[0];
+ Lisp_Object end = args[1];
+ bool empty_input;
+ int fd;
+
+ if (STRINGP (start))
+ empty_input = SCHARS (start) == 0;
+ else if (NILP (start))
+ empty_input = BEG == Z;
+ else
+ {
+ validate_region (&args[0], &args[1]);
+ start = args[0];
+ end = args[1];
+ empty_input = XINT (start) == XINT (end);
+ }
+
+ if (!empty_input)
+ create_temp_file (nargs, args, &infile, &fd);
+ else
+ {
+ infile = Qnil;
+ fd = emacs_open (NULL_DEVICE, O_RDONLY, 0);
+ if (fd < 0)
+ report_file_error ("Opening null device", Qnil);
+ record_unwind_protect_ptr (close_file_ptr_unwind, &fd);
+ }
+
+ GCPRO1 (infile);
if (nargs > 3 && !NILP (args[3]))
Fdelete_region (start, end);
@@ -1116,9 +1102,11 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
args[0] = args[2];
nargs = 2;
}
- args[1] = filename_string;
+ args[1] = infile;
- RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args)));
+ val = call_process (nargs, args, &fd, &infile);
+ dynwind_end ();
+ return val;
}
#ifndef WINDOWSNT
@@ -1181,18 +1169,11 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
#ifdef WINDOWSNT
int cpid;
HANDLE handles[3];
-#endif /* WINDOWSNT */
+#else
+ int exec_errno;
pid_t pid = getpid ();
-
- /* Close Emacs's descriptors that this process should not have. */
- close_process_descs ();
-
- /* DOS_NT isn't in a vfork, so if we are in the middle of load-file,
- we will lose if we call close_load_descs here. */
-#ifndef DOS_NT
- close_load_descs ();
-#endif
+#endif /* WINDOWSNT */
/* 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.
@@ -1201,23 +1182,21 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
static variables as if the superior had done alloca and will be
cleaned up in the usual way. */
{
- register char *temp;
- size_t i; /* size_t, because ptrdiff_t might overflow here! */
+ char *temp;
+ ptrdiff_t i;
i = SBYTES (current_dir);
#ifdef MSDOS
/* MSDOS must have all environment variables malloc'ed, because
low-level libc functions that launch subsidiary processes rely
on that. */
- pwd_var = xmalloc (i + 6);
+ pwd_var = xmalloc (i + 5);
#else
- pwd_var = alloca (i + 6);
+ pwd_var = alloca (i + 5);
#endif
temp = pwd_var + 4;
memcpy (pwd_var, "PWD=", 4);
- memcpy (temp, SDATA (current_dir), i);
- if (!IS_DIRECTORY_SEP (temp[i - 1])) temp[i++] = DIRECTORY_SEP;
- temp[i] = 0;
+ strcpy (temp, SSDATA (current_dir));
#ifndef DOS_NT
/* We can't signal an Elisp error here; we're in a vfork. Since
@@ -1226,7 +1205,7 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
are changed between the check and this chdir, but we should
at least check. */
if (chdir (temp) < 0)
- _exit (errno);
+ _exit (EXIT_CANCELED);
#else /* DOS_NT */
/* Get past the drive letter, so that d:/ is left alone. */
if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
@@ -1351,28 +1330,27 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
}
#ifndef MSDOS
- emacs_close (0);
- emacs_close (1);
- emacs_close (2);
-
+ /* Redirect file descriptors and clear the close-on-exec flag on the
+ redirected ones. IN, OUT, and ERR are close-on-exec so they
+ need not be closed explicitly. */
dup2 (in, 0);
dup2 (out, 1);
dup2 (err, 2);
- emacs_close (in);
- if (out != in)
- emacs_close (out);
- if (err != in && err != out)
- emacs_close (err);
setpgid (0, 0);
tcsetpgrp (0, pid);
execve (new_argv[0], new_argv, env);
+ exec_errno = errno;
- emacs_write (1, "Can't exec program: ", 20);
- emacs_write (1, new_argv[0], strlen (new_argv[0]));
- emacs_write (1, "\n", 1);
- _exit (1);
+ /* Avoid deadlock if the child's perror writes to a full pipe; the
+ pipe's reader is the parent, but with vfork the parent can't
+ run until the child exits. Truncate the diagnostic instead. */
+ fcntl (STDERR_FILENO, F_SETFL, O_NONBLOCK);
+
+ errno = exec_errno;
+ emacs_perror (new_argv[0]);
+ _exit (exec_errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE);
#else /* MSDOS */
pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
@@ -1387,7 +1365,8 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
#ifndef WINDOWSNT
/* Move the file descriptor FD so that its number is not less than MINFD.
- If the file descriptor is moved at all, the original is freed. */
+ If the file descriptor is moved at all, the original is closed on MSDOS,
+ but not elsewhere as the caller will close it anyway. */
static int
relocate_fd (int fd, int minfd)
{
@@ -1395,18 +1374,15 @@ relocate_fd (int fd, int minfd)
return fd;
else
{
- int new = fcntl (fd, F_DUPFD, minfd);
+ int new = fcntl (fd, F_DUPFD_CLOEXEC, minfd);
if (new == -1)
{
- const char *message_1 = "Error while setting up child: ";
- const char *errmessage = strerror (errno);
- const char *message_2 = "\n";
- emacs_write (2, message_1, strlen (message_1));
- emacs_write (2, errmessage, strlen (errmessage));
- emacs_write (2, message_2, strlen (message_2));
- _exit (1);
+ emacs_perror ("while setting up child");
+ _exit (EXIT_CANCELED);
}
+#ifdef MSDOS
emacs_close (fd);
+#endif
return new;
}
}
@@ -1536,14 +1512,14 @@ init_callproc_1 (void)
#ifdef HAVE_NS
etc_dir ? etc_dir :
#endif
- PATH_DATA);
+ PATH_DATA, 0);
Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory));
Vdoc_directory = decode_env_path ("EMACSDOC",
#ifdef HAVE_NS
etc_dir ? etc_dir :
#endif
- PATH_DOC);
+ PATH_DOC, 0);
Vdoc_directory = Ffile_name_as_directory (Fcar (Vdoc_directory));
/* Check the EMACSPATH environment variable, defaulting to the
@@ -1552,10 +1528,10 @@ init_callproc_1 (void)
#ifdef HAVE_NS
path_exec ? path_exec :
#endif
- PATH_EXEC);
+ PATH_EXEC, 0);
Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
/* FIXME? For ns, path_exec should go at the front? */
- Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
+ Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
}
/* This is run after init_cmdargs, when Vinstallation_directory is valid. */
@@ -1596,9 +1572,9 @@ init_callproc (void)
#ifdef HAVE_NS
path_exec ? path_exec :
#endif
- PATH_EXEC);
+ PATH_EXEC, 0);
Vexec_path = Fcons (tem, Vexec_path);
- Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
+ Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
}
Vexec_directory = Ffile_name_as_directory (tem);
@@ -1623,17 +1599,17 @@ init_callproc (void)
if (data_dir == 0)
{
Lisp_Object tem, tem1, srcdir;
+ Lisp_Object lispdir = Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0));
+
+ srcdir = Fexpand_file_name (build_string ("../src/"), lispdir);
- srcdir = Fexpand_file_name (build_string ("../src/"),
- build_string (PATH_DUMPLOADSEARCH));
- tem = Fexpand_file_name (build_string ("GNU"), Vdata_directory);
+ tem = Fexpand_file_name (build_string ("NEWS"), Vdata_directory);
tem1 = Ffile_exists_p (tem);
if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1))
{
Lisp_Object newdir;
- newdir = Fexpand_file_name (build_string ("../etc/"),
- build_string (PATH_DUMPLOADSEARCH));
- tem = Fexpand_file_name (build_string ("GNU"), newdir);
+ newdir = Fexpand_file_name (build_string ("../etc/"), lispdir);
+ tem = Fexpand_file_name (build_string ("NEWS"), newdir);
tem1 = Ffile_exists_p (tem);
if (!NILP (tem1))
Vdata_directory = newdir;
@@ -1659,7 +1635,7 @@ init_callproc (void)
#ifdef DOS_NT
Vshared_game_score_directory = Qnil;
#else
- Vshared_game_score_directory = build_string (PATH_GAME);
+ Vshared_game_score_directory = build_unibyte_string (PATH_GAME);
if (NILP (Ffile_accessible_directory_p (Vshared_game_score_directory)))
Vshared_game_score_directory = Qnil;
#endif
@@ -1680,15 +1656,18 @@ set_initial_environment (void)
void
syms_of_callproc (void)
{
+#include "callproc.x"
+
#ifndef DOS_NT
Vtemp_file_name_pattern = build_string ("emacsXXXXXX");
-#elif defined (WINDOWSNT)
+#else /* DOS_NT */
Vtemp_file_name_pattern = build_string ("emXXXXXX");
-#else
- Vtemp_file_name_pattern = build_string ("detmp.XXX");
#endif
staticpro (&Vtemp_file_name_pattern);
+ synch_process_tempfile = make_number (0);
+ staticpro (&synch_process_tempfile);
+
DEFVAR_LISP ("shell-file-name", Vshell_file_name,
doc: /* File name to load inferior shells from.
Initialized from the SHELL environment variable, or to a system-dependent
@@ -1696,7 +1675,11 @@ default if SHELL is not set. */);
DEFVAR_LISP ("exec-path", Vexec_path,
doc: /* List of directories to search programs to run in subprocesses.
-Each element is a string (directory name) or nil (try default directory). */);
+Each element is a string (directory name) or nil (try default directory).
+
+By default the last element of this list is `exec-directory'. The
+last element is not always used, for example in shell completion
+(`shell-dynamic-complete-command'). */);
DEFVAR_LISP ("exec-suffixes", Vexec_suffixes,
doc: /* List of suffixes to try to find executable file names.
@@ -1760,8 +1743,4 @@ use.
See `setenv' and `getenv'. */);
Vprocess_environment = Qnil;
-
- defsubr (&Scall_process);
- defsubr (&Sgetenv_internal);
- defsubr (&Scall_process_region);
}