/* 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.
/* 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
/* 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 *);
\f
-/* 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.
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 void
-call_process_kill (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;
}
+ 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 void
-call_process_cleanup (Lisp_Object arg)
+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_void (call_process_kill);
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);
-
-#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));
-#endif
+#endif /* !MSDOS */
}
#ifdef DOS_NT
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;
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;
/* 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)
}
}
- 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)))
{
}
/* 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));
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;
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
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",
- BVAR (current_buffer, directory));
+ 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))
display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
- filefd = emacs_open (SSDATA (infile), O_RDONLY, 0);
- if (filefd < 0)
- {
- int open_errno = errno;
- report_file_errno ("Opening process input file", DECODE_FILE (infile),
- open_errno);
- }
-
- 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);
- }
- 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);
- ok = 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)
- {
- int openp_errno = errno;
- emacs_close (filefd);
- report_file_errno ("Searching for program", args[0], openp_errno);
- }
+ report_file_error ("Searching for program", args[0]);
}
/* If program file name starts with /: for quoting a magic name,
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;
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 = emacs_open (tempfile, O_WRONLY | O_CREAT | O_TRUNC,
- S_IREAD | S_IWRITE);
- if (outfilefd < 0)
+ if (!*tempfile)
+ report_file_error ("Opening process output file", Qnil);
+ output_file = build_string (tempfile);
+ synch_process_tempfile = output_file;
+ }
+#endif
+
+ if (discard_output)
+ {
+ 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;
- emacs_close (filefd);
+ output_file = DECODE_FILE (output_file);
report_file_errno ("Opening process output file",
- build_string (tempfile), open_errno);
+ output_file, open_errno);
}
}
- else
- outfilefd = fd_output;
- fd0 = filefd;
- fd1 = outfilefd;
-#endif /* MSDOS */
-
- if (INTEGERP (buffer))
- {
- fd0 = -1;
- fd1 = emacs_open (NULL_DEVICE, O_WRONLY, 0);
- }
else
{
-#ifndef MSDOS
int fd[2];
if (emacs_pipe (fd) != 0)
- {
- int pipe_errno = errno;
- emacs_close (filefd);
- report_file_errno ("Creating process pipe", Qnil, pipe_errno);
- }
- fd0 = fd[0];
- fd1 = fd[1];
-#endif
+ report_file_error ("Creating process pipe", Qnil);
+ callproc_fd[CALLPROC_PIPEREAD] = fd[0];
+ fd_output = fd[1];
}
+ callproc_fd[CALLPROC_STDOUT] = fd_output;
- {
- int fd_error = fd1;
-
- if (fd_output >= 0)
- fd1 = fd_output;
+ fd_error = fd_output;
- if (NILP (error_file))
- fd_error = emacs_open (NULL_DEVICE, O_WRONLY, 0);
- else if (STRINGP (error_file))
- fd_error = emacs_open (SSDATA (error_file),
+ 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 open_errno = errno;
- 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_errno ("Cannot redirect stderr", error_file, open_errno);
- }
+ if (fd_error < 0)
+ {
+ int open_errno = errno;
+ report_file_errno ("Cannot redirect stderr",
+ (STRINGP (error_file)
+ ? DECODE_FILE (error_file)
+ : build_string (NULL_DEVICE)),
+ open_errno);
+ }
+ callproc_fd[CALLPROC_STDERR] = fd_error;
+ }
#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)
+ /* 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 (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;
+
+ for (i = 0; i < CALLPROC_FDS; i++)
+ if (0 <= callproc_fd[i])
{
- /* 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)
- {
- int open_errno = errno;
- unlink (tempfile);
- emacs_close (filefd);
- report_file_errno ("Cannot re-open temporary file",
- build_string (tempfile), open_errno);
- }
+ emacs_close (callproc_fd[i]);
+ callproc_fd[i] = -1;
}
- else
- fd0 = -1; /* We are not going to read from tempfile. */
+ emacs_close (*filefd);
+ *filefd = -1;
+
+ 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);
+ }
+ }
+
#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
- if (fd0 >= 0)
- emacs_close (fd0);
+ child_setup (*filefd, fd_output, fd_error, new_argv, 0, current_dir);
+ }
- setsid ();
+#endif /* not WINDOWSNT */
- /* Emacs ignores SIGPIPE, but the child should not. */
- signal (SIGPIPE, SIG_DFL);
+ child_errno = errno;
- child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir);
- }
+ if (pid > 0)
+ {
+ synch_process_pid = pid;
-#endif /* not WINDOWSNT */
+ 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;
+ }
+ }
- child_errno = errno;
+ unblock_child_signal (&oldset);
+ unblock_input ();
- if (pid > 0)
+ if (pid < 0)
+ report_file_errno ("Doing vfork", Qnil, child_errno);
+
+ /* 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)
- report_file_errno ("Doing vfork", Qnil, child_errno);
-
if (INTEGERP (buffer))
- return unbind_to (count, Qnil);
+ {
+ dynwind_end ();
+ return 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;
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
/* 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)
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;
}
#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;
synch_process_pid = 0;
SAFE_FREE ();
- unbind_to (count, Qnil);
+ dynwind_end ();
if (WIFSIGNALED (status))
{
return make_number (WEXITSTATUS (status));
}
\f
-static void
-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);
-}
-
/* 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. */
+ 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 Lisp_Object
-create_temp_file (ptrdiff_t nargs, Lisp_Object *args)
+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;
Lisp_Object val, start, end;
{
Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
char *tempfile;
+ ptrdiff_t count;
#ifdef WINDOWSNT
/* Cannot use the result of Fexpand_file_name, because it
GCPRO1 (filename_string);
tempfile = SSDATA (filename_string);
- {
- int fd = mkostemp (tempfile, O_CLOEXEC);
- if (fd < 0)
- report_file_error ("Failed to open temporary file using pattern",
- pattern);
- emacs_close (fd);
- }
-
- record_unwind_protect (delete_temp_file, 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];
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. */
- RETURN_UNGCPRO (filename_string);
+ UNGCPRO;
}
DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
(ptrdiff_t nargs, Lisp_Object *args)
{
struct gcpro gcpro1;
- Lisp_Object infile;
- ptrdiff_t count = SPECPDL_INDEX ();
+ 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;
empty_input = XINT (start) == XINT (end);
}
- infile = empty_input ? Qnil : create_temp_file (nargs, args);
+ 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]))
}
args[1] = infile;
- RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args)));
+ val = call_process (nargs, args, &fd, &infile);
+ dynwind_end ();
+ return val;
}
\f
#ifndef WINDOWSNT
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
#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
#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. */
#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);
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;
#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
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
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.
See `setenv' and `getenv'. */);
Vprocess_environment = Qnil;
-
- defsubr (&Scall_process);
- defsubr (&Sgetenv_internal);
- defsubr (&Scall_process_region);
}
HCoop / bpt / emacs.git / blobdiff