Add facility to collect stderr of async subprocess
* src/w32.h (register_aux_fd): New function declaration. * src/w32.c (register_aux_fd): New function. * src/process.h (struct Lisp_Process): New member stderrproc. * src/process.c (PIPECONN_P): New macro. (PIPECONN1_P): New macro. (Fdelete_process, Fprocess_status, Fset_process_buffer) (Fset_process_filter, Fset_process_sentinel, Fstop_process) (Fcontinue_process): Handle pipe process specially. (create_process): Respect p->stderrproc. (Fmake_pipe_process): New function. (Fmake_process): Add new keyword argument :stderr. (wait_reading_process_output): Specially handle a pipe process when it gets an EOF. (syms_of_process): Register Qpipe and Smake_pipe_process. * doc/lispref/processes.texi (Asynchronous Processes): Document `make-pipe-process' and `:stderr' keyword of `make-process'. * lisp/subr.el (start-process): Suggest to use `make-process' handle standard error separately. * test/automated/process-tests.el (process-test-stderr-buffer) (process-test-stderr-filter): New tests. * etc/NEWS: Mention new process type `pipe' and its usage with the `:stderr' keyword of `make-process'.
This commit is contained in:
Daiki Ueno
Daiki Ueno
parent
a2940cd43e
commit
f55ea05bdf
8 changed files with 434 additions and 18 deletions
|
|
@ -739,6 +739,58 @@ If @var{stopped} is non-@code{nil}, start the process in the
|
|||
@item :filter @var{filter}
|
||||
Initialize the process filter to @var{filter}.
|
||||
|
||||
@item :sentinel @var{sentinel}
|
||||
Initialize the process sentinel to @var{sentinel}.
|
||||
|
||||
@item :stderr @var{stderr}
|
||||
Associate @var{stderr} with the standard error of the process.
|
||||
@var{stderr} is either a buffer or a pipe process created with
|
||||
@code{make-pipe-process}.
|
||||
@end table
|
||||
|
||||
The original argument list, modified with the actual connection
|
||||
information, is available via the @code{process-contact} function.
|
||||
@end defun
|
||||
|
||||
@defun make-pipe-process &rest args
|
||||
This function creates a bidirectional pipe which can be attached to a
|
||||
child process (currently only useful with the @code{:stderr} keyword
|
||||
of @code{make-process}).
|
||||
|
||||
The arguments @var{args} are a list of keyword/argument pairs.
|
||||
Omitting a keyword is always equivalent to specifying it with value
|
||||
@code{nil}, except for @code{:coding}.
|
||||
Here are the meaningful keywords:
|
||||
|
||||
@table @asis
|
||||
@item :name @var{name}
|
||||
Use the string @var{name} as the process name. It is modified if
|
||||
necessary to make it unique.
|
||||
|
||||
@item :buffer @var{buffer}
|
||||
Use @var{buffer} as the process buffer.
|
||||
|
||||
@item :coding @var{coding}
|
||||
If @var{coding} is a symbol, it specifies the coding system to be
|
||||
used for both reading and writing of data from and to the
|
||||
connection. If @var{coding} is a cons cell
|
||||
@w{@code{(@var{decoding} . @var{encoding})}}, then @var{decoding}
|
||||
will be used for reading and @var{encoding} for writing.
|
||||
|
||||
If @var{coding} is @code{nil}, the default rules for finding the
|
||||
coding system will apply. @xref{Default Coding Systems}.
|
||||
|
||||
@item :noquery @var{query-flag}
|
||||
Initialize the process query flag to @var{query-flag}.
|
||||
@xref{Query Before Exit}.
|
||||
|
||||
@item :stop @var{stopped}
|
||||
If @var{stopped} is non-@code{nil}, start the process in the
|
||||
``stopped'' state.
|
||||
|
||||
@item :filter @var{filter}
|
||||
Initialize the process filter to @var{filter}.
|
||||
|
||||
@item :sentinel @var{sentinel}
|
||||
Initialize the process sentinel to @var{sentinel}.
|
||||
@end table
|
||||
|
|
|
|||
4
etc/NEWS
4
etc/NEWS
|
|
@ -674,6 +674,10 @@ word syntax, use `\sw' instead.
|
|||
|
||||
* Lisp Changes in Emacs 25.1
|
||||
|
||||
** New process type `pipe', which can be used in combination with the
|
||||
`:stderr' keyword of make-process to handle standard error output
|
||||
of subprocess.
|
||||
|
||||
** New function `make-process' provides an alternative interface to
|
||||
`start-process'. It allows programs to set process parameters such as
|
||||
process filter, sentinel, etc., through keyword arguments (similar to
|
||||
|
|
|
|||
|
|
@ -1936,9 +1936,9 @@ PROGRAM is the program file name. It is searched for in `exec-path'
|
|||
\(which see). If nil, just associate a pty with the buffer. Remaining
|
||||
arguments are strings to give program as arguments.
|
||||
|
||||
If you want to separate standard output from standard error, invoke
|
||||
the command through a shell and redirect one of them using the shell
|
||||
syntax."
|
||||
If you want to separate standard output from standard error, use
|
||||
`make-process' or invoke the command through a shell and redirect
|
||||
one of them using the shell syntax."
|
||||
(unless (fboundp 'make-process)
|
||||
(error "Emacs was compiled without subprocess support"))
|
||||
(apply #'make-process
|
||||
|
|
|
|||
296
src/process.c
296
src/process.c
|
|
@ -189,6 +189,8 @@ process_socket (int domain, int type, int protocol)
|
|||
#define NETCONN1_P(p) (EQ (p->type, Qnetwork))
|
||||
#define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
|
||||
#define SERIALCONN1_P(p) (EQ (p->type, Qserial))
|
||||
#define PIPECONN_P(p) (EQ (XPROCESS (p)->type, Qpipe))
|
||||
#define PIPECONN1_P(p) (EQ (p->type, Qpipe))
|
||||
|
||||
/* Number of events of change of status of a process. */
|
||||
static EMACS_INT process_tick;
|
||||
|
|
@ -411,6 +413,11 @@ pset_write_queue (struct Lisp_Process *p, Lisp_Object val)
|
|||
{
|
||||
p->write_queue = val;
|
||||
}
|
||||
static void
|
||||
pset_stderrproc (struct Lisp_Process *p, Lisp_Object val)
|
||||
{
|
||||
p->stderrproc = val;
|
||||
}
|
||||
|
||||
|
||||
static Lisp_Object
|
||||
|
|
@ -837,7 +844,7 @@ nil, indicating the current buffer's process. */)
|
|||
p = XPROCESS (process);
|
||||
|
||||
p->raw_status_new = 0;
|
||||
if (NETCONN1_P (p) || SERIALCONN1_P (p))
|
||||
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
|
||||
{
|
||||
pset_status (p, list2 (Qexit, make_number (0)));
|
||||
p->tick = ++process_tick;
|
||||
|
|
@ -903,7 +910,7 @@ nil, indicating the current buffer's process. */)
|
|||
status = p->status;
|
||||
if (CONSP (status))
|
||||
status = XCAR (status);
|
||||
if (NETCONN1_P (p) || SERIALCONN1_P (p))
|
||||
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
|
||||
{
|
||||
if (EQ (status, Qexit))
|
||||
status = Qclosed;
|
||||
|
|
@ -987,7 +994,7 @@ Return BUFFER. */)
|
|||
CHECK_BUFFER (buffer);
|
||||
p = XPROCESS (process);
|
||||
pset_buffer (p, buffer);
|
||||
if (NETCONN1_P (p) || SERIALCONN1_P (p))
|
||||
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
|
||||
pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer));
|
||||
setup_process_coding_systems (process);
|
||||
return buffer;
|
||||
|
|
@ -1063,7 +1070,7 @@ The string argument is normally a multibyte string, except:
|
|||
}
|
||||
|
||||
pset_filter (p, filter);
|
||||
if (NETCONN1_P (p) || SERIALCONN1_P (p))
|
||||
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
|
||||
pset_childp (p, Fplist_put (p->childp, QCfilter, filter));
|
||||
setup_process_coding_systems (process);
|
||||
return filter;
|
||||
|
|
@ -1095,7 +1102,7 @@ It gets two arguments: the process, and a string describing the change. */)
|
|||
sentinel = Qinternal_default_process_sentinel;
|
||||
|
||||
pset_sentinel (p, sentinel);
|
||||
if (NETCONN1_P (p) || SERIALCONN1_P (p))
|
||||
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
|
||||
pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel));
|
||||
return sentinel;
|
||||
}
|
||||
|
|
@ -1204,7 +1211,8 @@ list of keywords. */)
|
|||
Fprocess_datagram_address (process));
|
||||
#endif
|
||||
|
||||
if ((!NETCONN_P (process) && !SERIALCONN_P (process)) || EQ (key, Qt))
|
||||
if ((!NETCONN_P (process) && !SERIALCONN_P (process) && !PIPECONN_P (process))
|
||||
|| EQ (key, Qt))
|
||||
return contact;
|
||||
if (NILP (key) && NETCONN_P (process))
|
||||
return list2 (Fplist_get (contact, QChost),
|
||||
|
|
@ -1212,6 +1220,11 @@ list of keywords. */)
|
|||
if (NILP (key) && SERIALCONN_P (process))
|
||||
return list2 (Fplist_get (contact, QCport),
|
||||
Fplist_get (contact, QCspeed));
|
||||
/* FIXME: Return a meaningful value (e.g. the child ends of pipe),
|
||||
if pipe process is useful for other purposes than receiving
|
||||
stderr. */
|
||||
if (NILP (key) && PIPECONN_P (process))
|
||||
return Qt;
|
||||
return Fplist_get (contact, key);
|
||||
}
|
||||
|
||||
|
|
@ -1386,10 +1399,15 @@ to use a pty, or nil to use the default specified through
|
|||
|
||||
:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
|
||||
|
||||
:stderr STDERR -- STDERR is either a buffer or a pipe process attached
|
||||
to the standard error of subprocess. Specifying this implies
|
||||
`:connection-type' is set to `pipe'.
|
||||
|
||||
usage: (make-process &rest ARGS) */)
|
||||
(ptrdiff_t nargs, Lisp_Object *args)
|
||||
{
|
||||
Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
|
||||
Lisp_Object xstderr, stderrproc;
|
||||
ptrdiff_t count = SPECPDL_INDEX ();
|
||||
struct gcpro gcpro1;
|
||||
USE_SAFE_ALLOCA;
|
||||
|
|
@ -1433,6 +1451,27 @@ usage: (make-process &rest ARGS) */)
|
|||
if (!NILP (program))
|
||||
CHECK_STRING (program);
|
||||
|
||||
stderrproc = Qnil;
|
||||
xstderr = Fplist_get (contact, QCstderr);
|
||||
if (PROCESSP (xstderr))
|
||||
{
|
||||
if (!PIPECONN_P (xstderr))
|
||||
error ("Process is not a pipe process");
|
||||
stderrproc = xstderr;
|
||||
}
|
||||
else if (!NILP (xstderr))
|
||||
{
|
||||
struct gcpro gcpro1, gcpro2;
|
||||
CHECK_STRING (program);
|
||||
GCPRO2 (buffer, current_dir);
|
||||
stderrproc = CALLN (Fmake_pipe_process,
|
||||
QCname,
|
||||
concat2 (name, build_string (" stderr")),
|
||||
QCbuffer,
|
||||
Fget_buffer_create (xstderr));
|
||||
UNGCPRO;
|
||||
}
|
||||
|
||||
proc = make_process (name);
|
||||
/* If an error occurs and we can't start the process, we want to
|
||||
remove it from the process list. This means that each error
|
||||
|
|
@ -1463,6 +1502,13 @@ usage: (make-process &rest ARGS) */)
|
|||
else
|
||||
report_file_error ("Unknown connection type", tem);
|
||||
|
||||
if (!NILP (stderrproc))
|
||||
{
|
||||
pset_stderrproc (XPROCESS (proc), stderrproc);
|
||||
|
||||
XPROCESS (proc)->pty_flag = false;
|
||||
}
|
||||
|
||||
#ifdef HAVE_GNUTLS
|
||||
/* AKA GNUTLS_INITSTAGE(proc). */
|
||||
XPROCESS (proc)->gnutls_initstage = GNUTLS_STAGE_EMPTY;
|
||||
|
|
@ -1705,10 +1751,10 @@ static void
|
|||
create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
|
||||
{
|
||||
struct Lisp_Process *p = XPROCESS (process);
|
||||
int inchannel, outchannel;
|
||||
int inchannel, outchannel, errchannel = -1;
|
||||
pid_t pid;
|
||||
int vfork_errno;
|
||||
int forkin, forkout;
|
||||
int forkin, forkout, forkerr = -1;
|
||||
bool pty_flag = 0;
|
||||
char pty_name[PTY_NAME_SIZE];
|
||||
Lisp_Object lisp_pty_name = Qnil;
|
||||
|
|
@ -1746,6 +1792,18 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
|
|||
outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
|
||||
inchannel = p->open_fd[READ_FROM_SUBPROCESS];
|
||||
forkout = p->open_fd[SUBPROCESS_STDOUT];
|
||||
|
||||
if (!NILP (p->stderrproc))
|
||||
{
|
||||
struct Lisp_Process *pp = XPROCESS (p->stderrproc);
|
||||
|
||||
forkerr = pp->open_fd[SUBPROCESS_STDOUT];
|
||||
errchannel = pp->open_fd[READ_FROM_SUBPROCESS];
|
||||
|
||||
/* Close unnecessary file descriptors. */
|
||||
close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
|
||||
close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
|
||||
}
|
||||
}
|
||||
|
||||
#ifndef WINDOWSNT
|
||||
|
|
@ -1792,6 +1850,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
|
|||
char **volatile new_argv_volatile = new_argv;
|
||||
int volatile forkin_volatile = forkin;
|
||||
int volatile forkout_volatile = forkout;
|
||||
int volatile forkerr_volatile = forkerr;
|
||||
struct Lisp_Process *p_volatile = p;
|
||||
|
||||
pid = vfork ();
|
||||
|
|
@ -1801,6 +1860,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
|
|||
new_argv = new_argv_volatile;
|
||||
forkin = forkin_volatile;
|
||||
forkout = forkout_volatile;
|
||||
forkerr = forkerr_volatile;
|
||||
p = p_volatile;
|
||||
|
||||
pty_flag = p->pty_flag;
|
||||
|
|
@ -1811,6 +1871,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
|
|||
{
|
||||
int xforkin = forkin;
|
||||
int xforkout = forkout;
|
||||
int xforkerr = forkerr;
|
||||
|
||||
/* Make the pty be the controlling terminal of the process. */
|
||||
#ifdef HAVE_PTYS
|
||||
|
|
@ -1910,10 +1971,13 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
|
|||
|
||||
if (pty_flag)
|
||||
child_setup_tty (xforkout);
|
||||
|
||||
if (xforkerr < 0)
|
||||
xforkerr = xforkout;
|
||||
#ifdef WINDOWSNT
|
||||
pid = child_setup (xforkin, xforkout, xforkout, new_argv, 1, current_dir);
|
||||
pid = child_setup (xforkin, xforkout, xforkerr, new_argv, 1, current_dir);
|
||||
#else /* not WINDOWSNT */
|
||||
child_setup (xforkin, xforkout, xforkout, new_argv, 1, current_dir);
|
||||
child_setup (xforkin, xforkout, xforkerr, new_argv, 1, current_dir);
|
||||
#endif /* not WINDOWSNT */
|
||||
}
|
||||
|
||||
|
|
@ -1958,6 +2022,11 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
|
|||
close_process_fd (&p->open_fd[READ_FROM_EXEC_MONITOR]);
|
||||
}
|
||||
#endif
|
||||
if (!NILP (p->stderrproc))
|
||||
{
|
||||
struct Lisp_Process *pp = XPROCESS (p->stderrproc);
|
||||
close_process_fd (&pp->open_fd[SUBPROCESS_STDOUT]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -2016,6 +2085,187 @@ create_pty (Lisp_Object process)
|
|||
p->pid = -2;
|
||||
}
|
||||
|
||||
DEFUN ("make-pipe-process", Fmake_pipe_process, Smake_pipe_process,
|
||||
0, MANY, 0,
|
||||
doc: /* Create and return a bidirectional pipe process.
|
||||
|
||||
In Emacs, pipes are represented by process objects, so input and
|
||||
output work as for subprocesses, and `delete-process' closes a pipe.
|
||||
However, a pipe process has no process id, it cannot be signaled,
|
||||
and the status codes are different from normal processes.
|
||||
|
||||
Arguments are specified as keyword/argument pairs. The following
|
||||
arguments are defined:
|
||||
|
||||
:name NAME -- NAME is the name of the process. It is modified if necessary to make it unique.
|
||||
|
||||
:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
|
||||
with the process. Process output goes at the end of that buffer,
|
||||
unless you specify an output stream or filter function to handle the
|
||||
output. If BUFFER is not given, the value of NAME is used.
|
||||
|
||||
:coding CODING -- If CODING is a symbol, it specifies the coding
|
||||
system used for both reading and writing for this process. If CODING
|
||||
is a cons (DECODING . ENCODING), DECODING is used for reading, and
|
||||
ENCODING is used for writing.
|
||||
|
||||
:noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
|
||||
the process is running. If BOOL is not given, query before exiting.
|
||||
|
||||
:stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
|
||||
In the stopped state, a pipe process does not accept incoming data,
|
||||
but you can send outgoing data. The stopped state is cleared by
|
||||
`continue-process' and set by `stop-process'.
|
||||
|
||||
:filter FILTER -- Install FILTER as the process filter.
|
||||
|
||||
:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
|
||||
|
||||
usage: (make-pipe-process &rest ARGS) */)
|
||||
(ptrdiff_t nargs, Lisp_Object *args)
|
||||
{
|
||||
Lisp_Object proc, contact;
|
||||
struct Lisp_Process *p;
|
||||
struct gcpro gcpro1;
|
||||
Lisp_Object name, buffer;
|
||||
Lisp_Object tem, val;
|
||||
ptrdiff_t specpdl_count;
|
||||
int inchannel, outchannel;
|
||||
|
||||
if (nargs == 0)
|
||||
return Qnil;
|
||||
|
||||
contact = Flist (nargs, args);
|
||||
GCPRO1 (contact);
|
||||
|
||||
name = Fplist_get (contact, QCname);
|
||||
CHECK_STRING (name);
|
||||
proc = make_process (name);
|
||||
specpdl_count = SPECPDL_INDEX ();
|
||||
record_unwind_protect (remove_process, proc);
|
||||
p = XPROCESS (proc);
|
||||
|
||||
if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
|
||||
|| emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
|
||||
report_file_error ("Creating pipe", Qnil);
|
||||
outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
|
||||
inchannel = p->open_fd[READ_FROM_SUBPROCESS];
|
||||
|
||||
fcntl (inchannel, F_SETFL, O_NONBLOCK);
|
||||
fcntl (outchannel, F_SETFL, O_NONBLOCK);
|
||||
|
||||
#ifdef WINDOWSNT
|
||||
register_aux_fd (inchannel);
|
||||
#endif
|
||||
|
||||
/* Record this as an active process, with its channels. */
|
||||
chan_process[inchannel] = proc;
|
||||
p->infd = inchannel;
|
||||
p->outfd = outchannel;
|
||||
|
||||
if (inchannel > max_process_desc)
|
||||
max_process_desc = inchannel;
|
||||
|
||||
buffer = Fplist_get (contact, QCbuffer);
|
||||
if (NILP (buffer))
|
||||
buffer = name;
|
||||
buffer = Fget_buffer_create (buffer);
|
||||
pset_buffer (p, buffer);
|
||||
|
||||
pset_childp (p, contact);
|
||||
pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
|
||||
pset_type (p, Qpipe);
|
||||
pset_sentinel (p, Fplist_get (contact, QCsentinel));
|
||||
pset_filter (p, Fplist_get (contact, QCfilter));
|
||||
pset_log (p, Qnil);
|
||||
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
|
||||
p->kill_without_query = 1;
|
||||
if (tem = Fplist_get (contact, QCstop), !NILP (tem))
|
||||
pset_command (p, Qt);
|
||||
eassert (! p->pty_flag);
|
||||
|
||||
if (!EQ (p->command, Qt))
|
||||
{
|
||||
FD_SET (inchannel, &input_wait_mask);
|
||||
FD_SET (inchannel, &non_keyboard_wait_mask);
|
||||
}
|
||||
#ifdef ADAPTIVE_READ_BUFFERING
|
||||
p->adaptive_read_buffering
|
||||
= (NILP (Vprocess_adaptive_read_buffering) ? 0
|
||||
: EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
|
||||
#endif
|
||||
|
||||
/* Make the process marker point into the process buffer (if any). */
|
||||
if (BUFFERP (buffer))
|
||||
set_marker_both (p->mark, buffer,
|
||||
BUF_ZV (XBUFFER (buffer)),
|
||||
BUF_ZV_BYTE (XBUFFER (buffer)));
|
||||
|
||||
{
|
||||
/* Setup coding systems for communicating with the network stream. */
|
||||
struct gcpro gcpro1;
|
||||
/* Qt denotes we have not yet called Ffind_operation_coding_system. */
|
||||
Lisp_Object coding_systems = Qt;
|
||||
Lisp_Object val;
|
||||
|
||||
tem = Fplist_get (contact, QCcoding);
|
||||
val = Qnil;
|
||||
if (!NILP (tem))
|
||||
{
|
||||
val = tem;
|
||||
if (CONSP (val))
|
||||
val = XCAR (val);
|
||||
}
|
||||
else if (!NILP (Vcoding_system_for_read))
|
||||
val = Vcoding_system_for_read;
|
||||
else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
|
||||
|| (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
|
||||
/* We dare not decode end-of-line format by setting VAL to
|
||||
Qraw_text, because the existing Emacs Lisp libraries
|
||||
assume that they receive bare code including a sequence of
|
||||
CR LF. */
|
||||
val = Qnil;
|
||||
else
|
||||
{
|
||||
if (CONSP (coding_systems))
|
||||
val = XCAR (coding_systems);
|
||||
else if (CONSP (Vdefault_process_coding_system))
|
||||
val = XCAR (Vdefault_process_coding_system);
|
||||
else
|
||||
val = Qnil;
|
||||
}
|
||||
pset_decode_coding_system (p, val);
|
||||
|
||||
if (!NILP (tem))
|
||||
{
|
||||
val = tem;
|
||||
if (CONSP (val))
|
||||
val = XCDR (val);
|
||||
}
|
||||
else if (!NILP (Vcoding_system_for_write))
|
||||
val = Vcoding_system_for_write;
|
||||
else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
|
||||
val = Qnil;
|
||||
else
|
||||
{
|
||||
if (CONSP (coding_systems))
|
||||
val = XCDR (coding_systems);
|
||||
else if (CONSP (Vdefault_process_coding_system))
|
||||
val = XCDR (Vdefault_process_coding_system);
|
||||
else
|
||||
val = Qnil;
|
||||
}
|
||||
pset_encode_coding_system (p, val);
|
||||
}
|
||||
/* This may signal an error. */
|
||||
setup_process_coding_systems (proc);
|
||||
|
||||
specpdl_ptr = specpdl + specpdl_count;
|
||||
|
||||
UNGCPRO;
|
||||
return proc;
|
||||
}
|
||||
|
||||
|
||||
/* Convert an internal struct sockaddr to a lisp object (vector or string).
|
||||
The address family of sa is not included in the result. */
|
||||
|
|
@ -4884,7 +5134,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
|
|||
available now and a closed pipe.
|
||||
With luck, a closed pipe will be accompanied by
|
||||
subprocess termination and SIGCHLD. */
|
||||
else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
|
||||
else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)
|
||||
&& !PIPECONN_P (proc))
|
||||
;
|
||||
#endif
|
||||
#ifdef HAVE_PTYS
|
||||
|
|
@ -4916,8 +5167,18 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
|
|||
#endif /* HAVE_PTYS */
|
||||
/* If we can detect process termination, don't consider the
|
||||
process gone just because its pipe is closed. */
|
||||
else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
|
||||
else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)
|
||||
&& !PIPECONN_P (proc))
|
||||
;
|
||||
else if (nread == 0 && PIPECONN_P (proc))
|
||||
{
|
||||
/* Preserve status of processes already terminated. */
|
||||
XPROCESS (proc)->tick = ++process_tick;
|
||||
deactivate_process (proc);
|
||||
if (EQ (XPROCESS (proc)->status, Qrun))
|
||||
pset_status (XPROCESS (proc),
|
||||
list2 (Qexit, make_number (0)));
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Preserve status of processes already terminated. */
|
||||
|
|
@ -5954,7 +6215,8 @@ If PROCESS is a network or serial process, inhibit handling of incoming
|
|||
traffic. */)
|
||||
(Lisp_Object process, Lisp_Object current_group)
|
||||
{
|
||||
if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
|
||||
if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
|
||||
|| PIPECONN_P (process)))
|
||||
{
|
||||
struct Lisp_Process *p;
|
||||
|
||||
|
|
@ -5983,7 +6245,8 @@ If PROCESS is a network or serial process, resume handling of incoming
|
|||
traffic. */)
|
||||
(Lisp_Object process, Lisp_Object current_group)
|
||||
{
|
||||
if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
|
||||
if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
|
||||
|| PIPECONN_P (process)))
|
||||
{
|
||||
struct Lisp_Process *p;
|
||||
|
||||
|
|
@ -7030,7 +7293,7 @@ kill_buffer_processes (Lisp_Object buffer)
|
|||
FOR_EACH_PROCESS (tail, proc)
|
||||
if (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))
|
||||
{
|
||||
if (NETCONN_P (proc) || SERIALCONN_P (proc))
|
||||
if (NETCONN_P (proc) || SERIALCONN_P (proc) || PIPECONN_P (proc))
|
||||
Fdelete_process (proc);
|
||||
else if (XPROCESS (proc)->infd >= 0)
|
||||
process_send_signal (proc, SIGHUP, Qnil, 1);
|
||||
|
|
@ -7330,6 +7593,7 @@ syms_of_process (void)
|
|||
DEFSYM (Qreal, "real");
|
||||
DEFSYM (Qnetwork, "network");
|
||||
DEFSYM (Qserial, "serial");
|
||||
DEFSYM (Qpipe, "pipe");
|
||||
DEFSYM (QCbuffer, ":buffer");
|
||||
DEFSYM (QChost, ":host");
|
||||
DEFSYM (QCservice, ":service");
|
||||
|
|
@ -7346,6 +7610,7 @@ syms_of_process (void)
|
|||
DEFSYM (QCplist, ":plist");
|
||||
DEFSYM (QCcommand, ":command");
|
||||
DEFSYM (QCconnection_type, ":connection-type");
|
||||
DEFSYM (QCstderr, ":stderr");
|
||||
DEFSYM (Qpty, "pty");
|
||||
DEFSYM (Qpipe, "pipe");
|
||||
|
||||
|
|
@ -7451,6 +7716,7 @@ The variable takes effect when `start-process' is called. */);
|
|||
defsubr (&Sset_process_plist);
|
||||
defsubr (&Sprocess_list);
|
||||
defsubr (&Smake_process);
|
||||
defsubr (&Smake_pipe_process);
|
||||
defsubr (&Sserial_process_configure);
|
||||
defsubr (&Smake_serial_process);
|
||||
defsubr (&Sset_network_process_option);
|
||||
|
|
|
|||
|
|
@ -105,6 +105,9 @@ struct Lisp_Process
|
|||
Lisp_Object gnutls_cred_type;
|
||||
#endif
|
||||
|
||||
/* Pipe process attached to the standard error of this process. */
|
||||
Lisp_Object stderrproc;
|
||||
|
||||
/* After this point, there are no Lisp_Objects any more. */
|
||||
/* alloc.c assumes that `pid' is the first such non-Lisp slot. */
|
||||
|
||||
|
|
|
|||
20
src/w32.c
20
src/w32.c
|
|
@ -9473,6 +9473,26 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact)
|
|||
pset_childp (p, childp2);
|
||||
}
|
||||
|
||||
/* For make-pipe-process */
|
||||
void
|
||||
register_aux_fd (int infd)
|
||||
{
|
||||
child_process *cp;
|
||||
|
||||
cp = new_child ();
|
||||
if (!cp)
|
||||
error ("Could not create child process");
|
||||
cp->fd = infd;
|
||||
cp->status = STATUS_READ_ACKNOWLEDGED;
|
||||
|
||||
if (fd_info[ infd ].cp != NULL)
|
||||
{
|
||||
error ("fd_info[fd = %d] is already in use", infd);
|
||||
}
|
||||
fd_info[ infd ].cp = cp;
|
||||
fd_info[ infd ].hnd = (HANDLE) _get_osfhandle (infd);
|
||||
}
|
||||
|
||||
#ifdef HAVE_GNUTLS
|
||||
|
||||
ssize_t
|
||||
|
|
|
|||
|
|
@ -202,6 +202,7 @@ extern int random (void);
|
|||
extern int fchmod (int, mode_t);
|
||||
extern int sys_rename_replace (char const *, char const *, BOOL);
|
||||
extern int pipe2 (int *, int);
|
||||
extern void register_aux_fd (int);
|
||||
|
||||
extern void set_process_dir (char *);
|
||||
extern int sys_spawnve (int, char *, char **, char **);
|
||||
|
|
|
|||
|
|
@ -72,4 +72,74 @@
|
|||
(should (string= (buffer-string) "arg1 = \"x &y\", arg2 = \n"))))
|
||||
(when batfile (delete-file batfile))))))
|
||||
|
||||
(ert-deftest process-test-stderr-buffer ()
|
||||
(skip-unless (executable-find "bash"))
|
||||
(let* ((stdout-buffer (generate-new-buffer "*stdout*"))
|
||||
(stderr-buffer (generate-new-buffer "*stderr*"))
|
||||
(proc (make-process :name "test"
|
||||
:command (list "bash" "-c"
|
||||
(concat "echo hello stdout!; "
|
||||
"echo hello stderr! >&2; "
|
||||
"exit 20"))
|
||||
:buffer stdout-buffer
|
||||
:stderr stderr-buffer))
|
||||
(sentinel-called nil)
|
||||
(start-time (float-time)))
|
||||
(set-process-sentinel proc (lambda (proc msg)
|
||||
(setq sentinel-called t)))
|
||||
(while (not (or sentinel-called
|
||||
(> (- (float-time) start-time)
|
||||
process-test-sentinel-wait-timeout)))
|
||||
(accept-process-output))
|
||||
(cl-assert (eq (process-status proc) 'exit))
|
||||
(cl-assert (= (process-exit-status proc) 20))
|
||||
(should (with-current-buffer stdout-buffer
|
||||
(goto-char (point-min))
|
||||
(looking-at "hello stdout!")))
|
||||
(should (with-current-buffer stderr-buffer
|
||||
(goto-char (point-min))
|
||||
(looking-at "hello stderr!")))))
|
||||
|
||||
(ert-deftest process-test-stderr-filter ()
|
||||
(skip-unless (executable-find "bash"))
|
||||
(let* ((sentinel-called nil)
|
||||
(stderr-sentinel-called nil)
|
||||
(stdout-output nil)
|
||||
(stderr-output nil)
|
||||
(stdout-buffer (generate-new-buffer "*stdout*"))
|
||||
(stderr-buffer (generate-new-buffer "*stderr*"))
|
||||
(stderr-proc (make-pipe-process :name "stderr"
|
||||
:buffer stderr-buffer))
|
||||
(proc (make-process :name "test" :buffer stdout-buffer
|
||||
:command (list "bash" "-c"
|
||||
(concat "echo hello stdout!; "
|
||||
"echo hello stderr! >&2; "
|
||||
"exit 20"))
|
||||
:stderr stderr-proc))
|
||||
(start-time (float-time)))
|
||||
(set-process-filter proc (lambda (proc input)
|
||||
(push input stdout-output)))
|
||||
(set-process-sentinel proc (lambda (proc msg)
|
||||
(setq sentinel-called t)))
|
||||
(set-process-filter stderr-proc (lambda (proc input)
|
||||
(push input stderr-output)))
|
||||
(set-process-sentinel stderr-proc (lambda (proc input)
|
||||
(setq stderr-sentinel-called t)))
|
||||
(while (not (or sentinel-called
|
||||
(> (- (float-time) start-time)
|
||||
process-test-sentinel-wait-timeout)))
|
||||
(accept-process-output))
|
||||
(cl-assert (eq (process-status proc) 'exit))
|
||||
(cl-assert (= (process-exit-status proc) 20))
|
||||
(should sentinel-called)
|
||||
(should (equal 1 (with-current-buffer stdout-buffer
|
||||
(point-max))))
|
||||
(should (equal "hello stdout!\n"
|
||||
(mapconcat #'identity (nreverse stdout-output) "")))
|
||||
(should stderr-sentinel-called)
|
||||
(should (equal 1 (with-current-buffer stderr-buffer
|
||||
(point-max))))
|
||||
(should (equal "hello stderr!\n"
|
||||
(mapconcat #'identity (nreverse stderr-output) "")))))
|
||||
|
||||
(provide 'process-tests)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue