/* Asynchronous subprocess control for GNU Emacs.
- Copyright (C) 1985, 1986, 1987, 1988, 1993 Free Software Foundation, Inc.
+ Copyright (C) 1985, 86, 87, 88, 93, 94 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <sys/types.h> /* some typedefs are used in sys/file.h */
#include <sys/file.h>
#include <sys/stat.h>
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+#ifdef WINDOWSNT
+#include <stdlib.h>
+#include <fcntl.h>
+#endif /* not WINDOWSNT */
#ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
#include <sys/socket.h>
#include <client.h>
#endif
-/* DGUX inet_addr returns a 'struct in_addr'. */
-#ifdef DGUX
+/* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */
+#ifdef HAVE_BROKEN_INET_ADDR
#define IN_ADDR struct in_addr
#define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
#else
#endif /* HAVE_PTYS and no O_NDELAY */
#endif /* BSD or STRIDE */
+#ifdef BROKEN_O_NONBLOCK
+#undef O_NONBLOCK
+#endif /* BROKEN_O_NONBLOCK */
+
#ifdef NEED_BSDTTY
#include <bsdtty.h>
#endif
Lisp_Object Qprocessp;
Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed;
+Lisp_Object Qlast_nonmenu_event;
/* Qexit is declared and initialized in eval.c. */
/* a process object is a network connection when its childp field is neither
#ifdef HAVE_SOCKETS
static Lisp_Object stream_process;
-#define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String)
+#define NETCONN_P(p) (GC_STRINGP (XPROCESS (p)->childp))
#else
#define NETCONN_P(p) 0
#endif /* HAVE_SOCKETS */
#include "syswait.h"
-extern errno;
-extern sys_nerr;
+extern int errno;
+extern char *strerror ();
+#ifdef VMS
extern char *sys_errlist[];
+#endif
+
+#ifndef HAVE_H_ERRNO
+extern int h_errno;
+#endif
+#ifndef SYS_SIGLIST_DECLARED
#ifndef VMS
#ifndef BSD4_1
+#ifndef WINDOWSNT
#ifndef LINUX
extern char *sys_siglist[];
-#endif
-#else
+#endif /* not LINUX */
+#else /* BSD4_1 */
char *sys_siglist[] =
{
"bum signal!!",
"exceeded CPU time limit",
"exceeded file size limit"
};
+#endif /* not WINDOWSNT */
#endif
#endif /* VMS */
+#endif /* ! SYS_SIGLIST_DECLARED */
/* t means use pty, nil means use a pipe,
maybe other values to come. */
#define FD_ZERO(p) (*(p) = 0)
#endif /* no FD_SET */
-/* Mask of bits indicating the descriptors that we wait for input on */
+/* If we support X Windows, turn on the code to poll periodically
+ to detect C-g. It isn't actually used when doing interrupt input. */
+#ifdef HAVE_X_WINDOWS
+#define POLL_FOR_INPUT
+#endif
+
+/* Mask of bits indicating the descriptors that we wait for input on. */
static SELECT_TYPE input_wait_mask;
-/* Descriptor to use for keyboard input. */
-static int keyboard_descriptor;
+/* Mask that excludes keyboard input descriptor (s). */
+
+static SELECT_TYPE non_keyboard_wait_mask;
+
+/* The largest descriptor currently in use for a process object. */
+static int max_process_desc;
+
+/* The largest descriptor currently in use for keyboard input. */
+static int max_keyboard_desc;
/* Nonzero means delete a process right away if it exits. */
static int delete_exited_processes;
/* Indexed by descriptor, gives the process (if any) for that descriptor */
-static Lisp_Object chan_process[MAXDESC];
+Lisp_Object chan_process[MAXDESC];
/* Alist of elements (NAME . PROCESS) */
-static Lisp_Object Vprocess_alist;
+Lisp_Object Vprocess_alist;
/* Buffered-ahead input char from process, indexed by channel.
-1 means empty (no char is buffered).
output from the process is to read at least one char.
Always -1 on systems that support FIONREAD. */
-static int proc_buffered_char[MAXDESC];
+/* Don't make static; need to access externally. */
+int proc_buffered_char[MAXDESC];
static Lisp_Object get_process ();
+
+/* Maximum number of bytes to send to a pty without an eof. */
+static int pty_max_bytes;
+
+/* Open an available pty, returning a file descriptor.
+ Return -1 on failure.
+ The file name of the terminal corresponding to the pty
+ is left in the variable pty_name. */
+
+static char pty_name[24];
\f
/* Compute the Lisp form of the process status, p->status, from
the numeric status that was returned by `wait'. */
{
Lisp_Object tem;
- if (XTYPE (l) == Lisp_Symbol)
+ if (SYMBOLP (l))
{
*symbol = l;
*code = 0;
if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
{
+ char *signame = 0;
+ if (code < NSIG)
+ {
#ifndef VMS
- string = build_string (code < NSIG ? sys_siglist[code] : "unknown");
+ /* Cast to suppress warning if the table has const char *. */
+ signame = (char *) sys_siglist[code];
#else
- string = build_string (code < NSIG ? sys_errlist[code] : "unknown");
+ signame = sys_errlist[code];
#endif
+ }
+ if (signame == 0)
+ signame = "unknown";
+ string = build_string (signame);
string2 = build_string (coredump ? " (core dumped)\n" : "\n");
XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
return concat2 (string, string2);
\f
#ifdef HAVE_PTYS
-/* Open an available pty, returning a file descriptor.
- Return -1 on failure.
- The file name of the terminal corresponding to the pty
- is left in the variable pty_name. */
-
-char pty_name[24];
-
int
allocate_pty ()
{
make_process (name)
Lisp_Object name;
{
+ struct Lisp_Vector *vec;
register Lisp_Object val, tem, name1;
register struct Lisp_Process *p;
char suffix[10];
register int i;
- /* size of process structure includes the vector header,
- so deduct for that. But struct Lisp_Vector includes the first
- element, thus deducts too much, so add it back. */
- val = Fmake_vector (make_number ((sizeof (struct Lisp_Process)
- - sizeof (struct Lisp_Vector)
- + sizeof (Lisp_Object))
- / sizeof (Lisp_Object)),
- Qnil);
- XSETTYPE (val, Lisp_Process);
-
- p = XPROCESS (val);
- XSET (p->infd, Lisp_Int, -1);
- XSET (p->outfd, Lisp_Int, -1);
- XFASTINT (p->pid) = 0;
- XFASTINT (p->tick) = 0;
- XFASTINT (p->update_tick) = 0;
+ vec = allocate_vectorlike ((EMACS_INT) VECSIZE (struct Lisp_Process));
+ for (i = 0; i < VECSIZE (struct Lisp_Process); i++)
+ vec->contents[i] = Qnil;
+ vec->size = VECSIZE (struct Lisp_Process);
+ p = (struct Lisp_Process *)vec;
+
+ XSETINT (p->infd, -1);
+ XSETINT (p->outfd, -1);
+ XSETFASTINT (p->pid, 0);
+ XSETFASTINT (p->tick, 0);
+ XSETFASTINT (p->update_tick, 0);
p->raw_status_low = Qnil;
p->raw_status_high = Qnil;
p->status = Qrun;
}
name = name1;
p->name = name;
+ XSETPROCESS (val, p);
Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
return val;
}
(obj)
Lisp_Object obj;
{
- return XTYPE (obj) == Lisp_Process ? Qt : Qnil;
+ return PROCESSP (obj) ? Qt : Qnil;
}
DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
(name)
register Lisp_Object name;
{
- if (XTYPE (name) == Lisp_Process)
+ if (PROCESSP (name))
return name;
CHECK_STRING (name, 0);
return Fcdr (Fassoc (name, Vprocess_alist));
for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
{
proc = Fcdr (Fcar (tail));
- if (XTYPE (proc) == Lisp_Process && EQ (XPROCESS (proc)->buffer, buf))
+ if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
return proc;
}
return Qnil;
get_process (name)
register Lisp_Object name;
{
- register Lisp_Object proc;
- if (NILP (name))
- proc = Fget_buffer_process (Fcurrent_buffer ());
+ register Lisp_Object proc, obj;
+ if (STRINGP (name))
+ {
+ obj = Fget_process (name);
+ if (NILP (obj))
+ obj = Fget_buffer (name);
+ if (NILP (obj))
+ error ("Process %s does not exist", XSTRING (name)->data);
+ }
+ else if (NILP (name))
+ obj = Fcurrent_buffer ();
else
+ obj = name;
+
+ /* Now obj should be either a buffer object or a process object.
+ */
+ if (BUFFERP (obj))
{
- proc = Fget_process (name);
+ proc = Fget_buffer_process (obj);
if (NILP (proc))
- proc = Fget_buffer_process (Fget_buffer (name));
+ error ("Buffer %s has no process", XSTRING (XBUFFER (obj)->name)->data);
}
-
- if (!NILP (proc))
- return proc;
-
- if (NILP (name))
- error ("Current buffer has no process");
else
- error ("Process %s does not exist", XSTRING (name)->data);
- /* NOTREACHED */
+ {
+ CHECK_PROCESS (obj, 0);
+ proc = obj;
+ }
+ return proc;
}
DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
{
register struct Lisp_Process *p;
register Lisp_Object status;
- proc = Fget_process (proc);
+
+ if (STRINGP (proc))
+ proc = Fget_process (proc);
+ else
+ proc = get_process (proc);
+
if (NILP (proc))
return proc;
+
p = XPROCESS (proc);
if (!NILP (p->raw_status_low))
update_status (p);
status = p->status;
- if (XTYPE (status) == Lisp_Cons)
+ if (CONSP (status))
status = XCONS (status)->car;
if (NETCONN_P (proc))
{
CHECK_PROCESS (proc, 0);
if (!NILP (XPROCESS (proc)->raw_status_low))
update_status (XPROCESS (proc));
- if (XTYPE (XPROCESS (proc)->status) == Lisp_Cons)
+ if (CONSP (XPROCESS (proc)->status))
return XCONS (XCONS (XPROCESS (proc)->status)->cdr)->car;
return make_number (0);
}
return XPROCESS (proc)->command;
}
+DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
+ "Return the name of the terminal PROCESS uses, or nil if none.\n\
+This is the terminal that the process itself reads and writes on,\n\
+not the name of the pty that Emacs uses to talk with that terminal.")
+ (proc)
+ register Lisp_Object proc;
+{
+ CHECK_PROCESS (proc, 0);
+ return XPROCESS (proc)->tty_name;
+}
+
DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
2, 2, 0,
"Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
{
CHECK_PROCESS (proc, 0);
if (EQ (filter, Qt))
- FD_CLR (XINT (XPROCESS (proc)->infd), &input_wait_mask);
+ {
+ FD_CLR (XINT (XPROCESS (proc)->infd), &input_wait_mask);
+ FD_CLR (XINT (XPROCESS (proc)->infd), &non_keyboard_wait_mask);
+ }
else if (EQ (XPROCESS (proc)->filter, Qt))
- FD_SET (XINT (XPROCESS (proc)->infd), &input_wait_mask);
+ {
+ FD_SET (XINT (XPROCESS (proc)->infd), &input_wait_mask);
+ FD_SET (XINT (XPROCESS (proc)->infd), &non_keyboard_wait_mask);
+ }
XPROCESS (proc)->filter = filter;
return filter;
}
return XPROCESS (proc)->sentinel;
}
+DEFUN ("set-process-window-size", Fset_process_window_size,
+ Sset_process_window_size, 3, 3, 0,
+ "Tell PROCESS that it has logical window size HEIGHT and WIDTH.")
+ (proc, height, width)
+ register Lisp_Object proc, height, width;
+{
+ CHECK_PROCESS (proc, 0);
+ CHECK_NATNUM (height, 0);
+ CHECK_NATNUM (width, 0);
+ if (set_window_size (XINT (XPROCESS (proc)->infd),
+ XINT (height), XINT(width)) <= 0)
+ return Qnil;
+ else
+ return Qt;
+}
+
DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
Sprocess_kill_without_query, 1, 2, 0,
"Say no query needed if PROCESS is running when Emacs is exited.\n\
-Optional second argument if non-nill says to require a query.\n\
+Optional second argument if non-nil says to require a query.\n\
Value is t if a query was formerly required.")
(proc, value)
register Lisp_Object proc, value;
register int state;
char tembuf[80];
- XFASTINT (minspace) = 1;
+ XSETFASTINT (minspace, 1);
set_buffer_internal (XBUFFER (Vstandard_output));
Fbuffer_disable_undo (Vstandard_output);
current_buffer->truncate_lines = Qt;
write_string ("\
-Proc Status Buffer Command\n\
----- ------ ------ -------\n", -1);
+Proc Status Buffer Tty Command\n\
+---- ------ ------ --- -------\n", -1);
for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
{
if (!NILP (p->raw_status_low))
update_status (p);
symbol = p->status;
- if (XTYPE (p->status) == Lisp_Cons)
+ if (CONSP (p->status))
symbol = XCONS (p->status)->car;
Findent_to (make_number (37), minspace);
+ if (STRINGP (p->tty_name))
+ Finsert (1, &p->tty_name);
+ else
+ insert_string ("(none)");
+
+ Findent_to (make_number (49), minspace);
+
if (NETCONN_P (proc))
{
sprintf (tembuf, "(network stream connection to %s)\n",
#else /* not VMS */
new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
- for (i = 3; i < nargs; i++)
- {
- tem = args[i];
- CHECK_STRING (tem, i);
- new_argv[i - 2] = XSTRING (tem)->data;
- }
- new_argv[i - 2] = 0;
- new_argv[0] = XSTRING (program)->data;
-
/* If program file name is not absolute, search our path for it */
- if (new_argv[0][0] != '/')
+ if (!IS_DIRECTORY_SEP (XSTRING (program)->data[0])
+ && !(XSTRING (program)->size > 1
+ && IS_DEVICE_SEP (XSTRING (program)->data[1])))
{
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
tem = Qnil;
+ GCPRO4 (name, program, buffer, current_dir);
openp (Vexec_path, program, EXEC_SUFFIXES, &tem, 1);
+ UNGCPRO;
if (NILP (tem))
report_file_error ("Searching for program", Fcons (program, Qnil));
new_argv[0] = XSTRING (tem)->data;
}
+ else
+ new_argv[0] = XSTRING (program)->data;
+
+ for (i = 3; i < nargs; i++)
+ {
+ tem = args[i];
+ CHECK_STRING (tem, i);
+ new_argv[i - 2] = XSTRING (tem)->data;
+ }
+ new_argv[i - 2] = 0;
#endif /* not VMS */
proc = make_process (name);
start_process_unwind (proc)
Lisp_Object proc;
{
- if (XTYPE (proc) != Lisp_Process)
+ if (!PROCESSP (proc))
abort ();
/* Was PROC started successfully? */
inchannel = outchannel = -1;
#ifdef HAVE_PTYS
- if (EQ (Vprocess_connection_type, Qt))
+ if (!NILP (Vprocess_connection_type))
outchannel = inchannel = allocate_pty ();
if (inchannel >= 0)
}
#else /* not SKTPAIR */
{
+#ifdef WINDOWSNT
+ pipe_with_inherited_out (sv);
+ inchannel = sv[0];
+ forkout = sv[1];
+
+ pipe_with_inherited_in (sv);
+ forkin = sv[0];
+ outchannel = sv[1];
+#else /* not WINDOWSNT */
pipe (sv);
inchannel = sv[0];
forkout = sv[1];
pipe (sv);
outchannel = sv[1];
forkin = sv[0];
+#endif /* not WINDOWSNT */
}
#endif /* not SKTPAIR */
/* Record this as an active process, with its channels.
As a result, child_setup will close Emacs's side of the pipes. */
chan_process[inchannel] = process;
- XSET (XPROCESS (process)->infd, Lisp_Int, inchannel);
- XSET (XPROCESS (process)->outfd, Lisp_Int, outchannel);
+ XSETINT (XPROCESS (process)->infd, inchannel);
+ XSETINT (XPROCESS (process)->outfd, outchannel);
/* Record the tty descriptor used in the subprocess. */
if (forkin < 0)
XPROCESS (process)->subtty = Qnil;
else
- XFASTINT (XPROCESS (process)->subtty) = forkin;
+ XSETFASTINT (XPROCESS (process)->subtty, forkin);
XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
XPROCESS (process)->status = Qrun;
#endif /* not BSD4_1 */
#endif /* SIGCHLD */
+ FD_SET (inchannel, &input_wait_mask);
+ FD_SET (inchannel, &non_keyboard_wait_mask);
+ if (inchannel > max_process_desc)
+ max_process_desc = inchannel;
+
/* Until we store the proper pid, enable sigchld_handler
to recognize an unknown pid as standing for this process.
It is very important not to let this `marker' value stay
Protect it from permanent change. */
char **save_environ = environ;
+#ifndef WINDOWSNT
pid = vfork ();
if (pid == 0)
+#endif /* not WINDOWSNT */
{
int xforkin = forkin;
int xforkout = forkout;
#ifdef HAVE_PTYS
/* First, disconnect its current controlling terminal. */
#ifdef HAVE_SETSID
+ /* We tried doing setsid only if pty_flag, but it caused
+ process_set_signal to fail on SGI when using a pipe. */
setsid ();
-#ifdef TIOCSCTTY
/* Make the pty's terminal the controlling terminal. */
if (pty_flag)
- /* We ignore the return value
- because faith@cs.unc.edu says that is necessary on Linux. */
- ioctl (xforkin, TIOCSCTTY, 0);
+ {
+#ifdef TIOCSCTTY
+ /* We ignore the return value
+ because faith@cs.unc.edu says that is necessary on Linux. */
+ ioctl (xforkin, TIOCSCTTY, 0);
#endif
+ }
#else /* not HAVE_SETSID */
#ifdef USG
- /* It's very important to call setpgrp() here and no time
+ /* It's very important to call setpgrp here and no time
afterwards. Otherwise, we lose our controlling tty which
is set when we open the pty. */
setpgrp ();
#endif /* USG */
#endif /* not HAVE_SETSID */
+#if defined (HAVE_TERMIOS) && defined (LDISC1)
+ if (pty_flag && xforkin >= 0)
+ {
+ struct termios t;
+ tcgetattr (xforkin, &t);
+ t.c_lflag = LDISC1;
+ if (tcsetattr (xforkin, TCSANOW, &t) < 0)
+ write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
+ }
+#else
+#if defined (NTTYDISC) && defined (TIOCSETD)
+ if (pty_flag && xforkin >= 0)
+ {
+ /* Use new line discipline. */
+ int ldisc = NTTYDISC;
+ ioctl (xforkin, TIOCSETD, &ldisc);
+ }
+#endif
+#endif
#ifdef TIOCNOTTY
/* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
can do TIOCSPGRP only to the process's controlling tty. */
/* In order to get a controlling terminal on some versions
of BSD, it is necessary to put the process in pgrp 0
before it opens the terminal. */
+#ifdef OSF1
+ setpgid (0, 0);
+#else
setpgrp (0, 0);
+#endif
#endif
}
#endif /* TIOCNOTTY */
This makes the pty the controlling terminal of the subprocess. */
if (pty_flag)
{
+#ifdef SET_CHILD_PTY_PGRP
+ int pgrp = getpid ();
+#endif
+
/* I wonder if close (open (pty_name, ...)) would work? */
if (xforkin >= 0)
close (xforkin);
xforkout = xforkin = open (pty_name, O_RDWR, 0);
+#ifdef SET_CHILD_PTY_PGRP
+ ioctl (xforkin, TIOCSPGRP, &pgrp);
+ ioctl (xforkout, TIOCSPGRP, &pgrp);
+#endif
+
if (xforkin < 0)
abort ();
}
#endif /* not UNIPLUS and not RTU */
#ifdef SETUP_SLAVE_PTY
- SETUP_SLAVE_PTY;
+ if (pty_flag)
+ {
+ SETUP_SLAVE_PTY;
+ }
#endif /* SETUP_SLAVE_PTY */
#ifdef AIX
/* On AIX, we've disabled SIGHUP above once we start a child on a pty.
#endif /* not BSD4_1 */
#endif /* SIGCHLD */
- child_setup_tty (xforkout);
+ signal (SIGINT, SIG_DFL);
+ signal (SIGQUIT, SIG_DFL);
+
+ if (pty_flag)
+ child_setup_tty (xforkout);
+#ifdef WINDOWSNT
+ pid = child_setup (xforkin, xforkout, xforkout,
+ new_argv, 1, current_dir);
+#else /* not WINDOWSNT */
child_setup (xforkin, xforkout, xforkout,
new_argv, 1, current_dir);
+#endif /* not WINDOWSNT */
}
environ = save_environ;
}
if (pid < 0)
- report_file_error ("Doing vfork", Qnil);
+ {
+ if (forkin >= 0)
+ close (forkin);
+ if (forkin != forkout && forkout >= 0)
+ close (forkout);
+ report_file_error ("Doing vfork", Qnil);
+ }
- XFASTINT (XPROCESS (process)->pid) = pid;
+ XSETFASTINT (XPROCESS (process)->pid, pid);
- FD_SET (inchannel, &input_wait_mask);
+#ifdef WINDOWSNT
+ register_child (pid, inchannel);
+#endif /* WINDOWSNT */
/* If the subfork execv fails, and it exits,
this close hangs. I don't know why.
stop_polling ();
signal (SIGALRM, create_process_1);
alarm (1);
-#ifdef SYSV4_PTYS
- /* OK to close only if it's not a pty. Otherwise we need to leave
- it open for ioctl to get pgrp when signals are sent, or to send
- the interrupt characters through if that's how we're signalling
- subprocesses. Alternately if you are concerned about running out
- of file descriptors, you could just save the tty name and open
- just to do the ioctl. */
- if (NILP (XFASTINT (XPROCESS (process)->pty_flag)))
-#endif
- {
- XPROCESS (process)->subtty = Qnil;
- if (forkin >= 0)
- close (forkin);
- }
+ XPROCESS (process)->subtty = Qnil;
+ if (forkin >= 0)
+ close (forkin);
alarm (0);
start_polling ();
if (forkin != forkout && forkout >= 0)
close (forkout);
+ XPROCESS (process)->tty_name = build_string (pty_name);
+
#ifdef SIGCHLD
#ifdef BSD4_1
sigrelse (SIGCHLD);
int port;
struct hostent host_info_fixed;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ int retry = 0;
+ int count = specpdl_ptr - specpdl;
GCPRO4 (name, buffer, host, service);
CHECK_STRING (name, 0);
CHECK_STRING (host, 0);
- if (XTYPE(service) == Lisp_Int)
+ if (INTEGERP (service))
port = htons ((unsigned short) XINT (service));
else
{
}
#ifndef TERM
- host_info_ptr = gethostbyname (XSTRING (host)->data);
+ while (1)
+ {
+#ifdef TRY_AGAIN
+ h_errno = 0;
+#endif
+ host_info_ptr = gethostbyname (XSTRING (host)->data);
+#ifdef TRY_AGAIN
+ if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN))
+#endif
+ break;
+ Fsleep_for (make_number (1), Qnil);
+ }
if (host_info_ptr == 0)
/* Attempt to interpret host as numeric inet address */
{
if (s < 0)
report_file_error ("error creating socket", Fcons (name, Qnil));
+ /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
+ when connect is interrupted. So let's not let it get interrupted.
+ Note we do not turn off polling, because polling is only used
+ when not interrupt_input, and thus not normally used on the systems
+ which have this bug. On systems which use polling, there's no way
+ to quit if polling is turned off. */
+ if (interrupt_input)
+ unrequest_sigio ();
+
+ /* Slow down polling to every ten seconds.
+ Some kernels have a bug which causes retrying connect to fail
+ after a connect. */
+#ifdef POLL_FOR_INPUT
+ bind_polling_period (10);
+#endif
+
loop:
- if (connect (s, (struct sockaddr *) &address, sizeof address) == -1)
+ if (connect (s, (struct sockaddr *) &address, sizeof address) == -1
+ && errno != EISCONN)
{
int xerrno = errno;
+
if (errno == EINTR)
goto loop;
+ if (errno == EADDRINUSE && retry < 20)
+ {
+ retry++;
+ goto loop;
+ }
+
close (s);
+
+ if (interrupt_input)
+ request_sigio ();
+
errno = xerrno;
report_file_error ("connection failed",
Fcons (host, Fcons (name, Qnil)));
}
+
+#ifdef POLL_FOR_INPUT
+ unbind_to (count, Qnil);
+#endif
+
+ if (interrupt_input)
+ request_sigio ();
+
#else /* TERM */
s = connect_server (0);
if (s < 0)
XPROCESS (proc)->filter = Qnil;
XPROCESS (proc)->command = Qnil;
XPROCESS (proc)->pid = Qnil;
- XSET (XPROCESS (proc)->infd, Lisp_Int, s);
- XSET (XPROCESS (proc)->outfd, Lisp_Int, outch);
+ XSETINT (XPROCESS (proc)->infd, s);
+ XSETINT (XPROCESS (proc)->outfd, outch);
XPROCESS (proc)->status = Qrun;
FD_SET (inch, &input_wait_mask);
+ FD_SET (inch, &non_keyboard_wait_mask);
+ if (inch > max_process_desc)
+ max_process_desc = inch;
UNGCPRO;
return proc;
close (outchannel);
#endif
- XSET (p->infd, Lisp_Int, -1);
- XSET (p->outfd, Lisp_Int, -1);
+ XSETINT (p->infd, -1);
+ XSETINT (p->outfd, -1);
chan_process[inchannel] = Qnil;
FD_CLR (inchannel, &input_wait_mask);
+ FD_CLR (inchannel, &non_keyboard_wait_mask);
+ if (inchannel == max_process_desc)
+ {
+ int i;
+ /* We just closed the highest-numbered process input descriptor,
+ so recompute the highest-numbered one now. */
+ max_process_desc = 0;
+ for (i = 0; i < MAXDESC; i++)
+ if (!NILP (chan_process[i]))
+ max_process_desc = i;
+ }
}
}
close_process_descs ()
{
+#ifndef WINDOWSNT
int i;
for (i = 0; i < MAXDESC; i++)
{
close (out);
}
}
+#endif
}
\f
DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
{
CHECK_NUMBER (timeout_msecs, 2);
useconds = XINT (timeout_msecs);
- if (XTYPE (timeout) != Lisp_Int)
- XSET (timeout, Lisp_Int, 0);
+ if (!INTEGERP (timeout))
+ XSETINT (timeout, 0);
{
int carry = useconds / 1000000;
}
if (NILP (proc))
- XFASTINT (proc) = 0;
+ XSETFASTINT (proc, 0);
return
(wait_reading_process_input (seconds, useconds, proc, 0)
function Fwaiting_for_user_input_p below) whether emacs was waiting
for user-input when that process-filter was called.
waiting_for_input cannot be used as that is by definition 0 when
- lisp code is being evalled */
+ lisp code is being evalled.
+ This is also used in record_asynch_buffer_change.
+ For that purpose, this must be 0
+ when not inside wait_reading_process_input. */
static int waiting_for_user_input_p;
/* Read and dispose of subprocess output while waiting for timeout to
1 to return when input is available, or
-1 meaning caller will actually read the input, so don't throw to
the quit handler, or
- a cons cell, meaning wait wait until its car is non-nil
+ a cons cell, meaning wait until its car is non-nil
(and gobble terminal input into the buffer if any arrives), or
a process object, meaning wait until something arrives from that
process. The return value is true iff we read some input from
/* If read_kbd is a process to watch, set wait_proc and wait_channel
accordingly. */
- if (XTYPE (read_kbd) == Lisp_Process)
+ if (PROCESSP (read_kbd))
{
wait_proc = XPROCESS (read_kbd);
wait_channel = XINT (wait_proc->infd);
- XFASTINT (read_kbd) = 0;
+ XSETFASTINT (read_kbd, 0);
}
/* If waiting for non-nil in a cell, record where. */
- if (XTYPE (read_kbd) == Lisp_Cons)
+ if (CONSP (read_kbd))
{
wait_for_cell = &XCONS (read_kbd)->car;
- XFASTINT (read_kbd) = 0;
+ XSETFASTINT (read_kbd, 0);
}
waiting_for_user_input_p = XINT (read_kbd);
EMACS_ADD_TIME (end_time, end_time, timeout);
}
+ /* It would not be safe to call this below,
+ where we call redisplay_preserve_echo_area. */
+ if (do_display && frame_garbaged)
+ prepare_menu_bars ();
+
while (1)
{
/* If calling from keyboard input, do not quit
if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0)
{
/* It's okay for us to do this and then continue with
- the loop, since timeout has already been zeroed out. */
+ the loop, since timeout has already been zeroed out. */
clear_waiting_for_input ();
status_notify ();
}
/* Wait till there is something to do */
- Available = input_wait_mask;
- /* We used to have && wait_for_cell == 0
- but that led to lossage handling selection_request events:
- within one, we would start to handle another. */
- if (! XINT (read_kbd))
- FD_CLR (keyboard_descriptor, &Available);
+ if (! XINT (read_kbd) && wait_for_cell == 0)
+ Available = non_keyboard_wait_mask;
+ else
+ Available = input_wait_mask;
/* If frame size has changed or the window is newly mapped,
redisplay now, before we start to wait. There is a race
condition here; if a SIGIO arrives between now and the select
and indicates that a frame is trashed, the select may block
displaying a trashed screen. */
- if (frame_garbaged)
+ if (frame_garbaged && do_display)
redisplay_preserve_echo_area ();
if (XINT (read_kbd) && detect_input_pending ())
the ptc file descriptor is automatically closed,
yielding EBADF here or at select() call above.
So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
- in m-ibmrt-aix.h), and here we just ignore the select error.
+ in m/ibmrt-aix.h), and here we just ignore the select error.
Cleanup occurs c/o status_notify after SIGCLD. */
FD_ZERO (&Available); /* Cannot depend on values returned */
#else
#endif
}
else
- error("select error: %s", sys_errlist[xerrno]);
+ error("select error: %s", strerror (xerrno));
}
#if defined(sun) && !defined(USG5_4)
- else if (nfds > 0 && FD_ISSET (keyboard_descriptor, &Available)
+ else if (nfds > 0 && keyboard_bit_set (&Available)
&& interrupt_input)
/* System sometimes fails to deliver SIGIO.
/* If there is any, return immediately
to give it higher priority than subprocesses */
- /* We used to do his if wait_for_cell,
+ /* We used to do this if wait_for_cell,
but that caused infinite recursion in selection request events. */
- if ((XINT (read_kbd))
+ if ((XINT (read_kbd) || wait_for_cell)
&& detect_input_pending ())
{
swallow_events ();
but select says there is input. */
if (XINT (read_kbd) && interrupt_input
- && (FD_ISSET (keyboard_descriptor, &Available)))
+ && (keyboard_bit_set (&Available)))
kill (0, SIGIO);
#endif
/* Check for data from a process. */
/* Really FIRST_PROC_DESC should be 0 on Unix,
but this is safer in the short run. */
- for (channel = keyboard_descriptor == 0 ? FIRST_PROC_DESC : 0;
- channel < MAXDESC; channel++)
+ for (channel = 0; channel <= max_process_desc; channel++)
{
- if (FD_ISSET (channel, &Available))
+ if (FD_ISSET (channel, &Available)
+ && FD_ISSET (channel, &non_keyboard_wait_mask))
{
int nread;
} /* end for each file descriptor */
} /* end while exit conditions not met */
+ waiting_for_user_input_p = 0;
+
/* If calling from keyboard input, do not quit
since we want to return C-g as an input character.
Otherwise, do pending quit if requested. */
return got_some_input;
}
\f
+/* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
+
+static Lisp_Object
+read_process_output_call (fun_and_args)
+ Lisp_Object fun_and_args;
+{
+ return apply1 (XCONS (fun_and_args)->car, XCONS (fun_and_args)->cdr);
+}
+
+static Lisp_Object
+read_process_output_error_handler (error)
+ Lisp_Object error;
+{
+ cmd_error_internal (error, "error in process filter: ");
+ Vinhibit_quit = Qt;
+ update_echo_area ();
+ Fsleep_for (make_number (2));
+}
+
/* Read pending output from the process channel,
starting with our buffered-ahead character if we have one.
Yield number of characters read.
#else /* not VMS */
if (proc_buffered_char[channel] < 0)
+#ifdef WINDOWSNT
+ nchars = read_child_output (channel, chars, sizeof (chars));
+#else
nchars = read (channel, chars, sizeof chars);
+#endif
else
{
chars[0] = proc_buffered_char[channel];
proc_buffered_char[channel] = -1;
+#ifdef WINDOWSNT
+ nchars = read_child_output (channel, chars + 1, sizeof (chars) - 1);
+#else
nchars = read (channel, chars + 1, sizeof chars - 1);
+#endif
if (nchars < 0)
nchars = 1;
else
it up. */
int count = specpdl_ptr - specpdl;
Lisp_Object odeactivate;
+ Lisp_Object obuffer;
odeactivate = Vdeactivate_mark;
+ obuffer = Fcurrent_buffer ();
specbind (Qinhibit_quit, Qt);
- call2 (outstream, proc, make_string (chars, nchars));
+ specbind (Qlast_nonmenu_event, Qt);
+
+ internal_condition_case_1 (read_process_output_call,
+ Fcons (outstream,
+ Fcons (proc,
+ Fcons (make_string (chars, nchars),
+ Qnil))),
+ !NILP (Vdebug_on_error) ? Qnil : Qerror,
+ read_process_output_error_handler);
/* Handling the process output should not deactivate the mark. */
Vdeactivate_mark = odeactivate;
+ if (! EQ (Fcurrent_buffer (), obuffer))
+ record_asynch_buffer_change ();
+
+ if (waiting_for_user_input_p)
+ prepare_menu_bars ();
+
#ifdef VMS
start_vms_process_read (vs);
#endif
- unbind_to (count);
+ unbind_to (count, Qnil);
return nchars;
}
Fset_buffer (p->buffer);
opoint = point;
old_read_only = current_buffer->read_only;
- XFASTINT (old_begv) = BEGV;
- XFASTINT (old_zv) = ZV;
+ XSETFASTINT (old_begv, BEGV);
+ XSETFASTINT (old_zv, ZV);
current_buffer->read_only = Qnil;
at the current end-of-output marker,
thus preserving logical ordering of input and output. */
if (XMARKER (p->mark)->buffer)
- SET_PT (marker_position (p->mark));
+ SET_PT (clip_to_bounds (BEGV, marker_position (p->mark), ZV));
else
SET_PT (ZV);
/* Insert after old_begv, but before old_zv. */
if (point < XFASTINT (old_begv))
- XFASTINT (old_begv) += nchars;
+ XSETFASTINT (old_begv, XFASTINT (old_begv) + nchars);
if (point <= XFASTINT (old_zv))
- XFASTINT (old_zv) += nchars;
+ XSETFASTINT (old_zv, XFASTINT (old_zv) + nchars);
/* Insert before markers in case we are inserting where
the buffer's mark is, and the user's next command is Meta-y. */
DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
0, 0, 0,
- "Returns non-NIL if emacs is waiting for input from the user.\n\
+ "Returns non-nil if emacs is waiting for input from the user.\n\
This is intended for use by asynchronous process output filters and sentinels.")
()
{
- return ((waiting_for_user_input_p) ? Qt : Qnil);
+ return (waiting_for_user_input_p ? Qt : Qnil);
}
\f
/* Sending data to subprocess */
longjmp (send_process_frame, 1);
}
-send_process (proc, buf, len)
+/* Send some data to process PROC.
+ BUF is the beginning of the data; LEN is the number of characters.
+ OBJECT is the Lisp object that the data comes from. */
+
+send_process (proc, buf, len, object)
Lisp_Object proc;
char *buf;
int len;
+ Lisp_Object object;
{
/* Don't use register vars; longjmp can lose them. */
int rv;
unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
-
#ifdef VMS
struct Lisp_Process *p = XPROCESS (proc);
VMS_PROC_STUFF *vs, *get_vms_process_pointer();
else if (write_to_vms_process (vs, buf, len))
;
#else
+
+ if (pty_max_bytes == 0)
+ {
+#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
+ pty_max_bytes = fpathconf (XFASTINT (XPROCESS (proc)->outfd),
+ _PC_MAX_CANON);
+ if (pty_max_bytes < 0)
+ pty_max_bytes = 250;
+#else
+ pty_max_bytes = 250;
+#endif
+ /* Deduct one, to leave space for the eof. */
+ pty_max_bytes--;
+ }
+
if (!setjmp (send_process_frame))
while (len > 0)
{
int this = len;
SIGTYPE (*old_sigpipe)();
+ int flush_pty = 0;
- /* Don't send more than 500 bytes at a time. */
- if (this > 500)
- this = 500;
- old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
- rv = write (XINT (XPROCESS (proc)->outfd), buf, this);
- signal (SIGPIPE, old_sigpipe);
- if (rv < 0)
+ /* Decide how much data we can send in one batch.
+ Long lines need to be split into multiple batches. */
+ if (!NILP (XPROCESS (proc)->pty_flag))
{
- if (0
-#ifdef EWOULDBLOCK
- || errno == EWOULDBLOCK
-#endif
-#ifdef EAGAIN
- || errno == EAGAIN
-#endif
- )
+ /* Starting this at zero is always correct when not the first iteration
+ because the previous iteration ended by sending C-d.
+ It may not be correct for the first iteration
+ if a partial line was sent in a separate send_process call.
+ If that proves worth handling, we need to save linepos
+ in the process object. */
+ int linepos = 0;
+ char *ptr = buf;
+ char *end = buf + len;
+
+ /* Scan through this text for a line that is too long. */
+ while (ptr != end && linepos < pty_max_bytes)
{
- /* It would be nice to accept process output here,
- but that is difficult. For example, it could
- garbage what we are sending if that is from a buffer. */
- immediate_quit = 1;
- QUIT;
- sleep (1);
- immediate_quit = 0;
- continue;
+ if (*ptr == '\n')
+ linepos = 0;
+ else
+ linepos++;
+ ptr++;
}
- report_file_error ("writing to process", Fcons (proc, Qnil));
+ /* If we found one, break the line there
+ and put in a C-d to force the buffer through. */
+ this = ptr - buf;
}
- buf += rv;
- len -= rv;
- /* Allow input from processes between bursts of sending.
- Otherwise things may get stopped up. */
- if (len > 0)
+
+ /* Send this batch, using one or more write calls. */
+ while (this > 0)
{
- Lisp_Object zero;
+ old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
+ rv = write (XINT (XPROCESS (proc)->outfd), buf, this);
+ signal (SIGPIPE, old_sigpipe);
- XFASTINT (zero) = 0;
- wait_reading_process_input (-1, 0, zero, 0);
+ if (rv < 0)
+ {
+ if (0
+#ifdef EWOULDBLOCK
+ || errno == EWOULDBLOCK
+#endif
+#ifdef EAGAIN
+ || errno == EAGAIN
+#endif
+ )
+ /* Buffer is full. Wait, accepting input;
+ that may allow the program
+ to finish doing output and read more. */
+ {
+ Lisp_Object zero;
+ int offset;
+
+ /* Running filters might relocate buffers or strings.
+ Arrange to relocate BUF. */
+ if (BUFFERP (object))
+ offset = BUF_PTR_CHAR_POS (XBUFFER (object),
+ (unsigned char *) buf);
+ else if (STRINGP (object))
+ offset = buf - (char *) XSTRING (object)->data;
+
+ XSETFASTINT (zero, 0);
+ wait_reading_process_input (1, 0, zero, 0);
+
+ if (BUFFERP (object))
+ buf = (char *) BUF_CHAR_ADDRESS (XBUFFER (object), offset);
+ else if (STRINGP (object))
+ buf = offset + (char *) XSTRING (object)->data;
+
+ rv = 0;
+ }
+ else
+ /* This is a real error. */
+ report_file_error ("writing to process", Fcons (proc, Qnil));
+ }
+ buf += rv;
+ len -= rv;
+ this -= rv;
}
+
+ /* If we sent just part of the string, put in an EOF
+ to force it through, before we send the rest. */
+ if (len > 0)
+ Fprocess_send_eof (proc);
}
#endif
else
move_gap (start);
start1 = XINT (start);
- send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start));
+ send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start),
+ Fcurrent_buffer ());
return Qnil;
}
Lisp_Object proc;
CHECK_STRING (string, 1);
proc = get_process (process);
- send_process (proc, XSTRING (string)->data, XSTRING (string)->size);
+ send_process (proc, XSTRING (string)->data, XSTRING (string)->size, string);
return Qnil;
}
\f
right away.
If we can, we try to signal PROCESS by sending control characters
- down the pipe. This allows us to signal inferiors who have changed
+ down the pty. This allows us to signal inferiors who have changed
their uid, for which killpg would return an EPERM error. */
static void
{
case SIGINT:
tcgetattr (XINT (p->infd), &t);
- send_process (proc, &t.c_cc[VINTR], 1);
+ send_process (proc, &t.c_cc[VINTR], 1, Qnil);
return;
case SIGQUIT:
tcgetattr (XINT (p->infd), &t);
- send_process (proc, &t.c_cc[VQUIT], 1);
+ send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
return;
case SIGTSTP:
tcgetattr (XINT (p->infd), &t);
-#if defined (VSWTCH) && !defined (IRIX5)
- send_process (proc, &t.c_cc[VSWTCH], 1);
+#if defined (VSWTCH) && !defined (PREFER_VSUSP)
+ send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
#else
- send_process (proc, &t.c_cc[VSUSP], 1);
+ send_process (proc, &t.c_cc[VSUSP], 1, Qnil);
#endif
return;
}
{
case SIGINT:
ioctl (XINT (p->infd), TIOCGETC, &c);
- send_process (proc, &c.t_intrc, 1);
+ send_process (proc, &c.t_intrc, 1, Qnil);
return;
case SIGQUIT:
ioctl (XINT (p->infd), TIOCGETC, &c);
- send_process (proc, &c.t_quitc, 1);
+ send_process (proc, &c.t_quitc, 1, Qnil);
return;
#ifdef SIGTSTP
case SIGTSTP:
ioctl (XINT (p->infd), TIOCGLTC, &lc);
- send_process (proc, &lc.t_suspc, 1);
+ send_process (proc, &lc.t_suspc, 1, Qnil);
return;
#endif /* ! defined (SIGTSTP) */
}
{
case SIGINT:
ioctl (XINT (p->infd), TCGETA, &t);
- send_process (proc, &t.c_cc[VINTR], 1);
+ send_process (proc, &t.c_cc[VINTR], 1, Qnil);
return;
case SIGQUIT:
ioctl (XINT (p->infd), TCGETA, &t);
- send_process (proc, &t.c_cc[VQUIT], 1);
+ send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
return;
#ifdef SIGTSTP
case SIGTSTP:
ioctl (XINT (p->infd), TCGETA, &t);
- send_process (proc, &t.c_cc[VSWTCH], 1);
+ send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
return;
#endif /* ! defined (SIGTSTP) */
}
#endif /* ! defined (SIGCONT) */
case SIGINT:
#ifdef VMS
- send_process (proc, "\003", 1); /* ^C */
+ send_process (proc, "\003", 1, Qnil); /* ^C */
goto whoosh;
#endif
case SIGQUIT:
#ifdef VMS
- send_process (proc, "\031", 1); /* ^Y */
+ send_process (proc, "\031", 1, Qnil); /* ^Y */
goto whoosh;
#endif
case SIGKILL:
DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
"Interrupt process PROCESS. May be process or name of one.\n\
PROCESS may be a process, a buffer, or the name of a process or buffer.\n\
-Nil or no arg means current buffer's process.\n\
+nil or no arg means current buffer's process.\n\
Second arg CURRENT-GROUP non-nil means send signal to\n\
the current process-group of the process's controlling terminal\n\
rather than to the process's own process group.\n\
{
CHECK_NUMBER (pid, 0);
CHECK_NUMBER (sig, 1);
+#ifdef WINDOWSNT
+ /* Only works for kill-type signals */
+ return make_number (win32_kill_process (XINT (pid), XINT (sig)));
+#else
return make_number (kill (XINT (pid), XINT (sig)));
+#endif
}
DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
"Make PROCESS see end-of-file in its input.\n\
Eof comes after any text already sent to it.\n\
PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
-nil, indicating the current buffer's process.")
+nil, indicating the current buffer's process.\n\
+If PROCESS is a network connection, or is a process communicating\n\
+through a pipe (as opposed to a pty), then you cannot send any more\n\
+text to PROCESS after you call this function.")
(process)
Lisp_Object process;
{
if (! EQ (XPROCESS (proc)->status, Qrun))
error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data);
- /* Sending a zero-length record is supposed to mean eof
- when TIOCREMOTE is turned on. */
-#ifdef DID_REMOTE
- {
- char buf[1];
- write (XINT (XPROCESS (proc)->outfd), buf, 0);
- }
-#else /* did not do TOICREMOTE */
#ifdef VMS
- send_process (proc, "\032", 1); /* ^z */
+ send_process (proc, "\032", 1, Qnil); /* ^z */
#else
if (!NILP (XPROCESS (proc)->pty_flag))
- send_process (proc, "\004", 1);
+ send_process (proc, "\004", 1, Qnil);
else
{
close (XINT (XPROCESS (proc)->outfd));
- XSET (XPROCESS (proc)->outfd, Lisp_Int, open (NULL_DEVICE, O_WRONLY));
+ XSETINT (XPROCESS (proc)->outfd, open (NULL_DEVICE, O_WRONLY));
}
#endif /* VMS */
-#endif /* did not do TOICREMOTE */
return process;
}
{
Lisp_Object tail, proc;
- for (tail = Vprocess_alist; XGCTYPE (tail) == Lisp_Cons;
- tail = XCONS (tail)->cdr)
+ for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
{
proc = XCONS (XCONS (tail)->car)->cdr;
- if (XGCTYPE (proc) == Lisp_Process
+ if (GC_PROCESSP (proc)
&& (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
{
if (NETCONN_P (proc))
- deactivate_process (proc);
+ Fdelete_process (proc);
else if (XINT (XPROCESS (proc)->infd) >= 0)
process_send_signal (proc, SIGHUP, Qnil, 1);
}
{
proc = XCONS (XCONS (tail)->car)->cdr;
p = XPROCESS (proc);
- if (XTYPE (p->pid) == Lisp_Int && XINT (p->pid) == -1)
+ if (INTEGERP (p->pid) && XINT (p->pid) == -1)
break;
p = 0;
}
if (p != 0)
{
union { int i; WAITTYPE wt; } u;
+ int clear_desc_flag = 0;
XSETINT (p->tick, ++process_tick);
u.wt = w;
- XFASTINT (p->raw_status_low) = u.i & 0xffff;
- XFASTINT (p->raw_status_high) = u.i >> 16;
+ XSETFASTINT (p->raw_status_low, u.i & 0xffff);
+ XSETFASTINT (p->raw_status_high, u.i >> 16);
/* If process has terminated, stop waiting for its output. */
- if (WIFSIGNALED (w) || WIFEXITED (w))
- if (XINT (p->infd) >= 0)
+ if ((WIFSIGNALED (w) || WIFEXITED (w))
+ && XINT (p->infd) >= 0)
+ clear_desc_flag = 1;
+
+ /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
+ if (clear_desc_flag)
+ {
FD_CLR (XINT (p->infd), &input_wait_mask);
+ FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
+ }
/* Tell wait_reading_process_input that it needs to wake up and
look around. */
if (WIFEXITED (w))
synch_process_retcode = WRETCODE (w);
else if (WIFSIGNALED (w))
+ {
+ int code = WTERMSIG (w);
+ char *signame = 0;
+
+ if (code < NSIG)
+ {
#ifndef VMS
- synch_process_death = (char *) sys_siglist[WTERMSIG (w)];
+ /* Suppress warning if the table has const char *. */
+ signame = (char *) sys_siglist[code];
#else
- synch_process_death = sys_errlist[WTERMSIG (w)];
+ signame = sys_errlist[code];
#endif
+ }
+ if (signame == 0)
+ signame = "unknown";
+
+ synch_process_death = signame;
+ }
/* Tell wait_reading_process_input that it needs to wake up and
look around. */
get another signal.
Otherwise (on systems that have WNOHANG), loop around
to use up all the processes that have something to tell us. */
-#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG))
+#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG)) || defined (WINDOWSNT)
#ifdef USG
signal (signo, sigchld_handler);
#endif
return Qnil;
}
+static Lisp_Object
+exec_sentinel_error_handler (error)
+ Lisp_Object error;
+{
+ cmd_error_internal (error, "error in process sentinel: ");
+ Vinhibit_quit = Qt;
+ update_echo_area ();
+ Fsleep_for (make_number (2));
+}
+
static void
exec_sentinel (proc, reason)
Lisp_Object proc, reason;
{
- Lisp_Object sentinel;
+ Lisp_Object sentinel, obuffer, odeactivate;
register struct Lisp_Process *p = XPROCESS (proc);
int count = specpdl_ptr - specpdl;
+ odeactivate = Vdeactivate_mark;
+ obuffer = Fcurrent_buffer ();
sentinel = p->sentinel;
if (NILP (sentinel))
return;
record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
/* Inhibit quit so that random quits don't screw up a running filter. */
specbind (Qinhibit_quit, Qt);
- call2 (sentinel, proc, reason);
- unbind_to (count);
+ specbind (Qlast_nonmenu_event, Qt);
+
+ internal_condition_case_1 (read_process_output_call,
+ Fcons (sentinel,
+ Fcons (proc, Fcons (reason, Qnil))),
+ !NILP (Vdebug_on_error) ? Qnil : Qerror,
+ exec_sentinel_error_handler);
+
+ Vdeactivate_mark = odeactivate;
+ if (! EQ (Fcurrent_buffer (), obuffer))
+ record_asynch_buffer_change ();
+
+ if (waiting_for_user_input_p)
+ prepare_menu_bars ();
+ unbind_to (count, Qnil);
}
/* Report all recent events of a change in process status
status_notify ()
{
register Lisp_Object proc, buffer;
- Lisp_Object tail = Qnil;
- Lisp_Object msg = Qnil;
+ Lisp_Object tail, msg;
struct gcpro gcpro1, gcpro2;
+ tail = Qnil;
+ msg = Qnil;
/* We need to gcpro tail; if read_process_output calls a filter
which deletes a process and removes the cons to which tail points
from Vprocess_alist, and then causes a GC, tail is an unprotected
/* If process is terminated, deactivate it or delete it. */
symbol = p->status;
- if (XTYPE (p->status) == Lisp_Cons)
+ if (CONSP (p->status))
symbol = XCONS (p->status)->car;
if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
when a process becomes runnable. */
else if (!EQ (symbol, Qrun) && !NILP (buffer))
{
- Lisp_Object ro = XBUFFER (buffer)->read_only;
- Lisp_Object tem;
+ Lisp_Object ro, tem;
struct buffer *old = current_buffer;
int opoint;
+ ro = XBUFFER (buffer)->read_only;
+
/* Avoid error if buffer is deleted
(probably that's why the process is dead, too) */
if (NILP (XBUFFER (buffer)->name))
UNGCPRO;
}
\f
+/* The first time this is called, assume keyboard input comes from DESC
+ instead of from where we used to expect it.
+ Subsequent calls mean assume input keyboard can come from DESC
+ in addition to other places. */
+
+static int add_keyboard_wait_descriptor_called_flag;
+
+void
+add_keyboard_wait_descriptor (desc)
+ int desc;
+{
+ if (! add_keyboard_wait_descriptor_called_flag)
+ FD_CLR (0, &input_wait_mask);
+ add_keyboard_wait_descriptor_called_flag = 1;
+ FD_SET (desc, &input_wait_mask);
+ if (desc > max_keyboard_desc)
+ max_keyboard_desc = desc;
+}
+
+/* From now on, do not expect DESC to give keyboard input. */
+
+void
+delete_keyboard_wait_descriptor (desc)
+ int desc;
+{
+ int fd;
+ int lim = max_keyboard_desc;
+
+ FD_CLR (desc, &input_wait_mask);
+
+ if (desc == max_keyboard_desc)
+ for (fd = 0; fd < lim; fd++)
+ if (FD_ISSET (fd, &input_wait_mask)
+ && !FD_ISSET (fd, &non_keyboard_wait_mask))
+ max_keyboard_desc = fd;
+}
+
+/* Return nonzero if *MASK has a bit set
+ that corresponds to one of the keyboard input descriptors. */
+
+int
+keyboard_bit_set (mask)
+ SELECT_TYPE *mask;
+{
+ int fd;
+
+ for (fd = 0; fd < max_keyboard_desc; fd++)
+ if (FD_ISSET (fd, mask) && FD_ISSET (fd, &input_wait_mask)
+ && !FD_ISSET (fd, &non_keyboard_wait_mask))
+ return 1;
+
+ return 0;
+}
+\f
init_process ()
{
register int i;
#endif
FD_ZERO (&input_wait_mask);
+ FD_ZERO (&non_keyboard_wait_mask);
+ max_process_desc = 0;
- keyboard_descriptor = 0;
- FD_SET (keyboard_descriptor, &input_wait_mask);
+ FD_SET (0, &input_wait_mask);
Vprocess_alist = Qnil;
for (i = 0; i < MAXDESC; i++)
}
}
-/* From now on, assume keyboard input comes from descriptor DESC. */
-
-void
-change_keyboard_wait_descriptor (desc)
- int desc;
-{
- FD_CLR (keyboard_descriptor, &input_wait_mask);
- keyboard_descriptor = desc;
- FD_SET (keyboard_descriptor, &input_wait_mask);
-}
-
syms_of_process ()
{
#ifdef HAVE_SOCKETS
Qclosed = intern ("closed");
staticpro (&Qclosed);
+ Qlast_nonmenu_event = intern ("last-nonmenu-event");
+ staticpro (&Qlast_nonmenu_event);
+
staticpro (&Vprocess_alist);
DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
"Control type of device used to communicate with subprocesses.\n\
-Values are nil to use a pipe, and t or 'pty for a pty. Note that if\n\
-pty's are not available, this variable will be ignored. The value takes\n\
-effect when `start-process' is called.");
+Values are nil to use a pipe, or t or `pty' to use a pty.\n\
+The value has no effect if the system has no ptys or if all ptys are busy:\n\
+then a pipe is used in any case.\n\
+The value takes effect when `start-process' is called.");
Vprocess_connection_type = Qt;
defsubr (&Sprocessp);
defsubr (&Sprocess_exit_status);
defsubr (&Sprocess_id);
defsubr (&Sprocess_name);
+ defsubr (&Sprocess_tty_name);
defsubr (&Sprocess_command);
defsubr (&Sset_process_buffer);
defsubr (&Sprocess_buffer);
defsubr (&Sset_process_filter);
defsubr (&Sprocess_filter);
defsubr (&Sset_process_sentinel);
+ defsubr (&Sset_process_window_size);
defsubr (&Sprocess_sentinel);
defsubr (&Sprocess_kill_without_query);
defsubr (&Slist_processes);
`subprocesses' isn't defined.
do_display != 0 means redisplay should be done to show subprocess
- output that arrives. This version of the function ignores it.
+ output that arrives.
Return true iff we received input from any process. */
/* It's infinite. */
timeout_p = 0;
+ /* This must come before stop_polling. */
+ prepare_menu_bars ();
+
/* Turn off periodic alarms (in case they are in use)
because the select emulator uses alarms. */
stop_polling ();
/* If a frame has been newly mapped and needs updating,
reprocess its display stuff. */
- if (frame_garbaged)
+ if (frame_garbaged && do_display)
redisplay_preserve_echo_area ();
if (XINT (read_kbd) && detect_input_pending ())
DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
- /* Don't confused make-docfile by having two doc strings for this function.
+ /* Don't confuse make-docfile by having two doc strings for this function.
make-docfile does not pay attention to #if, for good reason! */
0)
(name)
HCoop / bpt / emacs.git / blobdiff