/* 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 <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. */
#define NUMERIC_ADDR_ERROR (numeric_addr == -1)
#endif
-#if defined(BSD) || defined(STRIDE)
+#if defined(BSD_SYSTEM) || defined(STRIDE)
#include <sys/ioctl.h>
#if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
#include <fcntl.h>
#endif /* HAVE_PTYS and no O_NDELAY */
-#endif /* BSD or STRIDE */
+#endif /* BSD_SYSTEM || STRIDE */
#ifdef BROKEN_O_NONBLOCK
#undef O_NONBLOCK
/* 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) (GC_STRINGP (XPROCESS (p)->childp))
+#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
#else
#define NETCONN_P(p) 0
#endif /* HAVE_SOCKETS */
#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
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;
-/* 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'. */
\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 ()
{
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 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);
- FD_CLR (XINT (XPROCESS (proc)->infd), &non_keyboard_wait_mask);
+ FD_CLR (XINT (XPROCESS (process)->infd), &input_wait_mask);
+ FD_CLR (XINT (XPROCESS (process)->infd), &non_keyboard_wait_mask);
}
- else if (EQ (XPROCESS (proc)->filter, Qt))
+ else if (EQ (XPROCESS (process)->filter, Qt))
{
- FD_SET (XINT (XPROCESS (proc)->infd), &input_wait_mask);
- FD_SET (XINT (XPROCESS (proc)->infd), &non_keyboard_wait_mask);
+ FD_SET (XINT (XPROCESS (process)->infd), &input_wait_mask);
+ FD_SET (XINT (XPROCESS (process)->infd), &non_keyboard_wait_mask);
}
- XPROCESS (proc)->filter = filter;
+ 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,
tem = Fcar (Fcdr (p->status));
if (XFASTINT (tem))
{
- sprintf (tembuf, " %d", XFASTINT (tem));
+ sprintf (tembuf, " %d", (int) XFASTINT (tem));
write_string (tembuf, -1);
}
}
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
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++)
{
}
/* 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
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;
}
#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
/* 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);
#else /* not BSD4_1 */
-#if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
+#if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
sigsetmask (sigmask (SIGCHLD));
#else /* ordinary USG */
#if 0
#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);
/* 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
+#ifdef HAVE_SETPGID
setpgid (0, 0);
#else
setpgrp (0, 0);
}
#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);
#else /* not BSD4_1 */
-#if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
+#if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
sigsetmask (SIGEMPTYMASK);
#else /* ordinary USG */
#if 0
#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);
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);
}
-
- XSETFASTINT (XPROCESS (process)->pid, pid);
+ else
+ {
+ /* vfork succeeded. */
+ XSETFASTINT (XPROCESS (process)->pid, pid);
#ifdef WINDOWSNT
- register_child (pid, inchannel);
+ 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);
- 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);
#else /* not BSD4_1 */
-#if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
+#if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
sigsetmask (SIGEMPTYMASK);
#else /* ordinary USG */
#if 0
#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);
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;
- XSETINT (XPROCESS (proc)->infd, s);
+ XSETINT (XPROCESS (proc)->infd, inch);
XSETINT (XPROCESS (proc)->outfd, outch);
XPROCESS (proc)->status = Qrun;
FD_SET (inch, &input_wait_mask);
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, 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))
- XSETFASTINT (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);
}
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.
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. */
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 && keyboard_bit_set (&Available)
/* 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) || wait_for_cell)
+ 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;
}
if (XINT (read_kbd) && interrupt_input
&& (keyboard_bit_set (&Available)))
- kill (0, SIGIO);
+ kill (getpid (), SIGIO);
#endif
if (! wait_proc)
#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
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
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
+ nchars = read (channel, chars, sizeof (chars));
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
+ nchars = read (channel, chars + 1, sizeof (chars) - 1);
if (nchars < 0)
nchars = 1;
else
int count = specpdl_ptr - specpdl;
Lisp_Object odeactivate;
Lisp_Object obuffer, okeymap;
+ int outer_running_asynch_code = running_asynch_code;
/* 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. */
specbind (Qinhibit_quit, Qt);
specbind (Qlast_nonmenu_event, Qt);
+ /* In case we get recursively called,
+ and we already saved the match data nonrecursively,
+ save the same match data in safely recursive fashion. */
+ if (outer_running_asynch_code)
+ {
+ Lisp_Object tem;
+ /* Don't clobber the CURRENT match data, either! */
+ tem = Fmatch_data ();
+ restore_match_data ();
+ record_unwind_protect (Fstore_match_data, Fmatch_data ());
+ Fstore_match_data (tem);
+ }
+
+ /* For speed, if a search happens within this code,
+ save the match data in a special nonrecursive fashion. */
running_asynch_code = 1;
+
+ /* Read and dispose of the process output. */
internal_condition_case_1 (read_process_output_call,
Fcons (outstream,
Fcons (proc,
Qnil))),
!NILP (Vdebug_on_error) ? Qnil : Qerror,
read_process_output_error_handler);
- running_asynch_code = 0;
+
+ /* If we saved the match data nonrecursively, restore it now. */
restore_match_data ();
+ running_asynch_code = outer_running_asynch_code;
/* Handling the process output should not deactivate the mark. */
Vdeactivate_mark = odeactivate;
+#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))
- record_asynch_buffer_change ();
-
- if (waiting_for_user_input_p)
- prepare_menu_bars ();
+#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;
XSETFASTINT (old_begv, BEGV);
XSETFASTINT (old_zv, ZV);
/* 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))
+ if (PT < XFASTINT (old_begv))
XSETFASTINT (old_begv, XFASTINT (old_begv) + nchars);
- if (point <= XFASTINT (old_zv))
+ 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);
error ("SIGPIPE raised on process %s; closed it", procname);
#endif
}
+
+ UNGCPRO;
}
DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
handle_signal ("SIGUSR2", SIGUSR2);
#endif
else
- error ("Undefined signal name %s", XSTRING (sigcode)->data);
+ 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,
/* 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);
XSETINT (p->tick, ++process_tick);
u.wt = w;
- XSETFASTINT (p->raw_status_low, u.i & 0xffff);
- XSETFASTINT (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))
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)) || defined (WINDOWSNT)
-#ifdef USG
+#if defined (USG) && ! defined (POSIX_SIGNALS)
signal (signo, sigchld_handler);
#endif
errno = old_errno;
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
Lisp_Object sentinel, obuffer, odeactivate, okeymap;
register struct Lisp_Process *p = XPROCESS (proc);
int count = specpdl_ptr - specpdl;
+ int outer_running_asynch_code = running_asynch_code;
/* 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. */
specbind (Qinhibit_quit, Qt);
specbind (Qlast_nonmenu_event, Qt);
+ /* In case we get recursively called,
+ and we already saved the match data nonrecursively,
+ save the same match data in safely recursive fashion. */
+ if (outer_running_asynch_code)
+ {
+ Lisp_Object tem;
+ tem = Fmatch_data ();
+ restore_match_data ();
+ record_unwind_protect (Fstore_match_data, Fmatch_data ());
+ Fstore_match_data (tem);
+ }
+
+ /* For speed, if a search happens within this code,
+ save the match data in a special nonrecursive fashion. */
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;
+
+ /* If we saved the match data nonrecursively, restore it now. */
restore_match_data ();
+ running_asynch_code = outer_running_asynch_code;
Vdeactivate_mark = odeactivate;
+#if 0
if (! EQ (Fcurrent_buffer (), obuffer)
|| ! EQ (current_buffer->keymap, okeymap))
- record_asynch_buffer_change ();
+#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;
XSETINT (p->update_tick, XINT (p->tick));
/* If process is still active, read any output that remains. */
- if (XINT (p->infd) >= 0)
- while (! EQ (p->filter, Qt)
- && read_process_output (proc, XINT (p->infd)) > 0);
+ while (! EQ (p->filter, Qt)
+ && XINT (p->infd) >= 0
+ && read_process_output (proc, XINT (p->infd)) > 0);
buffer = p->buffer;
deactivate_process (proc);
}
+ /* The actions above may have further incremented p->tick.
+ So set p->update_tick again
+ so that an error in the sentinel will not cause
+ this code to be run again. */
+ XSETINT (p->update_tick, XINT (p->tick));
/* Now output the message suitably. */
if (!NILP (p->sentinel))
exec_sentinel (proc, msg);
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
{
int fd;
- for (fd = 0; fd < max_keyboard_desc; 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;
syms_of_process ()
{
-#ifdef HAVE_SOCKETS
- stream_process = intern ("stream");
-#endif
Qprocessp = intern ("processp");
staticpro (&Qprocessp);
Qrun = intern ("run");
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;
}
HCoop / bpt / emacs.git / blobdiff