/* Asynchronous subprocess control for GNU Emacs.
- Copyright (C) 1985, 86, 87, 88, 93, 94 Free Software Foundation, Inc.
+ Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 1996
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
#include <signal.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 <netdb.h>
#include <netinet/in.h>
#include <arpa/inet.h>
+#ifdef NEED_NET_ERRNO_H
+#include <net/errno.h>
+#endif /* NEED_NET_ERRNO_H */
#endif /* HAVE_SOCKETS */
/* TERM is a poor-man's SLIP, used on Linux. */
/* Qexit is declared and initialized in eval.c. */
/* a process object is a network connection when its childp field is neither
- Qt nor Qnil but is instead a string (name of foreign host we
- are connected to + name of port we are connected to) */
+ Qt nor Qnil but is instead a cons cell (HOSTNAME PORTNUM). */
#ifdef HAVE_SOCKETS
static Lisp_Object stream_process;
-#define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String)
+#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
#else
#define NETCONN_P(p) 0
#endif /* HAVE_SOCKETS */
#ifndef SYS_SIGLIST_DECLARED
#ifndef VMS
#ifndef BSD4_1
+#ifndef WINDOWSNT
#ifndef LINUX
extern char *sys_siglist[];
#endif /* not LINUX */
"exceeded CPU time limit",
"exceeded file size limit"
};
+#endif /* not WINDOWSNT */
#endif
#endif /* VMS */
#endif /* ! SYS_SIGLIST_DECLARED */
#endif
#endif /* SKTPAIR */
+/* These next two vars are non-static since sysdep.c uses them in the
+ emulation of `select'. */
/* Number of events of change of status of a process. */
-static int process_tick;
-
+int process_tick;
/* Number of events for which the user or sentinel has been notified. */
-static int update_tick;
-
-#ifdef FD_SET
-/* We could get this from param.h, but better not to depend on finding that.
- And better not to risk that it might define other symbols used in this
- file. */
-#ifdef FD_SETSIZE
-#define MAXDESC FD_SETSIZE
-#else
-#define MAXDESC 64
-#endif
-#define SELECT_TYPE fd_set
-#else /* no FD_SET */
-#define MAXDESC 32
-#define SELECT_TYPE int
+int update_tick;
-/* Define the macros to access a single-int bitmap of descriptors. */
-#define FD_SET(n, p) (*(p) |= (1 << (n)))
-#define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
-#define FD_ISSET(n, p) (*(p) & (1 << (n)))
-#define FD_ZERO(p) (*(p) = 0)
-#endif /* no FD_SET */
+#include "sysselect.h"
-/* If we support X Windows, turn on the code to poll periodically
+/* If we support a window system, turn on the code to poll periodically
to detect C-g. It isn't actually used when doing interrupt input. */
-#ifdef HAVE_X_WINDOWS
+#ifdef HAVE_WINDOW_SYSTEM
#define POLL_FOR_INPUT
#endif
-/* Mask of bits indicating the descriptors that we wait for input on */
+/* Mask of bits indicating the descriptors that we wait for input on. */
static SELECT_TYPE input_wait_mask;
+/* 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;
-/* Descriptor to use for keyboard input. */
-static int keyboard_descriptor;
+/* 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;
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 ();
+extern EMACS_TIME timer_check ();
+extern int timers_run;
+
/* Maximum number of bytes to send to a pty without an eof. */
static int pty_max_bytes;
+
+#ifdef HAVE_PTYS
+/* The file name of the pty opened by allocate_pty. */
+
+static char pty_name[24];
+#endif
\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 (code < NSIG)
{
#ifndef VMS
- signame = sys_siglist[code];
+ /* Cast to suppress warning if the table has const char *. */
+ signame = (char *) sys_siglist[code];
#else
signame = sys_errlist[code];
#endif
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;
}
pair = Frassq (proc, Vprocess_alist);
Vprocess_alist = Fdelq (pair, Vprocess_alist);
- Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil);
deactivate_process (proc);
}
\f
DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
"Return t if OBJECT is a process.")
- (obj)
- Lisp_Object obj;
+ (object)
+ Lisp_Object object;
{
- return XTYPE (obj) == Lisp_Process ? Qt : Qnil;
+ return PROCESSP (object) ? 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));
DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
"Return the (or, a) process associated with BUFFER.\n\
BUFFER may be a buffer or the name of one.")
- (name)
- register Lisp_Object name;
+ (buffer)
+ register Lisp_Object buffer;
{
register Lisp_Object buf, tail, proc;
- if (NILP (name)) return Qnil;
- buf = Fget_buffer (name);
+ if (NILP (buffer)) return Qnil;
+ buf = Fget_buffer (buffer);
if (NILP (buf)) return Qnil;
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;
"Delete PROCESS: kill it and forget about it immediately.\n\
PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
nil, indicating the current buffer's process.")
- (proc)
- register Lisp_Object proc;
+ (process)
+ register Lisp_Object process;
{
- proc = get_process (proc);
- XPROCESS (proc)->raw_status_low = Qnil;
- XPROCESS (proc)->raw_status_high = Qnil;
- if (NETCONN_P (proc))
+ process = get_process (process);
+ XPROCESS (process)->raw_status_low = Qnil;
+ XPROCESS (process)->raw_status_high = Qnil;
+ if (NETCONN_P (process))
{
- XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
- XSETINT (XPROCESS (proc)->tick, ++process_tick);
+ XPROCESS (process)->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
+ XSETINT (XPROCESS (process)->tick, ++process_tick);
}
- else if (XINT (XPROCESS (proc)->infd) >= 0)
+ else if (XINT (XPROCESS (process)->infd) >= 0)
{
- Fkill_process (proc, Qnil);
+ Fkill_process (process, Qnil);
/* Do this now, since remove_process will make sigchld_handler do nothing. */
- XPROCESS (proc)->status
+ XPROCESS (process)->status
= Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
- XSETINT (XPROCESS (proc)->tick, ++process_tick);
+ XSETINT (XPROCESS (process)->tick, ++process_tick);
status_notify ();
}
- remove_process (proc);
+ remove_process (process);
return Qnil;
}
\f
nil -- if arg is a process name and no such process exists.\n\
PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
nil, indicating the current buffer's process.")
- (proc)
- register Lisp_Object proc;
+ (process)
+ register Lisp_Object process;
{
register struct Lisp_Process *p;
register Lisp_Object status;
- if (STRINGP (proc))
- proc = Fget_process (proc);
+ if (STRINGP (process))
+ process = Fget_process (process);
else
- proc = get_process (proc);
+ process = get_process (process);
- if (NILP (proc))
- return proc;
+ if (NILP (process))
+ return process;
- p = XPROCESS (proc);
+ p = XPROCESS (process);
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))
+ if (NETCONN_P (process))
{
if (EQ (status, Qrun))
status = Qopen;
1, 1, 0,
"Return the exit status of PROCESS or the signal number that killed it.\n\
If PROCESS has not yet exited or died, return 0.")
- (proc)
- register Lisp_Object proc;
+ (process)
+ register Lisp_Object process;
{
- CHECK_PROCESS (proc, 0);
- if (!NILP (XPROCESS (proc)->raw_status_low))
- update_status (XPROCESS (proc));
- if (XTYPE (XPROCESS (proc)->status) == Lisp_Cons)
- return XCONS (XCONS (XPROCESS (proc)->status)->cdr)->car;
+ CHECK_PROCESS (process, 0);
+ if (!NILP (XPROCESS (process)->raw_status_low))
+ update_status (XPROCESS (process));
+ if (CONSP (XPROCESS (process)->status))
+ return XCONS (XCONS (XPROCESS (process)->status)->cdr)->car;
return make_number (0);
}
"Return the process id of PROCESS.\n\
This is the pid of the Unix process which PROCESS uses or talks to.\n\
For a network connection, this value is nil.")
- (proc)
- register Lisp_Object proc;
+ (process)
+ register Lisp_Object process;
{
- CHECK_PROCESS (proc, 0);
- return XPROCESS (proc)->pid;
+ CHECK_PROCESS (process, 0);
+ return XPROCESS (process)->pid;
}
DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
"Return the name of PROCESS, as a string.\n\
This is the name of the program invoked in PROCESS,\n\
possibly modified to make it unique among process names.")
- (proc)
- register Lisp_Object proc;
+ (process)
+ register Lisp_Object process;
{
- CHECK_PROCESS (proc, 0);
- return XPROCESS (proc)->name;
+ CHECK_PROCESS (process, 0);
+ return XPROCESS (process)->name;
}
DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
This is a list of strings, the first string being the program executed\n\
and the rest of the strings being the arguments given to it.\n\
For a non-child channel, this is nil.")
- (proc)
- register Lisp_Object proc;
+ (process)
+ register Lisp_Object process;
+{
+ CHECK_PROCESS (process, 0);
+ return XPROCESS (process)->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.")
+ (process)
+ register Lisp_Object process;
{
- CHECK_PROCESS (proc, 0);
- return XPROCESS (proc)->command;
+ CHECK_PROCESS (process, 0);
+ return XPROCESS (process)->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).")
- (proc, buffer)
- register Lisp_Object proc, buffer;
+ (process, buffer)
+ register Lisp_Object process, buffer;
{
- CHECK_PROCESS (proc, 0);
+ CHECK_PROCESS (process, 0);
if (!NILP (buffer))
CHECK_BUFFER (buffer, 1);
- XPROCESS (proc)->buffer = buffer;
+ XPROCESS (process)->buffer = buffer;
return buffer;
}
"Return the buffer PROCESS is associated with.\n\
Output from PROCESS is inserted in this buffer\n\
unless PROCESS has a filter.")
- (proc)
- register Lisp_Object proc;
+ (process)
+ register Lisp_Object process;
{
- CHECK_PROCESS (proc, 0);
- return XPROCESS (proc)->buffer;
+ CHECK_PROCESS (process, 0);
+ return XPROCESS (process)->buffer;
}
DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
1, 1, 0,
"Return the marker for the end of the last output from PROCESS.")
- (proc)
- register Lisp_Object proc;
+ (process)
+ register Lisp_Object process;
{
- CHECK_PROCESS (proc, 0);
- return XPROCESS (proc)->mark;
+ CHECK_PROCESS (process, 0);
+ return XPROCESS (process)->mark;
}
DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
the entire string of output is passed to the filter.\n\
The filter gets two arguments: the process and the string of output.\n\
If the process has a filter, its buffer is not used for output.")
- (proc, filter)
- register Lisp_Object proc, filter;
+ (process, filter)
+ register Lisp_Object process, filter;
{
- CHECK_PROCESS (proc, 0);
+ CHECK_PROCESS (process, 0);
if (EQ (filter, Qt))
- FD_CLR (XINT (XPROCESS (proc)->infd), &input_wait_mask);
- else if (EQ (XPROCESS (proc)->filter, Qt))
- FD_SET (XINT (XPROCESS (proc)->infd), &input_wait_mask);
- XPROCESS (proc)->filter = filter;
+ {
+ FD_CLR (XINT (XPROCESS (process)->infd), &input_wait_mask);
+ FD_CLR (XINT (XPROCESS (process)->infd), &non_keyboard_wait_mask);
+ }
+ else if (EQ (XPROCESS (process)->filter, Qt))
+ {
+ FD_SET (XINT (XPROCESS (process)->infd), &input_wait_mask);
+ FD_SET (XINT (XPROCESS (process)->infd), &non_keyboard_wait_mask);
+ }
+ XPROCESS (process)->filter = filter;
return filter;
}
1, 1, 0,
"Returns the filter function of PROCESS; nil if none.\n\
See `set-process-filter' for more info on filter functions.")
- (proc)
- register Lisp_Object proc;
+ (process)
+ register Lisp_Object process;
{
- CHECK_PROCESS (proc, 0);
- return XPROCESS (proc)->filter;
+ CHECK_PROCESS (process, 0);
+ return XPROCESS (process)->filter;
}
DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
"Give PROCESS the sentinel SENTINEL; nil for none.\n\
The sentinel is called as a function when the process changes state.\n\
It gets two arguments: the process, and a string describing the change.")
- (proc, sentinel)
- register Lisp_Object proc, sentinel;
+ (process, sentinel)
+ register Lisp_Object process, sentinel;
{
- CHECK_PROCESS (proc, 0);
- XPROCESS (proc)->sentinel = sentinel;
+ CHECK_PROCESS (process, 0);
+ XPROCESS (process)->sentinel = sentinel;
return sentinel;
}
1, 1, 0,
"Return the sentinel of PROCESS; nil if none.\n\
See `set-process-sentinel' for more info on sentinels.")
- (proc)
- register Lisp_Object proc;
+ (process)
+ register Lisp_Object process;
{
- CHECK_PROCESS (proc, 0);
- return XPROCESS (proc)->sentinel;
+ CHECK_PROCESS (process, 0);
+ return XPROCESS (process)->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;
+ (process, height, width)
+ register Lisp_Object process, height, width;
{
- CHECK_PROCESS (proc, 0);
+ CHECK_PROCESS (process, 0);
CHECK_NATNUM (height, 0);
CHECK_NATNUM (width, 0);
- if (set_window_size (XINT (XPROCESS (proc)->infd),
+ if (set_window_size (XINT (XPROCESS (process)->infd),
XINT (height), XINT(width)) <= 0)
return Qnil;
else
"Say no query needed if PROCESS is running when Emacs is exited.\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;
+ (process, value)
+ register Lisp_Object process, value;
{
Lisp_Object tem;
- CHECK_PROCESS (proc, 0);
- tem = XPROCESS (proc)->kill_without_query;
- XPROCESS (proc)->kill_without_query = Fnull (value);
+ CHECK_PROCESS (process, 0);
+ tem = XPROCESS (process)->kill_without_query;
+ XPROCESS (process)->kill_without_query = Fnull (value);
return Fnull (tem);
}
+DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
+ 1, 1, 0,
+ "Return the contact info of PROCESS; t for a real child.\n\
+For a net connection, the value is a cons cell of the form (HOST SERVICE).")
+ (process)
+ register Lisp_Object process;
+{
+ CHECK_PROCESS (process, 0);
+ return XPROCESS (process)->childp;
+}
+
#if 0 /* Turned off because we don't currently record this info
in the process. Perhaps add it. */
DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
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;
tem = Fcar (Fcdr (p->status));
if (XFASTINT (tem))
{
- sprintf (tembuf, " %d", XFASTINT (tem));
+ sprintf (tembuf, " %d", (int) XFASTINT (tem));
write_string (tembuf, -1);
}
}
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",
- XSTRING (p->childp)->data);
+ XSTRING (XCONS (p->childp)->car)->data);
insert_string (tembuf);
}
else
GCPRO2 (buffer, current_dir);
- current_dir =
- expand_and_dir_to_file
- (Funhandled_file_name_directory (current_dir), Qnil);
+ current_dir
+ = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
+ Qnil);
if (NILP (Ffile_accessible_directory_p (current_dir)))
report_file_error ("Setting current directory",
Fcons (current_buffer->directory, Qnil));
new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
/* If program file name is not absolute, search our path for it */
- if (XSTRING (program)->data[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;
UNGCPRO;
if (NILP (tem))
report_file_error ("Searching for program", Fcons (program, Qnil));
+ tem = Fexpand_file_name (tem, Qnil);
new_argv[0] = XSTRING (tem)->data;
}
else
- new_argv[0] = XSTRING (program)->data;
+ {
+ if (!NILP (Ffile_directory_p (program)))
+ error ("Specified program for new process is a directory");
+
+ new_argv[0] = XSTRING (program)->data;
+ }
for (i = 3; i < nargs; i++)
{
XPROCESS (proc)->filter = Qnil;
XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
+ /* Make the process marker point into the process buffer (if any). */
+ if (!NILP (buffer))
+ Fset_marker (XPROCESS (proc)->mark,
+ make_number (BUF_ZV (XBUFFER (buffer))), buffer);
+
create_process (proc, new_argv, current_dir);
return unbind_to (count, proc);
}
/* This function is the unwind_protect form for Fstart_process. If
- PROC doesn't have its pid set, then we know someone has signalled
+ PROC doesn't have its pid set, then we know someone has signaled
an error and the process wasn't started successfully, so we should
remove it from the process list. */
static Lisp_Object
start_process_unwind (proc)
Lisp_Object proc;
{
- if (XTYPE (proc) != Lisp_Process)
+ if (!PROCESSP (proc))
abort ();
/* Was PROC started successfully? */
create_process_1 (signo)
int signo;
{
-#ifdef USG
+#if defined (USG) && !defined (POSIX_SIGNALS)
/* USG systems forget handlers when they are used;
must reestablish each time */
signal (signo, create_process_1);
char **new_argv;
Lisp_Object current_dir;
{
- int pid, inchannel, outchannel, forkin, forkout;
+ int pid, inchannel, outchannel;
int sv[2];
+#ifdef POSIX_SIGNALS
+ sigset_t procmask;
+ sigset_t blocked;
+ struct sigaction sigint_action;
+ struct sigaction sigquit_action;
+#ifdef AIX
+ struct sigaction sighup_action;
+#endif
+#else /* !POSIX_SIGNALS */
#ifdef SIGCHLD
SIGTYPE (*sigchld)();
#endif
- int pty_flag = 0;
+#endif /* !POSIX_SIGNALS */
+ /* Use volatile to protect variables from being clobbered by longjmp. */
+ volatile int forkin, forkout;
+ volatile int pty_flag = 0;
extern char **environ;
inchannel = outchannel = -1;
#ifdef O_NONBLOCK
fcntl (inchannel, F_SETFL, O_NONBLOCK);
+ fcntl (outchannel, F_SETFL, O_NONBLOCK);
#else
#ifdef O_NDELAY
fcntl (inchannel, F_SETFL, O_NDELAY);
+ fcntl (outchannel, F_SETFL, O_NDELAY);
#endif
#endif
/* 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;
/* Delay interrupts until we have a chance to store
the new fork's pid in its process structure */
+#ifdef POSIX_SIGNALS
+ sigemptyset (&blocked);
+#ifdef SIGCHLD
+ sigaddset (&blocked, SIGCHLD);
+#endif
+#ifdef HAVE_VFORK
+ /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
+ this sets the parent's signal handlers as well as the child's.
+ So delay all interrupts whose handlers the child might munge,
+ and record the current handlers so they can be restored later. */
+ sigaddset (&blocked, SIGINT ); sigaction (SIGINT , 0, &sigint_action );
+ sigaddset (&blocked, SIGQUIT); sigaction (SIGQUIT, 0, &sigquit_action);
+#ifdef AIX
+ sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action );
+#endif
+#endif /* HAVE_VFORK */
+ sigprocmask (SIG_BLOCK, &blocked, &procmask);
+#else /* !POSIX_SIGNALS */
#ifdef SIGCHLD
#ifdef BSD4_1
sighold (SIGCHLD);
#endif /* ordinary USG */
#endif /* not BSD4_1 */
#endif /* SIGCHLD */
+#endif /* !POSIX_SIGNALS */
FD_SET (inchannel, &input_wait_mask);
+ FD_SET (inchannel, &non_keyboard_wait_mask);
if (inchannel > max_process_desc)
max_process_desc = inchannel;
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;
/* 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 HAVE_SETPGID
+ setpgid (0, 0);
+#else
setpgrp (0, 0);
+#endif
#endif
}
#endif /* TIOCNOTTY */
-#if !defined (RTU) && !defined (UNIPLUS)
+#if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
/*** There is a suggestion that this ought to be a
- conditional on TIOCSPGRP. */
+ conditional on TIOCSPGRP,
+ or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
+ Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
+ that system does seem to need this code, even though
+ both HAVE_SETSID and TIOCSCTTY are defined. */
/* Now close the pty (if we had it open) and reopen it.
This makes the pty the controlling terminal of the subprocess. */
if (pty_flag)
close (xforkin);
xforkout = xforkin = open (pty_name, O_RDWR, 0);
+ if (xforkin < 0)
+ {
+ write (1, "Couldn't open the pty terminal ", 31);
+ write (1, pty_name, strlen (pty_name));
+ write (1, "\n", 1);
+ _exit (1);
+ }
+
#ifdef SET_CHILD_PTY_PGRP
ioctl (xforkin, TIOCSPGRP, &pgrp);
ioctl (xforkout, TIOCSPGRP, &pgrp);
#endif
-
- if (xforkin < 0)
- abort ();
}
-#endif /* not UNIPLUS and not RTU */
+#endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
+
#ifdef SETUP_SLAVE_PTY
if (pty_flag)
{
#endif
#endif /* HAVE_PTYS */
+ signal (SIGINT, SIG_DFL);
+ signal (SIGQUIT, SIG_DFL);
+
+ /* Stop blocking signals in the child. */
+#ifdef POSIX_SIGNALS
+ sigprocmask (SIG_SETMASK, &procmask, 0);
+#else /* !POSIX_SIGNALS */
#ifdef SIGCHLD
#ifdef BSD4_1
sigrelse (SIGCHLD);
#endif /* ordinary USG */
#endif /* not BSD4_1 */
#endif /* SIGCHLD */
+#endif /* !POSIX_SIGNALS */
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;
}
+ /* This runs in the Emacs process. */
if (pid < 0)
{
if (forkin >= 0)
close (forkin);
if (forkin != forkout && forkout >= 0)
close (forkout);
- report_file_error ("Doing vfork", Qnil);
}
-
- XFASTINT (XPROCESS (process)->pid) = pid;
+ else
+ {
+ /* vfork succeeded. */
+ XSETFASTINT (XPROCESS (process)->pid, pid);
+
+#ifdef WINDOWSNT
+ register_child (pid, inchannel);
+#endif /* WINDOWSNT */
+
+ /* If the subfork execv fails, and it exits,
+ this close hangs. I don't know why.
+ So have an interrupt jar it loose. */
+ stop_polling ();
+ signal (SIGALRM, create_process_1);
+ alarm (1);
+ XPROCESS (process)->subtty = Qnil;
+ if (forkin >= 0)
+ close (forkin);
+ alarm (0);
+ start_polling ();
+ if (forkin != forkout && forkout >= 0)
+ close (forkout);
- /* If the subfork execv fails, and it exits,
- this close hangs. I don't know why.
- So have an interrupt jar it loose. */
- stop_polling ();
- signal (SIGALRM, create_process_1);
- alarm (1);
- XPROCESS (process)->subtty = Qnil;
- if (forkin >= 0)
- close (forkin);
- alarm (0);
- start_polling ();
- if (forkin != forkout && forkout >= 0)
- close (forkout);
+#ifdef HAVE_PTYS
+ if (pty_flag)
+ XPROCESS (process)->tty_name = build_string (pty_name);
+ else
+#endif
+ XPROCESS (process)->tty_name = Qnil;
+ }
+ /* Restore the signal state whether vfork succeeded or not.
+ (We will signal an error, below, if it failed.) */
+#ifdef POSIX_SIGNALS
+#ifdef HAVE_VFORK
+ /* Restore the parent's signal handlers. */
+ sigaction (SIGINT, &sigint_action, 0);
+ sigaction (SIGQUIT, &sigquit_action, 0);
+#ifdef AIX
+ sigaction (SIGHUP, &sighup_action, 0);
+#endif
+#endif /* HAVE_VFORK */
+ /* Stop blocking signals in the parent. */
+ sigprocmask (SIG_SETMASK, &procmask, 0);
+#else /* !POSIX_SIGNALS */
#ifdef SIGCHLD
#ifdef BSD4_1
sigrelse (SIGCHLD);
#endif /* ordinary USG */
#endif /* not BSD4_1 */
#endif /* SIGCHLD */
+#endif /* !POSIX_SIGNALS */
+
+ /* Now generate the error if vfork failed. */
+ if (pid < 0)
+ report_file_error ("Doing vfork", Qnil);
}
#endif /* not VMS */
int retry = 0;
int count = specpdl_ptr - specpdl;
+#ifdef WINDOWSNT
+ /* Ensure socket support is loaded if available. */
+ init_winsock (TRUE);
+#endif
+
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
{
port = svc_info->s_port;
}
+ /* Slow down polling to every ten seconds.
+ Some kernels have a bug which causes retrying connect to fail
+ after a connect. Polling can interfere with gethostbyname too. */
+#ifdef POLL_FOR_INPUT
+ bind_polling_period (10);
+#endif
+
#ifndef TERM
while (1)
{
#ifdef TRY_AGAIN
h_errno = 0;
#endif
+ immediate_quit = 1;
+ QUIT;
host_info_ptr = gethostbyname (XSTRING (host)->data);
+ immediate_quit = 0;
#ifdef TRY_AGAIN
if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN))
#endif
#endif
host_info.h_addr = (char*)(&numeric_addr);
addr_list[1] = 0;
- host_info.h_length = strlen (addr_list[0]);
+ /* numeric_addr isn't null-terminated; it has fixed length. */
+ host_info.h_length = sizeof (numeric_addr);
}
bzero (&address, sizeof address);
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:
+
+ immediate_quit = 1;
+ QUIT;
+
if (connect (s, (struct sockaddr *) &address, sizeof address) == -1
&& errno != EISCONN)
{
int xerrno = errno;
+ immediate_quit = 0;
+
if (errno == EINTR)
goto loop;
if (errno == EADDRINUSE && retry < 20)
{
+ /* A delay here is needed on some FreeBSD systems,
+ and it is harmless, since this retrying takes time anyway
+ and should be infrequent. */
+ Fsleep_for (make_number (1), Qnil);
retry++;
goto loop;
}
Fcons (host, Fcons (name, Qnil)));
}
+ immediate_quit = 0;
+
#ifdef POLL_FOR_INPUT
unbind_to (count, Qnil);
#endif
#endif
#endif
- XPROCESS (proc)->childp = host;
+ XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil));
XPROCESS (proc)->command_channel_p = Qnil;
XPROCESS (proc)->buffer = buffer;
XPROCESS (proc)->sentinel = Qnil;
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, inch);
+ 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;
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;
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,
seconds and microseconds to wait; return after that much time whether\n\
or not there is input.\n\
Return non-nil iff we received any output before the timeout expired.")
- (proc, timeout, timeout_msecs)
- register Lisp_Object proc, timeout, timeout_msecs;
+ (process, timeout, timeout_msecs)
+ register Lisp_Object process, timeout, timeout_msecs;
{
int seconds;
int useconds;
{
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;
{
CHECK_NUMBER (timeout, 1);
seconds = XINT (timeout);
- if (seconds <= 0)
+ if (seconds < 0 || (seconds == 0 && useconds == 0))
seconds = -1;
}
else
{
- if (NILP (proc))
+ if (NILP (process))
seconds = -1;
else
seconds = 0;
}
- if (NILP (proc))
- XFASTINT (proc) = 0;
+ if (NILP (process))
+ XSETFASTINT (process, 0);
return
- (wait_reading_process_input (seconds, useconds, proc, 0)
+ (wait_reading_process_input (seconds, useconds, process, 0)
? Qt : Qnil);
}
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;
+/* This is here so breakpoints can be put on it. */
+static
+wait_reading_process_input_1 ()
+{
+}
+
/* Read and dispose of subprocess output while waiting for timeout to
elapse and/or keyboard input to be available.
/* 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_SET_SECS_USECS (timeout, time_limit, microsecs);
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 ();
+#ifdef hpux
+ /* AlainF 5-Jul-1996
+ HP-UX 10.10 seem to have problems with signals coming in
+ Causes "poll: interrupted system call" messages when Emacs is run
+ in an X window
+ Turn off periodic alarms (in case they are in use) */
+ stop_polling ();
+#endif
while (1)
{
+ int timeout_reduced_for_timers = 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. */
EMACS_SET_SECS_USECS (timeout, 100000, 0);
}
+ /* Normally we run timers here.
+ But not if wait_for_cell; in those cases,
+ the wait is supposed to be short,
+ and those callers cannot handle running arbitrary Lisp code here. */
+ if (! wait_for_cell)
+ {
+ EMACS_TIME timer_delay;
+ int old_timers_run;
+
+ retry:
+ old_timers_run = timers_run;
+ timer_delay = timer_check (1);
+ if (timers_run != old_timers_run && do_display)
+ {
+ redisplay_preserve_echo_area ();
+ /* We must retry, since a timer may have requeued itself
+ and that could alter the time_delay. */
+ goto retry;
+ }
+
+ if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
+ {
+ EMACS_TIME difference;
+ EMACS_SUB_TIME (difference, timer_delay, timeout);
+ if (EMACS_TIME_NEG_P (difference))
+ {
+ timeout = timer_delay;
+ timeout_reduced_for_timers = 1;
+ }
+ }
+ /* If time_limit is -1, we are not going to wait at all. */
+ else if (time_limit != -1)
+ {
+ /* This is so a breakpoint can be put here. */
+ wait_reading_process_input_1 ();
+ }
+ }
+
/* Cause C-g and alarm signals to take immediate action,
and cause input available signals to zero out timeout.
{
Atemp = input_wait_mask;
EMACS_SET_SECS_USECS (timeout, 0, 0);
- if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0)
+ if ((select (MAXDESC, &Atemp, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
+ &timeout)
+ <= 0))
{
/* It's okay for us to do this and then continue with
the loop, since timeout has already been zeroed out. */
/* 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
and indicates that a frame is trashed, the select may block
displaying a trashed screen. */
if (frame_garbaged && do_display)
- redisplay_preserve_echo_area ();
+ {
+ clear_waiting_for_input ();
+ redisplay_preserve_echo_area ();
+ if (XINT (read_kbd) < 0)
+ set_waiting_for_input (&timeout);
+ }
if (XINT (read_kbd) && detect_input_pending ())
{
FD_ZERO (&Available);
}
else
- nfds = select (MAXDESC, &Available, 0, 0, &timeout);
+ nfds = select (MAXDESC, &Available, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
+ &timeout);
xerrno = errno;
/* If we woke up due to SIGWINCH, actually change size now. */
do_pending_window_change ();
- if (time_limit && nfds == 0) /* timeout elapsed */
+ if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
+ /* We wanted the full specified time, so return now. */
break;
if (nfds < 0)
{
#endif
}
else
- error("select error: %s", strerror (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 this if wait_for_cell,
- but that caused infinite recursion in selection request events. */
- if ((XINT (read_kbd))
+ if ((XINT (read_kbd) != 0)
+ && detect_input_pending_run_timers (do_display))
+ {
+ swallow_events (do_display);
+ if (detect_input_pending_run_timers (do_display))
+ break;
+ }
+
+ /* If wait_for_cell. check for keyboard input
+ but don't run any timers.
+ ??? (It seems wrong to me to check for keyboard
+ input at all when wait_for_cell, but the code
+ has been this way since July 1994.
+ Try changing this after version 19.31.) */
+ if (wait_for_cell
&& detect_input_pending ())
{
- swallow_events ();
+ swallow_events (do_display);
if (detect_input_pending ())
break;
}
but select says there is input. */
if (XINT (read_kbd) && interrupt_input
- && (FD_ISSET (keyboard_descriptor, &Available)))
- kill (0, SIGIO);
+ && (keyboard_bit_set (&Available)))
+ kill (getpid (), SIGIO);
#endif
if (! wait_proc)
/* 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 <= max_process_desc; 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;
#ifdef EWOULDBLOCK
else if (nread == -1 && errno == EWOULDBLOCK)
;
-#else
+#endif
+ /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
+ and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
#ifdef O_NONBLOCK
else if (nread == -1 && errno == EAGAIN)
;
;
#endif /* O_NDELAY */
#endif /* O_NONBLOCK */
-#endif /* EWOULDBLOCK */
#ifdef HAVE_PTYS
/* On some OSs with ptys, when the process on one end of
a pty exits, the other end gets an error reading with
} /* 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. */
clear_input_pending ();
QUIT;
}
-
+#ifdef hpux
+ /* AlainF 5-Jul-1996
+ HP-UX 10.10 seems to have problems with signals coming in
+ Causes "poll: interrupted system call" messages when Emacs is run
+ in an X window
+ Turn periodic alarms back on */
+ start_polling();
+#endif
+
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), Qnil);
+}
+
/* 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)
- nchars = read (channel, chars, sizeof chars);
+ nchars = read (channel, chars, sizeof (chars));
else
{
chars[0] = proc_buffered_char[channel];
proc_buffered_char[channel] = -1;
- nchars = read (channel, chars + 1, sizeof chars - 1);
+ nchars = read (channel, chars + 1, sizeof (chars) - 1);
if (nchars < 0)
nchars = 1;
else
it up. */
int count = specpdl_ptr - specpdl;
Lisp_Object odeactivate;
- Lisp_Object obuffer;
+ Lisp_Object obuffer, okeymap;
+ /* No need to gcpro these, because all we do with them later
+ is test them for EQness, and none of them should be a string. */
odeactivate = Vdeactivate_mark;
- obuffer = Fcurrent_buffer ();
+ XSETBUFFER (obuffer, current_buffer);
+ okeymap = current_buffer->keymap;
specbind (Qinhibit_quit, Qt);
specbind (Qlast_nonmenu_event, Qt);
- call2 (outstream, proc, make_string (chars, nchars));
+
+ running_asynch_code = 1;
+ 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);
+ running_asynch_code = 0;
+ restore_match_data ();
/* 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 ();
+#if 0 /* Call record_asynch_buffer_change unconditionally,
+ because we might have changed minor modes or other things
+ that affect key bindings. */
+ if (! EQ (Fcurrent_buffer (), obuffer)
+ || ! EQ (current_buffer->keymap, okeymap))
+#endif
+ /* But do it only if the caller is actually going to read events.
+ Otherwise there's no need to make him wake up, and it could
+ cause trouble (for example it would make Fsit_for return). */
+ if (waiting_for_user_input_p == -1)
+ record_asynch_buffer_change ();
#ifdef VMS
start_vms_process_read (vs);
odeactivate = Vdeactivate_mark;
Fset_buffer (p->buffer);
- opoint = point;
+ opoint = PT;
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;
/* If the output marker is outside of the visible region, save
the restriction and widen. */
- if (! (BEGV <= point && point <= ZV))
+ if (! (BEGV <= PT && PT <= ZV))
Fwiden ();
/* Make sure opoint floats ahead of any new text, just as point
would. */
- if (point <= opoint)
+ if (PT <= opoint)
opoint += nchars;
/* Insert after old_begv, but before old_zv. */
- if (point < XFASTINT (old_begv))
- XFASTINT (old_begv) += nchars;
- if (point <= XFASTINT (old_zv))
- XFASTINT (old_zv) += nchars;
+ if (PT < XFASTINT (old_begv))
+ XSETFASTINT (old_begv, XFASTINT (old_begv) + nchars);
+ if (PT <= XFASTINT (old_zv))
+ 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. */
insert_before_markers (chars, nchars);
- Fset_marker (p->mark, make_number (point), p->buffer);
+ Fset_marker (p->mark, make_number (PT), p->buffer);
update_mode_lines++;
OBJECT is the Lisp object that the data comes from. */
send_process (proc, buf, len, object)
- Lisp_Object proc;
+ volatile Lisp_Object proc;
char *buf;
int len;
Lisp_Object object;
{
- /* Don't use register vars; longjmp can lose them. */
+ /* Use volatile to protect variables from being clobbered by longjmp. */
int rv;
- unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
+ volatile unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
+ struct gcpro gcpro1;
+
+ GCPRO1 (object);
#ifdef VMS
struct Lisp_Process *p = XPROCESS (proc);
else if (STRINGP (object))
offset = buf - (char *) XSTRING (object)->data;
- XFASTINT (zero) = 0;
+ XSETFASTINT (zero, 0);
wait_reading_process_input (1, 0, zero, 0);
if (BUFFERP (object))
error ("SIGPIPE raised on process %s; closed it", procname);
#endif
}
+
+ UNGCPRO;
}
DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
DEFUN ("signal-process", Fsignal_process, Ssignal_process,
2, 2, "nProcess number: \nnSignal code: ",
- "Send the process with number PID the signal with code CODE.\n\
-Both PID and CODE are integers.")
- (pid, sig)
- Lisp_Object pid, sig;
+ "Send the process with process id PID the signal with code SIGCODE.\n\
+PID must be an integer. The process need not be a child of this Emacs.\n\
+SIGCODE may be an integer, or a symbol whose name is a signal name.")
+ (pid, sigcode)
+ Lisp_Object pid, sigcode;
{
CHECK_NUMBER (pid, 0);
- CHECK_NUMBER (sig, 1);
- return make_number (kill (XINT (pid), XINT (sig)));
+
+#define handle_signal(NAME, VALUE) \
+ else if (!strcmp (name, NAME)) \
+ XSETINT (sigcode, VALUE)
+
+ if (INTEGERP (sigcode))
+ ;
+ else
+ {
+ unsigned char *name;
+
+ CHECK_SYMBOL (sigcode, 1);
+ name = XSYMBOL (sigcode)->name->data;
+
+ if (0)
+ ;
+#ifdef SIGHUP
+ handle_signal ("SIGHUP", SIGHUP);
+#endif
+#ifdef SIGINT
+ handle_signal ("SIGINT", SIGINT);
+#endif
+#ifdef SIGQUIT
+ handle_signal ("SIGQUIT", SIGQUIT);
+#endif
+#ifdef SIGILL
+ handle_signal ("SIGILL", SIGILL);
+#endif
+#ifdef SIGABRT
+ handle_signal ("SIGABRT", SIGABRT);
+#endif
+#ifdef SIGEMT
+ handle_signal ("SIGEMT", SIGEMT);
+#endif
+#ifdef SIGKILL
+ handle_signal ("SIGKILL", SIGKILL);
+#endif
+#ifdef SIGFPE
+ handle_signal ("SIGFPE", SIGFPE);
+#endif
+#ifdef SIGBUS
+ handle_signal ("SIGBUS", SIGBUS);
+#endif
+#ifdef SIGSEGV
+ handle_signal ("SIGSEGV", SIGSEGV);
+#endif
+#ifdef SIGSYS
+ handle_signal ("SIGSYS", SIGSYS);
+#endif
+#ifdef SIGPIPE
+ handle_signal ("SIGPIPE", SIGPIPE);
+#endif
+#ifdef SIGALRM
+ handle_signal ("SIGALRM", SIGALRM);
+#endif
+#ifdef SIGTERM
+ handle_signal ("SIGTERM", SIGTERM);
+#endif
+#ifdef SIGURG
+ handle_signal ("SIGURG", SIGURG);
+#endif
+#ifdef SIGSTOP
+ handle_signal ("SIGSTOP", SIGSTOP);
+#endif
+#ifdef SIGTSTP
+ handle_signal ("SIGTSTP", SIGTSTP);
+#endif
+#ifdef SIGCONT
+ handle_signal ("SIGCONT", SIGCONT);
+#endif
+#ifdef SIGCHLD
+ handle_signal ("SIGCHLD", SIGCHLD);
+#endif
+#ifdef SIGTTIN
+ handle_signal ("SIGTTIN", SIGTTIN);
+#endif
+#ifdef SIGTTOU
+ handle_signal ("SIGTTOU", SIGTTOU);
+#endif
+#ifdef SIGIO
+ handle_signal ("SIGIO", SIGIO);
+#endif
+#ifdef SIGXCPU
+ handle_signal ("SIGXCPU", SIGXCPU);
+#endif
+#ifdef SIGXFSZ
+ handle_signal ("SIGXFSZ", SIGXFSZ);
+#endif
+#ifdef SIGVTALRM
+ handle_signal ("SIGVTALRM", SIGVTALRM);
+#endif
+#ifdef SIGPROF
+ handle_signal ("SIGPROF", SIGPROF);
+#endif
+#ifdef SIGWINCH
+ handle_signal ("SIGWINCH", SIGWINCH);
+#endif
+#ifdef SIGINFO
+ handle_signal ("SIGINFO", SIGINFO);
+#endif
+#ifdef SIGUSR1
+ handle_signal ("SIGUSR1", SIGUSR1);
+#endif
+#ifdef SIGUSR2
+ handle_signal ("SIGUSR2", SIGUSR2);
+#endif
+ else
+ error ("Undefined signal name %s", name);
+ }
+
+#undef handle_signal
+
+ return make_number (kill (XINT (pid), XINT (sigcode)));
}
DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
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, Qnil); /* ^z */
#else
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))
/* USG systems forget handlers when they are used;
must reestablish each time */
-#ifdef USG
+#if defined (USG) && !defined (POSIX_SIGNALS)
signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
#endif
#ifdef BSD4_1
/* Find the process that signaled us, and record its status. */
p = 0;
- for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
+ for (tail = Vprocess_alist; CONSP (tail); tail = XCONS (tail)->cdr)
{
proc = XCONS (XCONS (tail)->car)->cdr;
p = XPROCESS (proc);
/* Look for an asynchronous process whose pid hasn't been filled
in yet. */
if (p == 0)
- for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
+ for (tail = Vprocess_alist; CONSP (tail); tail = XCONS (tail)->cdr)
{
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;
+ XSETINT (p->raw_status_low, u.i & 0xffff);
+ XSETINT (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 (code < NSIG)
{
#ifndef VMS
- signame = sys_siglist[code];
+ /* Suppress warning if the table has const char *. */
+ signame = (char *) sys_siglist[code];
#else
signame = sys_errlist[code];
#endif
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))
-#ifdef USG
+#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG)) || defined (WINDOWSNT)
+#if defined (USG) && ! defined (POSIX_SIGNALS)
signal (signo, sigchld_handler);
#endif
errno = old_errno;
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), Qnil);
+}
+
static void
exec_sentinel (proc, reason)
Lisp_Object proc, reason;
{
- Lisp_Object sentinel, obuffer, odeactivate;
+ Lisp_Object sentinel, obuffer, odeactivate, okeymap;
register struct Lisp_Process *p = XPROCESS (proc);
int count = specpdl_ptr - specpdl;
+ /* No need to gcpro these, because all we do with them later
+ is test them for EQness, and none of them should be a string. */
odeactivate = Vdeactivate_mark;
- obuffer = Fcurrent_buffer ();
+ XSETBUFFER (obuffer, current_buffer);
+ okeymap = current_buffer->keymap;
+
sentinel = p->sentinel;
if (NILP (sentinel))
return;
/* Inhibit quit so that random quits don't screw up a running filter. */
specbind (Qinhibit_quit, Qt);
specbind (Qlast_nonmenu_event, Qt);
- call2 (sentinel, proc, reason);
+
+ running_asynch_code = 1;
+ 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);
+ running_asynch_code = 0;
+ restore_match_data ();
Vdeactivate_mark = odeactivate;
- if (! EQ (Fcurrent_buffer (), obuffer))
- record_asynch_buffer_change ();
+#if 0
+ if (! EQ (Fcurrent_buffer (), obuffer)
+ || ! EQ (current_buffer->keymap, okeymap))
+#endif
+ /* But do it only if the caller is actually going to read events.
+ Otherwise there's no need to make him wake up, and it could
+ cause trouble (for example it would make Fsit_for return). */
+ if (waiting_for_user_input_p == -1)
+ record_asynch_buffer_change ();
- if (waiting_for_user_input_p)
- prepare_menu_bars ();
unbind_to (count, Qnil);
}
reference. */
GCPRO2 (tail, msg);
+ /* Set this now, so that if new processes are created by sentinels
+ that we run, we get called again to handle their status changes. */
+ update_tick = process_tick;
+
for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
{
Lisp_Object symbol;
/* 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)
if (NILP (XBUFFER (buffer)->name))
continue;
Fset_buffer (buffer);
- opoint = point;
+ opoint = PT;
/* Insert new output into buffer
at the current end-of-output marker,
thus preserving logical ordering of input and output. */
SET_PT (marker_position (p->mark));
else
SET_PT (ZV);
- if (point <= opoint)
+ if (PT <= opoint)
opoint += XSTRING (msg)->size + XSTRING (p->name)->size + 10;
tem = current_buffer->read_only;
insert_string (" ");
Finsert (1, &msg);
current_buffer->read_only = tem;
- Fset_marker (p->mark, make_number (point), p->buffer);
+ Fset_marker (p->mark, make_number (PT), p->buffer);
SET_PT (opoint);
set_buffer_internal (old);
update_mode_lines++; /* in case buffers use %s in mode-line-format */
redisplay_preserve_echo_area ();
- update_tick = process_tick;
-
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
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 (&Sset_process_window_size);
defsubr (&Sprocess_kill_without_query);
+ defsubr (&Sprocess_contact);
defsubr (&Slist_processes);
defsubr (&Sprocess_list);
defsubr (&Sstart_process);
#include "lisp.h"
#include "systime.h"
#include "termopts.h"
+#include "sysselect.h"
extern int frame_garbaged;
+extern EMACS_TIME timer_check ();
+extern int timers_run;
/* As described above, except assuming that there are no subprocesses:
1 to return when input is available, or
-1 means caller will actually read the input, so don't throw to
the quit handler.
+ a cons cell, meaning wait until its car is non-nil
+ (and gobble terminal input into the buffer if any arrives), or
We know that read_kbd will never be a Lisp_Process, since
`subprocesses' isn't defined.
Lisp_Object read_kbd;
int do_display;
{
- EMACS_TIME end_time, timeout, *timeout_p;
- int waitchannels;
+ EMACS_TIME end_time, timeout;
+ SELECT_TYPE waitchannels;
+ int xerrno;
+ Lisp_Object *wait_for_cell = 0;
+
+ /* If waiting for non-nil in a cell, record where. */
+ if (CONSP (read_kbd))
+ {
+ wait_for_cell = &XCONS (read_kbd)->car;
+ XSETFASTINT (read_kbd, 0);
+ }
/* What does time_limit really mean? */
if (time_limit || microsecs)
{
- /* It's not infinite. */
- timeout_p = &timeout;
-
if (time_limit == -1)
/* In fact, it's zero. */
EMACS_SET_SECS_USECS (timeout, 0, 0);
}
else
/* It's infinite. */
- timeout_p = 0;
-
- /* This must come before stop_polling. */
- prepare_menu_bars ();
+ EMACS_SET_SECS_USECS (timeout, 100000, 0);
/* Turn off periodic alarms (in case they are in use)
because the select emulator uses alarms. */
for (;;)
{
int nfds;
-
- waitchannels = XINT (read_kbd) ? 1 : 0;
+ int timeout_reduced_for_timers = 0;
/* If calling from keyboard input, do not quit
since we want to return C-g as an input character.
if (XINT (read_kbd) >= 0)
QUIT;
- if (timeout_p)
+ /* Exit now if the cell we're waiting for became non-nil. */
+ if (wait_for_cell && ! NILP (*wait_for_cell))
+ break;
+
+ /* Compute time from now till when time limit is up */
+ /* Exit if already run out */
+ if (time_limit > 0 || microsecs)
{
- EMACS_GET_TIME (*timeout_p);
- EMACS_SUB_TIME (*timeout_p, end_time, *timeout_p);
- if (EMACS_TIME_NEG_P (*timeout_p))
+ EMACS_GET_TIME (timeout);
+ EMACS_SUB_TIME (timeout, end_time, timeout);
+ if (EMACS_TIME_NEG_P (timeout))
break;
}
+ /* If our caller will not immediately handle keyboard events,
+ run timer events directly.
+ (Callers that will immediately read keyboard events
+ call timer_delay on their own.) */
+ if (! wait_for_cell)
+ {
+ EMACS_TIME timer_delay;
+ int old_timers_run;
+
+ retry:
+ old_timers_run = timers_run;
+ timer_delay = timer_check (1);
+ if (timers_run != old_timers_run && do_display)
+ {
+ redisplay_preserve_echo_area ();
+ /* We must retry, since a timer may have requeued itself
+ and that could alter the time delay. */
+ goto retry;
+ }
+
+ if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
+ {
+ EMACS_TIME difference;
+ EMACS_SUB_TIME (difference, timer_delay, timeout);
+ if (EMACS_TIME_NEG_P (difference))
+ {
+ timeout = timer_delay;
+ timeout_reduced_for_timers = 1;
+ }
+ }
+ }
+
/* Cause C-g and alarm signals to take immediate action,
and cause input available signals to zero out timeout. */
if (XINT (read_kbd) < 0)
set_waiting_for_input (&timeout);
+ /* Wait till there is something to do. */
+
+ if (! XINT (read_kbd) && wait_for_cell == 0)
+ FD_ZERO (&waitchannels);
+ else
+ FD_SET (0, &waitchannels);
+
/* If a frame has been newly mapped and needs updating,
reprocess its display stuff. */
if (frame_garbaged && do_display)
- redisplay_preserve_echo_area ();
+ {
+ clear_waiting_for_input ();
+ redisplay_preserve_echo_area ();
+ if (XINT (read_kbd) < 0)
+ set_waiting_for_input (&timeout);
+ }
if (XINT (read_kbd) && detect_input_pending ())
- nfds = 0;
+ {
+ nfds = 0;
+ FD_ZERO (&waitchannels);
+ }
else
- nfds = select (1, &waitchannels, 0, 0, timeout_p);
+ nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
+ &timeout);
+
+ xerrno = errno;
/* Make C-g and alarm signals set flags again */
clear_waiting_for_input ();
/* If we woke up due to SIGWINCH, actually change size now. */
do_pending_window_change ();
+ if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
+ /* We waited the full specified time, so return now. */
+ break;
+
if (nfds == -1)
{
/* If the system call was interrupted, then go around the
loop again. */
- if (errno == EINTR)
- waitchannels = 0;
+ if (xerrno == EINTR)
+ FD_ZERO (&waitchannels);
+ else
+ error ("select error: %s", strerror (xerrno));
}
#ifdef sun
else if (nfds > 0 && (waitchannels & 1) && interrupt_input)
#endif
#ifdef SIGIO
if (XINT (read_kbd) && interrupt_input && (waitchannels & 1))
- kill (0, SIGIO);
+ kill (getpid (), SIGIO);
#endif
- /* If we have timed out (nfds == 0) or found some input (nfds > 0),
- we should exit. */
- if (nfds >= 0)
+ /* Check for keyboard input */
+
+ if ((XINT (read_kbd) != 0)
+ && detect_input_pending_run_timers (do_display))
+ {
+ swallow_events (do_display);
+ if (detect_input_pending_run_timers (do_display))
+ break;
+ }
+
+ /* If wait_for_cell. check for keyboard input
+ but don't run any timers.
+ ??? (It seems wrong to me to check for keyboard
+ input at all when wait_for_cell, but the code
+ has been this way since July 1994.
+ Try changing this after version 19.31.) */
+ if (wait_for_cell
+ && detect_input_pending ())
+ {
+ swallow_events (do_display);
+ if (detect_input_pending ())
+ break;
+ }
+
+ /* Exit now if the cell we're waiting for became non-nil. */
+ if (wait_for_cell && ! NILP (*wait_for_cell))
break;
}