X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/5f0929a7f9380db5d2416035fd02083ed1185779..193e4518576af3d5d88fe43b3e686112a349a054:/src/process.c diff --git a/src/process.c b/src/process.c index 43d569b201..b94b1d3096 100644 --- a/src/process.c +++ b/src/process.c @@ -1,5 +1,6 @@ /* 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. @@ -15,7 +16,8 @@ GNU General Public License for more details. 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 @@ -42,11 +44,19 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include #endif +#ifdef WINDOWSNT +#include +#include +#endif /* not WINDOWSNT */ + #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */ #include #include #include #include +#ifdef NEED_NET_ERRNO_H +#include +#endif /* NEED_NET_ERRNO_H */ #endif /* HAVE_SOCKETS */ /* TERM is a poor-man's SLIP, used on Linux. */ @@ -100,13 +110,10 @@ Lisp_Object Qlast_nonmenu_event; /* Qexit is declared and initialized in eval.c. */ /* a process object is a network connection when its childp field is neither - Qt nor Qnil but is instead a string (name of foreign host we - are connected to + name of port we are connected to) */ + Qt nor Qnil but is instead a cons cell (HOSTNAME PORTNUM). */ #ifdef HAVE_SOCKETS -static Lisp_Object stream_process; - -#define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String) +#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp)) #else #define NETCONN_P(p) 0 #endif /* HAVE_SOCKETS */ @@ -142,6 +149,7 @@ extern int h_errno; #ifndef SYS_SIGLIST_DECLARED #ifndef VMS #ifndef BSD4_1 +#ifndef WINDOWSNT #ifndef LINUX extern char *sys_siglist[]; #endif /* not LINUX */ @@ -175,6 +183,7 @@ char *sys_siglist[] = "exceeded CPU time limit", "exceeded file size limit" }; +#endif /* not WINDOWSNT */ #endif #endif /* VMS */ #endif /* ! SYS_SIGLIST_DECLARED */ @@ -189,48 +198,34 @@ static Lisp_Object Vprocess_connection_type; #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; @@ -247,12 +242,22 @@ Lisp_Object Vprocess_alist; output from the process is to read at least one char. Always -1 on systems that support FIONREAD. */ -static int proc_buffered_char[MAXDESC]; +/* Don't make static; need to access externally. */ +int proc_buffered_char[MAXDESC]; static Lisp_Object get_process (); +extern EMACS_TIME timer_check (); +extern int timers_run; + /* Maximum number of bytes to send to a pty without an eof. */ static int pty_max_bytes; + +#ifdef HAVE_PTYS +/* The file name of the pty opened by allocate_pty. */ + +static char pty_name[24]; +#endif /* Compute the Lisp form of the process status, p->status, from the numeric status that was returned by `wait'. */ @@ -300,7 +305,7 @@ decode_status (l, symbol, code, coredump) { Lisp_Object tem; - if (XTYPE (l) == Lisp_Symbol) + if (SYMBOLP (l)) { *symbol = l; *code = 0; @@ -334,7 +339,8 @@ status_message (status) 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 @@ -366,8 +372,6 @@ status_message (status) The file name of the terminal corresponding to the pty is left in the variable pty_name. */ -char pty_name[24]; - int allocate_pty () { @@ -454,27 +458,23 @@ Lisp_Object 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; @@ -492,6 +492,7 @@ make_process (name) } name = name1; p->name = name; + XSETPROCESS (val, p); Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist); return val; } @@ -503,17 +504,16 @@ remove_process (proc) pair = Frassq (proc, Vprocess_alist); Vprocess_alist = Fdelq (pair, Vprocess_alist); - Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil); deactivate_process (proc); } DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0, "Return t if OBJECT is a process.") - (obj) - Lisp_Object obj; + (object) + Lisp_Object object; { - return XTYPE (obj) == Lisp_Process ? Qt : Qnil; + return PROCESSP (object) ? Qt : Qnil; } DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0, @@ -521,7 +521,7 @@ DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0, (name) register Lisp_Object name; { - if (XTYPE (name) == Lisp_Process) + if (PROCESSP (name)) return name; CHECK_STRING (name, 0); return Fcdr (Fassoc (name, Vprocess_alist)); @@ -530,19 +530,19 @@ 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)) { proc = Fcdr (Fcar (tail)); - if (XTYPE (proc) == Lisp_Process && EQ (XPROCESS (proc)->buffer, buf)) + if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf)) return proc; } return Qnil; @@ -591,27 +591,27 @@ DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0, "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; } @@ -626,27 +626,27 @@ closed -- for a network stream connection that is closed.\n\ nil -- if arg is a process name and no such process exists.\n\ PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ nil, indicating the current buffer's process.") - (proc) - register Lisp_Object proc; + (process) + register Lisp_Object process; { register struct Lisp_Process *p; register Lisp_Object status; - if (STRINGP (proc)) - proc = Fget_process (proc); + if (STRINGP (process)) + process = Fget_process (process); else - proc = get_process (proc); + process = get_process (process); - if (NILP (proc)) - return proc; + if (NILP (process)) + return process; - p = XPROCESS (proc); + p = XPROCESS (process); if (!NILP (p->raw_status_low)) update_status (p); status = p->status; - if (XTYPE (status) == Lisp_Cons) + if (CONSP (status)) status = XCONS (status)->car; - if (NETCONN_P (proc)) + if (NETCONN_P (process)) { if (EQ (status, Qrun)) status = Qopen; @@ -660,14 +660,14 @@ DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status, 1, 1, 0, "Return the exit status of PROCESS or the signal number that killed it.\n\ If PROCESS has not yet exited or died, return 0.") - (proc) - register Lisp_Object proc; + (process) + register Lisp_Object process; { - CHECK_PROCESS (proc, 0); - if (!NILP (XPROCESS (proc)->raw_status_low)) - update_status (XPROCESS (proc)); - if (XTYPE (XPROCESS (proc)->status) == Lisp_Cons) - return XCONS (XCONS (XPROCESS (proc)->status)->cdr)->car; + CHECK_PROCESS (process, 0); + if (!NILP (XPROCESS (process)->raw_status_low)) + update_status (XPROCESS (process)); + if (CONSP (XPROCESS (process)->status)) + return XCONS (XCONS (XPROCESS (process)->status)->cdr)->car; return make_number (0); } @@ -675,22 +675,22 @@ DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 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, @@ -698,23 +698,34 @@ DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0, This is a list of strings, the first string being the program executed\n\ and the rest of the strings being the arguments given to it.\n\ For a non-child channel, this is nil.") - (proc) - register Lisp_Object proc; + (process) + register Lisp_Object process; +{ + CHECK_PROCESS (process, 0); + return XPROCESS (process)->command; +} + +DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0, + "Return the name of the terminal PROCESS uses, or nil if none.\n\ +This is the terminal that the process itself reads and writes on,\n\ +not the name of the pty that Emacs uses to talk with that terminal.") + (process) + register Lisp_Object process; { - CHECK_PROCESS (proc, 0); - return XPROCESS (proc)->command; + CHECK_PROCESS (process, 0); + return XPROCESS (process)->tty_name; } DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer, 2, 2, 0, "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).") - (proc, buffer) - register Lisp_Object proc, buffer; + (process, buffer) + register Lisp_Object process, buffer; { - CHECK_PROCESS (proc, 0); + CHECK_PROCESS (process, 0); if (!NILP (buffer)) CHECK_BUFFER (buffer, 1); - XPROCESS (proc)->buffer = buffer; + XPROCESS (process)->buffer = buffer; return buffer; } @@ -723,21 +734,21 @@ DEFUN ("process-buffer", Fprocess_buffer, Sprocess_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, @@ -748,15 +759,21 @@ When a process has a filter, each time it does output\n\ 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; } @@ -764,11 +781,11 @@ DEFUN ("process-filter", Fprocess_filter, Sprocess_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, @@ -776,11 +793,11 @@ 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; } @@ -788,23 +805,23 @@ DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_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 @@ -816,18 +833,29 @@ DEFUN ("process-kill-without-query", Fprocess_kill_without_query, "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, @@ -851,7 +879,7 @@ list_processes_1 () register int state; char tembuf[80]; - XFASTINT (minspace) = 1; + XSETFASTINT (minspace, 1); set_buffer_internal (XBUFFER (Vstandard_output)); Fbuffer_disable_undo (Vstandard_output); @@ -859,8 +887,8 @@ list_processes_1 () 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)) { @@ -877,7 +905,7 @@ Proc Status Buffer Command\n\ if (!NILP (p->raw_status_low)) update_status (p); symbol = p->status; - if (XTYPE (p->status) == Lisp_Cons) + if (CONSP (p->status)) symbol = XCONS (p->status)->car; @@ -910,7 +938,7 @@ Proc Status Buffer Command\n\ tem = Fcar (Fcdr (p->status)); if (XFASTINT (tem)) { - sprintf (tembuf, " %d", XFASTINT (tem)); + sprintf (tembuf, " %d", (int) XFASTINT (tem)); write_string (tembuf, -1); } } @@ -928,10 +956,17 @@ Proc Status Buffer Command\n\ Findent_to (make_number (37), minspace); + if (STRINGP (p->tty_name)) + Finsert (1, &p->tty_name); + else + insert_string ("(none)"); + + Findent_to (make_number (49), minspace); + if (NETCONN_P (proc)) { sprintf (tembuf, "(network stream connection to %s)\n", - XSTRING (p->childp)->data); + XSTRING (XCONS (p->childp)->car)->data); insert_string (tembuf); } else @@ -1019,9 +1054,9 @@ Remaining arguments are strings to give program as arguments.") 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)); @@ -1061,7 +1096,9 @@ Remaining arguments are strings to give program as arguments.") 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; @@ -1071,10 +1108,16 @@ Remaining arguments are strings to give program as arguments.") 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++) { @@ -1099,20 +1142,25 @@ Remaining arguments are strings to give program as arguments.") XPROCESS (proc)->filter = Qnil; XPROCESS (proc)->command = Flist (nargs - 2, args + 2); + /* Make the process marker point into the process buffer (if any). */ + if (!NILP (buffer)) + Fset_marker (XPROCESS (proc)->mark, + make_number (BUF_ZV (XBUFFER (buffer))), buffer); + create_process (proc, new_argv, current_dir); return unbind_to (count, proc); } /* This function is the unwind_protect form for Fstart_process. If - PROC doesn't have its pid set, then we know someone has signalled + PROC doesn't have its pid set, then we know someone has signaled an error and the process wasn't started successfully, so we should remove it from the process list. */ static Lisp_Object start_process_unwind (proc) Lisp_Object proc; { - if (XTYPE (proc) != Lisp_Process) + if (!PROCESSP (proc)) abort (); /* Was PROC started successfully? */ @@ -1127,7 +1175,7 @@ SIGTYPE 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); @@ -1159,12 +1207,24 @@ create_process (process, new_argv, current_dir) 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; @@ -1229,27 +1289,47 @@ create_process (process, new_argv, current_dir) #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); @@ -1264,8 +1344,10 @@ create_process (process, new_argv, current_dir) #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; @@ -1282,8 +1364,10 @@ create_process (process, new_argv, current_dir) 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; @@ -1351,14 +1435,22 @@ create_process (process, new_argv, current_dir) /* In order to get a controlling terminal on some versions of BSD, it is necessary to put the process in pgrp 0 before it opens the terminal. */ +#ifdef HAVE_SETPGID + setpgid (0, 0); +#else setpgrp (0, 0); +#endif #endif } #endif /* TIOCNOTTY */ -#if !defined (RTU) && !defined (UNIPLUS) +#if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY) /*** There is a suggestion that this ought to be a - conditional on TIOCSPGRP. */ + conditional on TIOCSPGRP, + or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)). + Trying the latter gave the wrong results on Debian GNU/Linux 1.1; + that system does seem to need this code, even though + both HAVE_SETSID and TIOCSCTTY are defined. */ /* Now close the pty (if we had it open) and reopen it. This makes the pty the controlling terminal of the subprocess. */ if (pty_flag) @@ -1372,15 +1464,21 @@ create_process (process, new_argv, current_dir) 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) { @@ -1395,6 +1493,13 @@ create_process (process, new_argv, current_dir) #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); @@ -1408,40 +1513,74 @@ create_process (process, new_argv, current_dir) #endif /* ordinary USG */ #endif /* not BSD4_1 */ #endif /* SIGCHLD */ +#endif /* !POSIX_SIGNALS */ if (pty_flag) child_setup_tty (xforkout); +#ifdef WINDOWSNT + pid = child_setup (xforkin, xforkout, xforkout, + new_argv, 1, current_dir); +#else /* not WINDOWSNT */ child_setup (xforkin, xforkout, xforkout, new_argv, 1, current_dir); +#endif /* not WINDOWSNT */ } environ = save_environ; } + /* This runs in the Emacs process. */ if (pid < 0) { if (forkin >= 0) close (forkin); if (forkin != forkout && forkout >= 0) close (forkout); - report_file_error ("Doing vfork", Qnil); } - - XFASTINT (XPROCESS (process)->pid) = pid; + else + { + /* vfork succeeded. */ + XSETFASTINT (XPROCESS (process)->pid, pid); + +#ifdef WINDOWSNT + register_child (pid, inchannel); +#endif /* WINDOWSNT */ + + /* If the subfork execv fails, and it exits, + this close hangs. I don't know why. + So have an interrupt jar it loose. */ + stop_polling (); + signal (SIGALRM, create_process_1); + alarm (1); + XPROCESS (process)->subtty = Qnil; + if (forkin >= 0) + close (forkin); + alarm (0); + start_polling (); + if (forkin != forkout && forkout >= 0) + close (forkout); - /* If the subfork execv fails, and it exits, - this close hangs. I don't know why. - So have an interrupt jar it loose. */ - stop_polling (); - signal (SIGALRM, create_process_1); - alarm (1); - XPROCESS (process)->subtty = Qnil; - if (forkin >= 0) - close (forkin); - alarm (0); - start_polling (); - if (forkin != forkout && forkout >= 0) - close (forkout); +#ifdef HAVE_PTYS + if (pty_flag) + XPROCESS (process)->tty_name = build_string (pty_name); + else +#endif + XPROCESS (process)->tty_name = Qnil; + } + /* Restore the signal state whether vfork succeeded or not. + (We will signal an error, below, if it failed.) */ +#ifdef POSIX_SIGNALS +#ifdef HAVE_VFORK + /* Restore the parent's signal handlers. */ + sigaction (SIGINT, &sigint_action, 0); + sigaction (SIGQUIT, &sigquit_action, 0); +#ifdef AIX + sigaction (SIGHUP, &sighup_action, 0); +#endif +#endif /* HAVE_VFORK */ + /* Stop blocking signals in the parent. */ + sigprocmask (SIG_SETMASK, &procmask, 0); +#else /* !POSIX_SIGNALS */ #ifdef SIGCHLD #ifdef BSD4_1 sigrelse (SIGCHLD); @@ -1459,6 +1598,11 @@ create_process (process, new_argv, current_dir) #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 */ @@ -1503,10 +1647,15 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ int retry = 0; int count = specpdl_ptr - specpdl; +#ifdef WINDOWSNT + /* Ensure socket support is loaded if available. */ + init_winsock (TRUE); +#endif + GCPRO4 (name, buffer, host, service); CHECK_STRING (name, 0); CHECK_STRING (host, 0); - if (XTYPE (service) == Lisp_Int) + if (INTEGERP (service)) port = htons ((unsigned short) XINT (service)); else { @@ -1517,13 +1666,23 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ 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 @@ -1549,7 +1708,8 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ #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); @@ -1571,23 +1731,26 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ 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; } @@ -1602,6 +1765,8 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ Fcons (host, Fcons (name, Qnil))); } + immediate_quit = 0; + #ifdef POLL_FOR_INPUT unbind_to (count, Qnil); #endif @@ -1636,17 +1801,18 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ #endif #endif - XPROCESS (proc)->childp = host; + XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil)); XPROCESS (proc)->command_channel_p = Qnil; XPROCESS (proc)->buffer = buffer; XPROCESS (proc)->sentinel = Qnil; XPROCESS (proc)->filter = Qnil; XPROCESS (proc)->command = Qnil; XPROCESS (proc)->pid = Qnil; - XSET (XPROCESS (proc)->infd, Lisp_Int, s); - XSET (XPROCESS (proc)->outfd, Lisp_Int, outch); + XSETINT (XPROCESS (proc)->infd, inch); + XSETINT (XPROCESS (proc)->outfd, outch); XPROCESS (proc)->status = Qrun; FD_SET (inch, &input_wait_mask); + FD_SET (inch, &non_keyboard_wait_mask); if (inch > max_process_desc) max_process_desc = inch; @@ -1682,10 +1848,11 @@ deactivate_process (proc) close (outchannel); #endif - XSET (p->infd, Lisp_Int, -1); - XSET (p->outfd, Lisp_Int, -1); + XSETINT (p->infd, -1); + XSETINT (p->outfd, -1); chan_process[inchannel] = Qnil; FD_CLR (inchannel, &input_wait_mask); + FD_CLR (inchannel, &non_keyboard_wait_mask); if (inchannel == max_process_desc) { int i; @@ -1705,6 +1872,7 @@ deactivate_process (proc) close_process_descs () { +#ifndef WINDOWSNT int i; for (i = 0; i < MAXDESC; i++) { @@ -1720,6 +1888,7 @@ close_process_descs () close (out); } } +#endif } DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output, @@ -1732,8 +1901,8 @@ Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\ 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; @@ -1742,8 +1911,8 @@ Return non-nil iff we received any output before the timeout expired.") { CHECK_NUMBER (timeout_msecs, 2); useconds = XINT (timeout_msecs); - if (XTYPE (timeout) != Lisp_Int) - XSET (timeout, Lisp_Int, 0); + if (!INTEGERP (timeout)) + XSETINT (timeout, 0); { int carry = useconds / 1000000; @@ -1768,22 +1937,22 @@ Return non-nil iff we received any output before the timeout expired.") { CHECK_NUMBER (timeout, 1); seconds = XINT (timeout); - if (seconds <= 0) + if (seconds < 0 || (seconds == 0 && useconds == 0)) seconds = -1; } else { - if (NILP (proc)) + if (NILP (process)) seconds = -1; else seconds = 0; } - if (NILP (proc)) - XFASTINT (proc) = 0; + if (NILP (process)) + XSETFASTINT (process, 0); return - (wait_reading_process_input (seconds, useconds, proc, 0) + (wait_reading_process_input (seconds, useconds, process, 0) ? Qt : Qnil); } @@ -1792,9 +1961,18 @@ Return non-nil iff we received any output before the timeout expired.") function Fwaiting_for_user_input_p below) whether emacs was waiting for user-input when that process-filter was called. waiting_for_input cannot be used as that is by definition 0 when - lisp code is being evalled */ + lisp code is being evalled. + This is also used in record_asynch_buffer_change. + For that purpose, this must be 0 + when not inside wait_reading_process_input. */ static int waiting_for_user_input_p; +/* This is here so breakpoints can be put on it. */ +static +wait_reading_process_input_1 () +{ +} + /* Read and dispose of subprocess output while waiting for timeout to elapse and/or keyboard input to be available. @@ -1847,18 +2025,18 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* If read_kbd is a process to watch, set wait_proc and wait_channel accordingly. */ - if (XTYPE (read_kbd) == Lisp_Process) + if (PROCESSP (read_kbd)) { wait_proc = XPROCESS (read_kbd); wait_channel = XINT (wait_proc->infd); - XFASTINT (read_kbd) = 0; + XSETFASTINT (read_kbd, 0); } /* If waiting for non-nil in a cell, record where. */ - if (XTYPE (read_kbd) == Lisp_Cons) + if (CONSP (read_kbd)) { wait_for_cell = &XCONS (read_kbd)->car; - XFASTINT (read_kbd) = 0; + XSETFASTINT (read_kbd, 0); } waiting_for_user_input_p = XINT (read_kbd); @@ -1871,14 +2049,19 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) 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. */ @@ -1911,6 +2094,44 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) 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. @@ -1928,7 +2149,9 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) { 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. */ @@ -1949,12 +2172,10 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* Wait till there is something to do */ - Available = input_wait_mask; - /* We used to have && wait_for_cell == 0 - but that led to lossage handling selection_request events: - within one, we would start to handle another. */ - if (! XINT (read_kbd)) - FD_CLR (keyboard_descriptor, &Available); + if (! XINT (read_kbd) && wait_for_cell == 0) + Available = non_keyboard_wait_mask; + else + Available = input_wait_mask; /* If frame size has changed or the window is newly mapped, redisplay now, before we start to wait. There is a race @@ -1962,7 +2183,12 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) 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 ()) { @@ -1970,7 +2196,8 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) FD_ZERO (&Available); } else - nfds = select (MAXDESC, &Available, 0, 0, &timeout); + nfds = select (MAXDESC, &Available, (SELECT_TYPE *)0, (SELECT_TYPE *)0, + &timeout); xerrno = errno; @@ -1980,7 +2207,8 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* 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) { @@ -2017,10 +2245,10 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) #endif } else - error("select error: %s", strerror (xerrno)); + error ("select error: %s", strerror (xerrno)); } #if defined(sun) && !defined(USG5_4) - else if (nfds > 0 && FD_ISSET (keyboard_descriptor, &Available) + else if (nfds > 0 && keyboard_bit_set (&Available) && interrupt_input) /* System sometimes fails to deliver SIGIO. @@ -2036,12 +2264,24 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* If there is any, return immediately to give it higher priority than subprocesses */ - /* We used to do this if wait_for_cell, - but that caused infinite recursion in selection request events. */ - if ((XINT (read_kbd)) + if ((XINT (read_kbd) != 0) + && detect_input_pending_run_timers (do_display)) + { + swallow_events (do_display); + if (detect_input_pending_run_timers (do_display)) + break; + } + + /* If wait_for_cell. check for keyboard input + but don't run any timers. + ??? (It seems wrong to me to check for keyboard + input at all when wait_for_cell, but the code + has been this way since July 1994. + Try changing this after version 19.31.) */ + if (wait_for_cell && detect_input_pending ()) { - swallow_events (); + swallow_events (do_display); if (detect_input_pending ()) break; } @@ -2057,8 +2297,8 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) but select says there is input. */ if (XINT (read_kbd) && interrupt_input - && (FD_ISSET (keyboard_descriptor, &Available))) - kill (0, SIGIO); + && (keyboard_bit_set (&Available))) + kill (getpid (), SIGIO); #endif if (! wait_proc) @@ -2072,10 +2312,10 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* 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; @@ -2110,7 +2350,9 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) #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) ; @@ -2126,7 +2368,6 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) ; #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 @@ -2159,6 +2400,8 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) } /* end for each file descriptor */ } /* end while exit conditions not met */ + waiting_for_user_input_p = 0; + /* If calling from keyboard input, do not quit since we want to return C-g as an input character. Otherwise, do pending quit if requested. */ @@ -2168,10 +2411,37 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) 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; } +/* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */ + +static Lisp_Object +read_process_output_call (fun_and_args) + Lisp_Object fun_and_args; +{ + return apply1 (XCONS (fun_and_args)->car, XCONS (fun_and_args)->cdr); +} + +static Lisp_Object +read_process_output_error_handler (error) + Lisp_Object error; +{ + cmd_error_internal (error, "error in process filter: "); + Vinhibit_quit = Qt; + update_echo_area (); + Fsleep_for (make_number (2), Qnil); +} + /* Read pending output from the process channel, starting with our buffered-ahead character if we have one. Yield number of characters read. @@ -2218,12 +2488,12 @@ read_process_output (proc, channel) #else /* not VMS */ if (proc_buffered_char[channel] < 0) - nchars = read (channel, chars, sizeof chars); + nchars = read (channel, chars, sizeof (chars)); else { chars[0] = proc_buffered_char[channel]; proc_buffered_char[channel] = -1; - nchars = read (channel, chars + 1, sizeof chars - 1); + nchars = read (channel, chars + 1, sizeof (chars) - 1); if (nchars < 0) nchars = 1; else @@ -2241,23 +2511,43 @@ read_process_output (proc, channel) it up. */ int count = specpdl_ptr - specpdl; Lisp_Object odeactivate; - Lisp_Object obuffer; + Lisp_Object obuffer, okeymap; + /* No need to gcpro these, because all we do with them later + is test them for EQness, and none of them should be a string. */ odeactivate = Vdeactivate_mark; - obuffer = Fcurrent_buffer (); + XSETBUFFER (obuffer, current_buffer); + okeymap = current_buffer->keymap; specbind (Qinhibit_quit, Qt); specbind (Qlast_nonmenu_event, Qt); - call2 (outstream, proc, make_string (chars, nchars)); + + running_asynch_code = 1; + internal_condition_case_1 (read_process_output_call, + Fcons (outstream, + Fcons (proc, + Fcons (make_string (chars, + nchars), + Qnil))), + !NILP (Vdebug_on_error) ? Qnil : Qerror, + read_process_output_error_handler); + running_asynch_code = 0; + restore_match_data (); /* Handling the process output should not deactivate the mark. */ Vdeactivate_mark = odeactivate; - if (! EQ (Fcurrent_buffer (), obuffer)) - record_asynch_buffer_change (); - - if (waiting_for_user_input_p) - prepare_menu_bars (); +#if 0 /* Call record_asynch_buffer_change unconditionally, + because we might have changed minor modes or other things + that affect key bindings. */ + if (! EQ (Fcurrent_buffer (), obuffer) + || ! EQ (current_buffer->keymap, okeymap)) +#endif + /* But do it only if the caller is actually going to read events. + Otherwise there's no need to make him wake up, and it could + cause trouble (for example it would make Fsit_for return). */ + if (waiting_for_user_input_p == -1) + record_asynch_buffer_change (); #ifdef VMS start_vms_process_read (vs); @@ -2276,10 +2566,10 @@ read_process_output (proc, channel) odeactivate = Vdeactivate_mark; Fset_buffer (p->buffer); - opoint = point; + opoint = PT; old_read_only = current_buffer->read_only; - XFASTINT (old_begv) = BEGV; - XFASTINT (old_zv) = ZV; + XSETFASTINT (old_begv, BEGV); + XSETFASTINT (old_zv, ZV); current_buffer->read_only = Qnil; @@ -2293,24 +2583,24 @@ read_process_output (proc, channel) /* If the output marker is outside of the visible region, save the restriction and widen. */ - if (! (BEGV <= point && point <= ZV)) + if (! (BEGV <= PT && PT <= ZV)) Fwiden (); /* Make sure opoint floats ahead of any new text, just as point would. */ - if (point <= opoint) + if (PT <= opoint) opoint += nchars; /* Insert after old_begv, but before old_zv. */ - if (point < XFASTINT (old_begv)) - XFASTINT (old_begv) += nchars; - if (point <= XFASTINT (old_zv)) - XFASTINT (old_zv) += nchars; + if (PT < XFASTINT (old_begv)) + XSETFASTINT (old_begv, XFASTINT (old_begv) + nchars); + if (PT <= XFASTINT (old_zv)) + XSETFASTINT (old_zv, XFASTINT (old_zv) + nchars); /* Insert before markers in case we are inserting where the buffer's mark is, and the user's next command is Meta-y. */ insert_before_markers (chars, nchars); - Fset_marker (p->mark, make_number (point), p->buffer); + Fset_marker (p->mark, make_number (PT), p->buffer); update_mode_lines++; @@ -2359,14 +2649,17 @@ send_process_trap () 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); @@ -2467,7 +2760,7 @@ send_process (proc, buf, len, object) 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)) @@ -2505,6 +2798,8 @@ send_process (proc, buf, len, object) error ("SIGPIPE raised on process %s; closed it", procname); #endif } + + UNGCPRO; } DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region, @@ -2836,14 +3131,126 @@ See function `interrupt-process' for more details on usage.") DEFUN ("signal-process", Fsignal_process, Ssignal_process, 2, 2, "nProcess number: \nnSignal code: ", - "Send the process with number PID the signal with code CODE.\n\ -Both PID and CODE are integers.") - (pid, sig) - Lisp_Object pid, sig; + "Send the process with process id PID the signal with code SIGCODE.\n\ +PID must be an integer. The process need not be a child of this Emacs.\n\ +SIGCODE may be an integer, or a symbol whose name is a signal name.") + (pid, sigcode) + Lisp_Object pid, sigcode; { CHECK_NUMBER (pid, 0); - CHECK_NUMBER (sig, 1); - return make_number (kill (XINT (pid), XINT (sig))); + +#define handle_signal(NAME, VALUE) \ + else if (!strcmp (name, NAME)) \ + XSETINT (sigcode, VALUE) + + if (INTEGERP (sigcode)) + ; + else + { + unsigned char *name; + + CHECK_SYMBOL (sigcode, 1); + name = XSYMBOL (sigcode)->name->data; + + if (0) + ; +#ifdef SIGHUP + handle_signal ("SIGHUP", SIGHUP); +#endif +#ifdef SIGINT + handle_signal ("SIGINT", SIGINT); +#endif +#ifdef SIGQUIT + handle_signal ("SIGQUIT", SIGQUIT); +#endif +#ifdef SIGILL + handle_signal ("SIGILL", SIGILL); +#endif +#ifdef SIGABRT + handle_signal ("SIGABRT", SIGABRT); +#endif +#ifdef SIGEMT + handle_signal ("SIGEMT", SIGEMT); +#endif +#ifdef SIGKILL + handle_signal ("SIGKILL", SIGKILL); +#endif +#ifdef SIGFPE + handle_signal ("SIGFPE", SIGFPE); +#endif +#ifdef SIGBUS + handle_signal ("SIGBUS", SIGBUS); +#endif +#ifdef SIGSEGV + handle_signal ("SIGSEGV", SIGSEGV); +#endif +#ifdef SIGSYS + handle_signal ("SIGSYS", SIGSYS); +#endif +#ifdef SIGPIPE + handle_signal ("SIGPIPE", SIGPIPE); +#endif +#ifdef SIGALRM + handle_signal ("SIGALRM", SIGALRM); +#endif +#ifdef SIGTERM + handle_signal ("SIGTERM", SIGTERM); +#endif +#ifdef SIGURG + handle_signal ("SIGURG", SIGURG); +#endif +#ifdef SIGSTOP + handle_signal ("SIGSTOP", SIGSTOP); +#endif +#ifdef SIGTSTP + handle_signal ("SIGTSTP", SIGTSTP); +#endif +#ifdef SIGCONT + handle_signal ("SIGCONT", SIGCONT); +#endif +#ifdef SIGCHLD + handle_signal ("SIGCHLD", SIGCHLD); +#endif +#ifdef SIGTTIN + handle_signal ("SIGTTIN", SIGTTIN); +#endif +#ifdef SIGTTOU + handle_signal ("SIGTTOU", SIGTTOU); +#endif +#ifdef SIGIO + handle_signal ("SIGIO", SIGIO); +#endif +#ifdef SIGXCPU + handle_signal ("SIGXCPU", SIGXCPU); +#endif +#ifdef SIGXFSZ + handle_signal ("SIGXFSZ", SIGXFSZ); +#endif +#ifdef SIGVTALRM + handle_signal ("SIGVTALRM", SIGVTALRM); +#endif +#ifdef SIGPROF + handle_signal ("SIGPROF", SIGPROF); +#endif +#ifdef SIGWINCH + handle_signal ("SIGWINCH", SIGWINCH); +#endif +#ifdef SIGINFO + handle_signal ("SIGINFO", SIGINFO); +#endif +#ifdef SIGUSR1 + handle_signal ("SIGUSR1", SIGUSR1); +#endif +#ifdef SIGUSR2 + handle_signal ("SIGUSR2", SIGUSR2); +#endif + else + error ("Undefined signal name %s", name); + } + +#undef handle_signal + + return make_number (kill (XINT (pid), XINT (sigcode))); } DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0, @@ -2867,14 +3274,6 @@ text to PROCESS after you call this function.") if (! EQ (XPROCESS (proc)->status, Qrun)) error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data); - /* Sending a zero-length record is supposed to mean eof - when TIOCREMOTE is turned on. */ -#ifdef DID_REMOTE - { - char buf[1]; - write (XINT (XPROCESS (proc)->outfd), buf, 0); - } -#else /* did not do TOICREMOTE */ #ifdef VMS send_process (proc, "\032", 1, Qnil); /* ^z */ #else @@ -2883,10 +3282,9 @@ text to PROCESS after you call this function.") else { close (XINT (XPROCESS (proc)->outfd)); - XSET (XPROCESS (proc)->outfd, Lisp_Int, open (NULL_DEVICE, O_WRONLY)); + XSETINT (XPROCESS (proc)->outfd, open (NULL_DEVICE, O_WRONLY)); } #endif /* VMS */ -#endif /* did not do TOICREMOTE */ return process; } @@ -2898,11 +3296,10 @@ kill_buffer_processes (buffer) { 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)) @@ -2972,7 +3369,7 @@ sigchld_handler (signo) /* 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 @@ -2989,7 +3386,7 @@ sigchld_handler (signo) /* 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); @@ -3001,11 +3398,11 @@ sigchld_handler (signo) /* Look for an asynchronous process whose pid hasn't been filled in yet. */ if (p == 0) - for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr) + for (tail = Vprocess_alist; CONSP (tail); tail = XCONS (tail)->cdr) { proc = XCONS (XCONS (tail)->car)->cdr; p = XPROCESS (proc); - if (XTYPE (p->pid) == Lisp_Int && XINT (p->pid) == -1) + if (INTEGERP (p->pid) && XINT (p->pid) == -1) break; p = 0; } @@ -3014,16 +3411,24 @@ sigchld_handler (signo) 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. */ @@ -3048,7 +3453,8 @@ sigchld_handler (signo) 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 @@ -3070,8 +3476,8 @@ sigchld_handler (signo) get another signal. Otherwise (on systems that have WNOHANG), loop around to use up all the processes that have something to tell us. */ -#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG)) -#ifdef USG +#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG)) || defined (WINDOWSNT) +#if defined (USG) && ! defined (POSIX_SIGNALS) signal (signo, sigchld_handler); #endif errno = old_errno; @@ -3089,16 +3495,30 @@ exec_sentinel_unwind (data) return Qnil; } +static Lisp_Object +exec_sentinel_error_handler (error) + Lisp_Object error; +{ + cmd_error_internal (error, "error in process sentinel: "); + Vinhibit_quit = Qt; + update_echo_area (); + Fsleep_for (make_number (2), Qnil); +} + static void exec_sentinel (proc, reason) Lisp_Object proc, reason; { - Lisp_Object sentinel, obuffer, odeactivate; + Lisp_Object sentinel, obuffer, odeactivate, okeymap; register struct Lisp_Process *p = XPROCESS (proc); int count = specpdl_ptr - specpdl; + /* No need to gcpro these, because all we do with them later + is test them for EQness, and none of them should be a string. */ odeactivate = Vdeactivate_mark; - obuffer = Fcurrent_buffer (); + XSETBUFFER (obuffer, current_buffer); + okeymap = current_buffer->keymap; + sentinel = p->sentinel; if (NILP (sentinel)) return; @@ -3110,14 +3530,27 @@ exec_sentinel (proc, reason) /* Inhibit quit so that random quits don't screw up a running filter. */ specbind (Qinhibit_quit, Qt); specbind (Qlast_nonmenu_event, Qt); - call2 (sentinel, proc, reason); + + running_asynch_code = 1; + internal_condition_case_1 (read_process_output_call, + Fcons (sentinel, + Fcons (proc, Fcons (reason, Qnil))), + !NILP (Vdebug_on_error) ? Qnil : Qerror, + exec_sentinel_error_handler); + running_asynch_code = 0; + restore_match_data (); Vdeactivate_mark = odeactivate; - if (! EQ (Fcurrent_buffer (), obuffer)) - record_asynch_buffer_change (); +#if 0 + if (! EQ (Fcurrent_buffer (), obuffer) + || ! EQ (current_buffer->keymap, okeymap)) +#endif + /* But do it only if the caller is actually going to read events. + Otherwise there's no need to make him wake up, and it could + cause trouble (for example it would make Fsit_for return). */ + if (waiting_for_user_input_p == -1) + record_asynch_buffer_change (); - if (waiting_for_user_input_p) - prepare_menu_bars (); unbind_to (count, Qnil); } @@ -3139,6 +3572,10 @@ status_notify () 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; @@ -3165,7 +3602,7 @@ status_notify () /* If process is terminated, deactivate it or delete it. */ symbol = p->status; - if (XTYPE (p->status) == Lisp_Cons) + if (CONSP (p->status)) symbol = XCONS (p->status)->car; if (EQ (symbol, Qsignal) || EQ (symbol, Qexit) @@ -3195,7 +3632,7 @@ status_notify () 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. */ @@ -3203,7 +3640,7 @@ status_notify () 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; @@ -3213,7 +3650,7 @@ status_notify () 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); @@ -3224,11 +3661,63 @@ status_notify () update_mode_lines++; /* in case buffers use %s in mode-line-format */ redisplay_preserve_echo_area (); - update_tick = process_tick; - UNGCPRO; } +/* 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; +} + init_process () { register int i; @@ -3241,10 +3730,10 @@ init_process () #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++) @@ -3254,22 +3743,8 @@ init_process () } } -/* 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 - stream_process = intern ("stream"); -#endif Qprocessp = intern ("processp"); staticpro (&Qprocessp); Qrun = intern ("run"); @@ -3317,6 +3792,7 @@ The value takes effect when `start-process' is called."); defsubr (&Sprocess_exit_status); defsubr (&Sprocess_id); defsubr (&Sprocess_name); + defsubr (&Sprocess_tty_name); defsubr (&Sprocess_command); defsubr (&Sset_process_buffer); defsubr (&Sprocess_buffer); @@ -3324,9 +3800,10 @@ The value takes effect when `start-process' is called."); 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); @@ -3356,9 +3833,12 @@ The value takes effect when `start-process' is called."); #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: @@ -3374,6 +3854,8 @@ extern int frame_garbaged; 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. @@ -3388,15 +3870,21 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) 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); @@ -3409,10 +3897,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) } 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. */ @@ -3421,8 +3906,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) 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. @@ -3430,28 +3914,84 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) 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 (); @@ -3459,12 +3999,18 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* 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) @@ -3473,12 +4019,35 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) #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; }