/* 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. */
#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 */
#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 ();
+
/* 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. */
+#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'. */
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
\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. */
+
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;
}
\f
DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
"Return t if OBJECT is a process.")
- (obj)
- Lisp_Object obj;
+ (object)
+ Lisp_Object object;
{
- return PROCESSP (obj) ? Qt : Qnil;
+ return PROCESSP (object) ? Qt : Qnil;
}
DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
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))
"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 (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 (CONSP (XPROCESS (proc)->status))
- 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 (proc, 0);
- return XPROCESS (proc)->command;
+ 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.")
- (proc)
- register Lisp_Object proc;
+ (process)
+ register Lisp_Object process;
{
- CHECK_PROCESS (proc, 0);
- return XPROCESS (proc)->tty_name;
+ 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);
}
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))
{
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",
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
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;
}
#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 */
#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 OSF1
+ setpgid (0, 0);
+#else
setpgrp (0, 0);
+#endif
#endif
}
#endif /* TIOCNOTTY */
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 */
#ifdef SETUP_SLAVE_PTY
#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 */
-
- signal (SIGINT, SIG_DFL);
- signal (SIGQUIT, SIG_DFL);
+#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;
-
- /* 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);
+ 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);
- XPROCESS (process)->tty_name = build_string (pty_name);
+#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 */
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)
{
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
&& errno != EISCONN)
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;
}
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;
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 (!INTEGERP (timeout))
- XSET (timeout, Lisp_Int, 0);
+ XSETINT (timeout, 0);
{
int carry = useconds / 1000000;
}
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);
}
{
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 (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)
{
+ 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);
}
+ /* 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 (read_kbd >= 0)
+ {
+ EMACS_TIME timer_delay;
+ timer_delay = timer_check (1);
+ 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.
{
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;
if (! XINT (read_kbd) && wait_for_cell == 0)
- FD_CLR (keyboard_descriptor, &Available);
+ 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)
{
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.
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 <= 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;
cmd_error_internal (error, "error in process filter: ");
Vinhibit_quit = Qt;
update_echo_area ();
- Fsleep_for (make_number (2));
+ Fsleep_for (make_number (2), Qnil);
}
/* Read pending output from the process channel,
#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;
+ 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);
+ running_asynch_code = 1;
internal_condition_case_1 (read_process_output_call,
Fcons (outstream,
Fcons (proc,
- Fcons (make_string (chars, nchars),
+ 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);
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;
/* 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. */
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;
#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))
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
+
+#ifdef WINDOWSNT
+ /* Only works for kill-type signals */
+ return make_number (win32_kill_process (XINT (pid), XINT (sigcode)));
+#else
+ return make_number (kill (XINT (pid), XINT (sigcode)));
+#endif
}
DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
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 */
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))
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))
+#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG)) || defined (WINDOWSNT)
#ifdef USG
signal (signo, sigchld_handler);
#endif
cmd_error_internal (error, "error in process sentinel: ");
Vinhibit_quit = Qt;
update_echo_area ();
- Fsleep_for (make_number (2));
+ 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;
specbind (Qinhibit_quit, Qt);
specbind (Qlast_nonmenu_event, Qt);
+ 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;
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
#include "lisp.h"
#include "systime.h"
#include "termopts.h"
+#include "sysselect.h"
extern int frame_garbaged;
int do_display;
{
EMACS_TIME end_time, timeout, *timeout_p;
- int waitchannels;
+ SELECT_TYPE waitchannels;
/* What does time_limit really mean? */
if (time_limit || microsecs)
/* 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 ();
{
int nfds;
- waitchannels = XINT (read_kbd) ? 1 : 0;
+ if (XINT (read_kbd))
+ FD_SET (0, &waitchannels);
+ else
+ FD_ZERO (&waitchannels);
/* If calling from keyboard input, do not quit
since we want to return C-g as an input character.
if (XINT (read_kbd) && detect_input_pending ())
nfds = 0;
else
- nfds = select (1, &waitchannels, 0, 0, timeout_p);
+ nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
+ timeout_p);
/* Make C-g and alarm signals set flags again */
clear_waiting_for_input ();
/* If the system call was interrupted, then go around the
loop again. */
if (errno == EINTR)
- waitchannels = 0;
+ FD_ZERO (&waitchannels);
}
#ifdef sun
else if (nfds > 0 && (waitchannels & 1) && interrupt_input)
HCoop / bpt / emacs.git / blobdiff