X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2ea6d561514f14c7c4d3479c9cf2b2d793c34ff1..a03f91ada2cec963ec3e73e81dbc8fbd4e8e0cc9:/src/process.c diff --git a/src/process.c b/src/process.c index c2785e75fc..1afb701dd2 100644 --- a/src/process.c +++ b/src/process.c @@ -1,5 +1,5 @@ /* 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 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -38,12 +38,23 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include /* some typedefs are used in sys/file.h */ #include #include +#ifdef HAVE_UNISTD_H +#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. */ @@ -51,8 +62,8 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include #endif -/* DGUX inet_addr returns a 'struct in_addr'. */ -#ifdef DGUX +/* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */ +#ifdef HAVE_BROKEN_INET_ADDR #define IN_ADDR struct in_addr #define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1) #else @@ -93,6 +104,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ Lisp_Object Qprocessp; Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed; +Lisp_Object Qlast_nonmenu_event; /* Qexit is declared and initialized in eval.c. */ /* a process object is a network connection when its childp field is neither @@ -102,7 +114,7 @@ Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed; #ifdef HAVE_SOCKETS static Lisp_Object stream_process; -#define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String) +#define NETCONN_P(p) (GC_STRINGP (XPROCESS (p)->childp)) #else #define NETCONN_P(p) 0 #endif /* HAVE_SOCKETS */ @@ -131,8 +143,14 @@ extern char *strerror (); extern char *sys_errlist[]; #endif +#ifndef HAVE_H_ERRNO +extern int h_errno; +#endif + +#ifndef SYS_SIGLIST_DECLARED #ifndef VMS #ifndef BSD4_1 +#ifndef WINDOWSNT #ifndef LINUX extern char *sys_siglist[]; #endif /* not LINUX */ @@ -166,8 +184,10 @@ char *sys_siglist[] = "exceeded CPU time limit", "exceeded file size limit" }; +#endif /* not WINDOWSNT */ #endif #endif /* VMS */ +#endif /* ! SYS_SIGLIST_DECLARED */ /* t means use pty, nil means use a pipe, maybe other values to come. */ @@ -179,48 +199,43 @@ 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 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_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; -/* Descriptor to use for keyboard input. */ -static int keyboard_descriptor; +/* Mask that excludes keyboard input descriptor (s). */ + +static SELECT_TYPE non_keyboard_wait_mask; + +/* The largest descriptor currently in use for a process object. */ +static int max_process_desc; + +/* The largest descriptor currently in use for keyboard input. */ +static int max_keyboard_desc; /* Nonzero means delete a process right away if it exits. */ static int delete_exited_processes; /* Indexed by descriptor, gives the process (if any) for that descriptor */ -static Lisp_Object chan_process[MAXDESC]; +Lisp_Object chan_process[MAXDESC]; /* Alist of elements (NAME . PROCESS) */ -static Lisp_Object Vprocess_alist; +Lisp_Object Vprocess_alist; /* Buffered-ahead input char from process, indexed by channel. -1 means empty (no char is buffered). @@ -228,9 +243,19 @@ static 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 (); + +/* 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'. */ @@ -278,7 +303,7 @@ decode_status (l, symbol, code, coredump) { Lisp_Object tem; - if (XTYPE (l) == Lisp_Symbol) + if (SYMBOLP (l)) { *symbol = l; *code = 0; @@ -308,11 +333,19 @@ status_message (status) if (EQ (symbol, Qsignal) || EQ (symbol, Qstop)) { + char *signame = 0; + if (code < NSIG) + { #ifndef VMS - string = build_string (code < NSIG ? sys_siglist[code] : "unknown"); + /* Cast to suppress warning if the table has const char *. */ + signame = (char *) sys_siglist[code]; #else - string = build_string (code < NSIG ? sys_errlist[code] : "unknown"); + signame = sys_errlist[code]; #endif + } + if (signame == 0) + signame = "unknown"; + string = build_string (signame); string2 = build_string (coredump ? " (core dumped)\n" : "\n"); XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]); return concat2 (string, string2); @@ -337,8 +370,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 () { @@ -425,27 +456,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; @@ -463,6 +490,7 @@ make_process (name) } name = name1; p->name = name; + XSETPROCESS (val, p); Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist); return val; } @@ -484,7 +512,7 @@ DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0, (obj) Lisp_Object obj; { - return XTYPE (obj) == Lisp_Process ? Qt : Qnil; + return PROCESSP (obj) ? Qt : Qnil; } DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0, @@ -492,7 +520,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)); @@ -513,7 +541,7 @@ BUFFER may be a buffer or the name of one.") 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; @@ -528,24 +556,34 @@ static Lisp_Object get_process (name) register Lisp_Object name; { - register Lisp_Object proc; - if (NILP (name)) - proc = Fget_buffer_process (Fcurrent_buffer ()); + register Lisp_Object proc, obj; + if (STRINGP (name)) + { + obj = Fget_process (name); + if (NILP (obj)) + obj = Fget_buffer (name); + if (NILP (obj)) + error ("Process %s does not exist", XSTRING (name)->data); + } + else if (NILP (name)) + obj = Fcurrent_buffer (); else + obj = name; + + /* Now obj should be either a buffer object or a process object. + */ + if (BUFFERP (obj)) { - proc = Fget_process (name); + proc = Fget_buffer_process (obj); if (NILP (proc)) - proc = Fget_buffer_process (Fget_buffer (name)); + error ("Buffer %s has no process", XSTRING (XBUFFER (obj)->name)->data); } - - if (!NILP (proc)) - return proc; - - if (NILP (name)) - error ("Current buffer has no process"); else - error ("Process %s does not exist", XSTRING (name)->data); - /* NOTREACHED */ + { + CHECK_PROCESS (obj, 0); + proc = obj; + } + return proc; } DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0, @@ -592,14 +630,20 @@ nil, indicating the current buffer's process.") { register struct Lisp_Process *p; register Lisp_Object status; - proc = get_process (proc); + + if (STRINGP (proc)) + proc = Fget_process (proc); + else + proc = get_process (proc); + if (NILP (proc)) return proc; + p = XPROCESS (proc); if (!NILP (p->raw_status_low)) update_status (p); status = p->status; - if (XTYPE (status) == Lisp_Cons) + if (CONSP (status)) status = XCONS (status)->car; if (NETCONN_P (proc)) { @@ -621,7 +665,7 @@ If PROCESS has not yet exited or died, return 0.") CHECK_PROCESS (proc, 0); if (!NILP (XPROCESS (proc)->raw_status_low)) update_status (XPROCESS (proc)); - if (XTYPE (XPROCESS (proc)->status) == Lisp_Cons) + if (CONSP (XPROCESS (proc)->status)) return XCONS (XCONS (XPROCESS (proc)->status)->cdr)->car; return make_number (0); } @@ -660,6 +704,17 @@ For a non-child channel, this is nil.") return XPROCESS (proc)->command; } +DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0, + "Return the name of the terminal PROCESS uses, or nil if none.\n\ +This is the terminal that the process itself reads and writes on,\n\ +not the name of the pty that Emacs uses to talk with that terminal.") + (proc) + register Lisp_Object proc; +{ + CHECK_PROCESS (proc, 0); + return XPROCESS (proc)->tty_name; +} + DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer, 2, 2, 0, "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).") @@ -708,9 +763,15 @@ If the process has a filter, its buffer is not used for output.") { CHECK_PROCESS (proc, 0); if (EQ (filter, Qt)) - FD_CLR (XINT (XPROCESS (proc)->infd), &input_wait_mask); + { + FD_CLR (XINT (XPROCESS (proc)->infd), &input_wait_mask); + FD_CLR (XINT (XPROCESS (proc)->infd), &non_keyboard_wait_mask); + } else if (EQ (XPROCESS (proc)->filter, Qt)) - FD_SET (XINT (XPROCESS (proc)->infd), &input_wait_mask); + { + FD_SET (XINT (XPROCESS (proc)->infd), &input_wait_mask); + FD_SET (XINT (XPROCESS (proc)->infd), &non_keyboard_wait_mask); + } XPROCESS (proc)->filter = filter; return filter; } @@ -750,10 +811,26 @@ See `set-process-sentinel' for more info on sentinels.") return XPROCESS (proc)->sentinel; } +DEFUN ("set-process-window-size", Fset_process_window_size, + Sset_process_window_size, 3, 3, 0, + "Tell PROCESS that it has logical window size HEIGHT and WIDTH.") + (proc, height, width) + register Lisp_Object proc, height, width; +{ + CHECK_PROCESS (proc, 0); + CHECK_NATNUM (height, 0); + CHECK_NATNUM (width, 0); + if (set_window_size (XINT (XPROCESS (proc)->infd), + XINT (height), XINT(width)) <= 0) + return Qnil; + else + return Qt; +} + DEFUN ("process-kill-without-query", Fprocess_kill_without_query, Sprocess_kill_without_query, 1, 2, 0, "Say no query needed if PROCESS is running when Emacs is exited.\n\ -Optional second argument if non-nill says to require a query.\n\ +Optional second argument if non-nil says to require a query.\n\ Value is t if a query was formerly required.") (proc, value) register Lisp_Object proc, value; @@ -790,7 +867,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); @@ -798,8 +875,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)) { @@ -816,7 +893,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; @@ -849,7 +926,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); } } @@ -867,6 +944,13 @@ 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", @@ -958,9 +1042,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)); @@ -999,24 +1083,37 @@ Remaining arguments are strings to give program as arguments.") #else /* not VMS */ new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *)); - for (i = 3; i < nargs; i++) - { - tem = args[i]; - CHECK_STRING (tem, i); - new_argv[i - 2] = XSTRING (tem)->data; - } - new_argv[i - 2] = 0; - new_argv[0] = XSTRING (program)->data; - /* If program file name is not absolute, search our path for it */ - if (new_argv[0][0] != '/') + if (!IS_DIRECTORY_SEP (XSTRING (program)->data[0]) + && !(XSTRING (program)->size > 1 + && IS_DEVICE_SEP (XSTRING (program)->data[1]))) { + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + tem = Qnil; + GCPRO4 (name, program, buffer, current_dir); openp (Vexec_path, program, EXEC_SUFFIXES, &tem, 1); + UNGCPRO; if (NILP (tem)) report_file_error ("Searching for program", Fcons (program, Qnil)); + tem = Fexpand_file_name (tem, Qnil); new_argv[0] = XSTRING (tem)->data; } + else + { + 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++) + { + tem = args[i]; + CHECK_STRING (tem, i); + new_argv[i - 2] = XSTRING (tem)->data; + } + new_argv[i - 2] = 0; #endif /* not VMS */ proc = make_process (name); @@ -1033,6 +1130,11 @@ 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); @@ -1046,7 +1148,7 @@ static Lisp_Object start_process_unwind (proc) Lisp_Object proc; { - if (XTYPE (proc) != Lisp_Process) + if (!PROCESSP (proc)) abort (); /* Was PROC started successfully? */ @@ -1093,18 +1195,30 @@ 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; #ifdef HAVE_PTYS - if (EQ (Vprocess_connection_type, Qt)) + if (!NILP (Vprocess_connection_type)) outchannel = inchannel = allocate_pty (); if (inchannel >= 0) @@ -1137,12 +1251,22 @@ create_process (process, new_argv, current_dir) } #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 */ @@ -1172,18 +1296,36 @@ create_process (process, new_argv, current_dir) /* 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); @@ -1198,6 +1340,12 @@ 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; /* Until we store the proper pid, enable sigchld_handler to recognize an unknown pid as standing for this process. @@ -1212,8 +1360,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; @@ -1228,14 +1378,18 @@ create_process (process, new_argv, current_dir) #ifdef HAVE_PTYS /* First, disconnect its current controlling terminal. */ #ifdef HAVE_SETSID + /* We tried doing setsid only if pty_flag, but it caused + process_set_signal to fail on SGI when using a pipe. */ setsid (); -#ifdef TIOCSCTTY /* Make the pty's terminal the controlling terminal. */ if (pty_flag) - /* We ignore the return value - because faith@cs.unc.edu says that is necessary on Linux. */ - ioctl (xforkin, TIOCSCTTY, 0); + { +#ifdef TIOCSCTTY + /* We ignore the return value + because faith@cs.unc.edu says that is necessary on Linux. */ + ioctl (xforkin, TIOCSCTTY, 0); #endif + } #else /* not HAVE_SETSID */ #ifdef USG /* It's very important to call setpgrp here and no time @@ -1244,15 +1398,25 @@ create_process (process, new_argv, current_dir) setpgrp (); #endif /* USG */ #endif /* not HAVE_SETSID */ -#ifdef NTTYDISC - if (pty_flag) +#if defined (HAVE_TERMIOS) && defined (LDISC1) + if (pty_flag && xforkin >= 0) + { + struct termios t; + tcgetattr (xforkin, &t); + t.c_lflag = LDISC1; + if (tcsetattr (xforkin, TCSANOW, &t) < 0) + write (1, "create_process/tcsetattr LDISC1 failed\n", 39); + } +#else +#if defined (NTTYDISC) && defined (TIOCSETD) + if (pty_flag && xforkin >= 0) { /* Use new line discipline. */ int ldisc = NTTYDISC; - if (ioctl (xforkin, TIOCSETD, &ldisc) < 0) - write (1, "create_process/TIOCSETD failed\n", 31); + ioctl (xforkin, TIOCSETD, &ldisc); } #endif +#endif #ifdef TIOCNOTTY /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you can do TIOCSPGRP only to the process's controlling tty. */ @@ -1267,7 +1431,11 @@ 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 OSF1 + setpgid (0, 0); +#else setpgrp (0, 0); +#endif #endif } #endif /* TIOCNOTTY */ @@ -1288,17 +1456,25 @@ 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 */ #ifdef SETUP_SLAVE_PTY - SETUP_SLAVE_PTY; + if (pty_flag) + { + SETUP_SLAVE_PTY; + } #endif /* SETUP_SLAVE_PTY */ #ifdef AIX /* On AIX, we've disabled SIGHUP above once we start a child on a pty. @@ -1308,6 +1484,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); @@ -1321,20 +1504,35 @@ create_process (process, new_argv, current_dir) #endif /* ordinary USG */ #endif /* not BSD4_1 */ #endif /* SIGCHLD */ +#endif /* !POSIX_SIGNALS */ - child_setup_tty (xforkout); + if (pty_flag) + child_setup_tty (xforkout); +#ifdef WINDOWSNT + pid = child_setup (xforkin, xforkout, xforkout, + new_argv, 1, current_dir); +#else /* not WINDOWSNT */ child_setup (xforkin, xforkout, xforkout, new_argv, 1, current_dir); +#endif /* not WINDOWSNT */ } environ = save_environ; } if (pid < 0) - report_file_error ("Doing vfork", Qnil); + { + if (forkin >= 0) + close (forkin); + if (forkin != forkout && forkout >= 0) + close (forkout); + report_file_error ("Doing vfork", Qnil); + } - XFASTINT (XPROCESS (process)->pid) = pid; + XSETFASTINT (XPROCESS (process)->pid, pid); - FD_SET (inchannel, &input_wait_mask); +#ifdef WINDOWSNT + register_child (pid, inchannel); +#endif /* WINDOWSNT */ /* If the subfork execv fails, and it exits, this close hangs. I don't know why. @@ -1350,6 +1548,25 @@ create_process (process, new_argv, current_dir) 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; + +#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); @@ -1367,6 +1584,7 @@ create_process (process, new_argv, current_dir) #endif /* ordinary USG */ #endif /* not BSD4_1 */ #endif /* SIGCHLD */ +#endif /* !POSIX_SIGNALS */ } #endif /* not VMS */ @@ -1408,11 +1626,13 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ int port; struct hostent host_info_fixed; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + int retry = 0; + int count = specpdl_ptr - specpdl; GCPRO4 (name, buffer, host, service); CHECK_STRING (name, 0); CHECK_STRING (host, 0); - if (XTYPE(service) == Lisp_Int) + if (INTEGERP (service)) port = htons ((unsigned short) XINT (service)); else { @@ -1423,8 +1643,26 @@ 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 - host_info_ptr = gethostbyname (XSTRING (host)->data); + while (1) + { +#ifdef TRY_AGAIN + h_errno = 0; +#endif + host_info_ptr = gethostbyname (XSTRING (host)->data); +#ifdef TRY_AGAIN + if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN)) +#endif + break; + Fsleep_for (make_number (1), Qnil); + } if (host_info_ptr == 0) /* Attempt to interpret host as numeric inet address */ { @@ -1467,11 +1705,23 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ unrequest_sigio (); loop: - if (connect (s, (struct sockaddr *) &address, sizeof address) == -1) + if (connect (s, (struct sockaddr *) &address, sizeof address) == -1 + && errno != EISCONN) { int xerrno = errno; + if (errno == EINTR) goto loop; + if (errno == EADDRINUSE && retry < 20) + { + /* 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; + } + close (s); if (interrupt_input) @@ -1482,6 +1732,10 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ Fcons (host, Fcons (name, Qnil))); } +#ifdef POLL_FOR_INPUT + unbind_to (count, Qnil); +#endif + if (interrupt_input) request_sigio (); @@ -1519,10 +1773,13 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ XPROCESS (proc)->filter = Qnil; XPROCESS (proc)->command = Qnil; XPROCESS (proc)->pid = Qnil; - XSET (XPROCESS (proc)->infd, Lisp_Int, s); - XSET (XPROCESS (proc)->outfd, Lisp_Int, outch); + XSETINT (XPROCESS (proc)->infd, s); + XSETINT (XPROCESS (proc)->outfd, outch); XPROCESS (proc)->status = Qrun; FD_SET (inch, &input_wait_mask); + FD_SET (inch, &non_keyboard_wait_mask); + if (inch > max_process_desc) + max_process_desc = inch; UNGCPRO; return proc; @@ -1556,10 +1813,21 @@ 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; + /* We just closed the highest-numbered process input descriptor, + so recompute the highest-numbered one now. */ + max_process_desc = 0; + for (i = 0; i < MAXDESC; i++) + if (!NILP (chan_process[i])) + max_process_desc = i; + } } } @@ -1569,6 +1837,7 @@ deactivate_process (proc) close_process_descs () { +#ifndef WINDOWSNT int i; for (i = 0; i < MAXDESC; i++) { @@ -1584,6 +1853,7 @@ close_process_descs () close (out); } } +#endif } DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output, @@ -1606,8 +1876,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; @@ -1644,7 +1914,7 @@ Return non-nil iff we received any output before the timeout expired.") } if (NILP (proc)) - XFASTINT (proc) = 0; + XSETFASTINT (proc, 0); return (wait_reading_process_input (seconds, useconds, proc, 0) @@ -1656,7 +1926,10 @@ 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; /* Read and dispose of subprocess output while waiting for timeout to @@ -1677,7 +1950,7 @@ static int waiting_for_user_input_p; 1 to return when input is available, or -1 meaning caller will actually read the input, so don't throw to the quit handler, or - a cons cell, meaning wait wait until its car is non-nil + a cons cell, meaning wait until its car is non-nil (and gobble terminal input into the buffer if any arrives), or a process object, meaning wait until something arrives from that process. The return value is true iff we read some input from @@ -1711,18 +1984,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); @@ -1736,10 +2009,6 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) EMACS_ADD_TIME (end_time, end_time, timeout); } - /* It would not be safe to call this below, - where we call redisplay_preserve_echo_area. */ - prepare_menu_bars (); - while (1) { /* If calling from keyboard input, do not quit @@ -1791,7 +2060,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. */ @@ -1812,20 +2083,23 @@ 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 condition here; if a SIGIO arrives between now and the select and indicates that a frame is trashed, the select may block displaying a trashed screen. */ - if (frame_garbaged) - redisplay_preserve_echo_area (); + if (frame_garbaged && do_display) + { + 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 ()) { @@ -1833,7 +2107,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; @@ -1883,7 +2158,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) 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. @@ -1899,9 +2174,9 @@ 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 his if wait_for_cell, + /* We used to do this if wait_for_cell, but that caused infinite recursion in selection request events. */ - if ((XINT (read_kbd)) + if ((XINT (read_kbd) || wait_for_cell) && detect_input_pending ()) { swallow_events (); @@ -1920,7 +2195,7 @@ 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))) + && (keyboard_bit_set (&Available))) kill (0, SIGIO); #endif @@ -1935,10 +2210,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 < MAXDESC; channel++) + for (channel = 0; channel <= max_process_desc; channel++) { - if (FD_ISSET (channel, &Available)) + if (FD_ISSET (channel, &Available) + && FD_ISSET (channel, &non_keyboard_wait_mask)) { int nread; @@ -2022,6 +2297,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. */ @@ -2035,6 +2312,25 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) 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. @@ -2081,12 +2377,20 @@ read_process_output (proc, channel) #else /* not VMS */ if (proc_buffered_char[channel] < 0) +#ifdef WINDOWSNT + nchars = read_child_output (channel, chars, sizeof (chars)); +#else nchars = read (channel, chars, sizeof chars); +#endif else { chars[0] = proc_buffered_char[channel]; proc_buffered_char[channel] = -1; +#ifdef WINDOWSNT + nchars = read_child_output (channel, chars + 1, sizeof (chars) - 1); +#else nchars = read (channel, chars + 1, sizeof chars - 1); +#endif if (nchars < 0) nchars = 1; else @@ -2104,15 +2408,44 @@ read_process_output (proc, channel) it up. */ int count = specpdl_ptr - specpdl; Lisp_Object odeactivate; + 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; + XSETBUFFER (obuffer, current_buffer); + okeymap = current_buffer->keymap; specbind (Qinhibit_quit, Qt); - call2 (outstream, proc, make_string (chars, nchars)); + specbind (Qlast_nonmenu_event, Qt); + + running_asynch_code = 1; + internal_condition_case_1 (read_process_output_call, + Fcons (outstream, + Fcons (proc, + Fcons (make_string (chars, + nchars), + 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 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); #endif @@ -2132,8 +2465,8 @@ read_process_output (proc, channel) Fset_buffer (p->buffer); opoint = point; old_read_only = current_buffer->read_only; - XFASTINT (old_begv) = BEGV; - XFASTINT (old_zv) = ZV; + XSETFASTINT (old_begv, BEGV); + XSETFASTINT (old_zv, ZV); current_buffer->read_only = Qnil; @@ -2157,9 +2490,9 @@ read_process_output (proc, channel) /* Insert after old_begv, but before old_zv. */ if (point < XFASTINT (old_begv)) - XFASTINT (old_begv) += nchars; + XSETFASTINT (old_begv, XFASTINT (old_begv) + nchars); if (point <= XFASTINT (old_zv)) - XFASTINT (old_zv) += nchars; + XSETFASTINT (old_zv, XFASTINT (old_zv) + nchars); /* Insert before markers in case we are inserting where the buffer's mark is, and the user's next command is Meta-y. */ @@ -2187,11 +2520,11 @@ read_process_output (proc, channel) DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p, 0, 0, 0, - "Returns non-NIL if emacs is waiting for input from the user.\n\ + "Returns non-nil if emacs is waiting for input from the user.\n\ This is intended for use by asynchronous process output filters and sentinels.") () { - return ((waiting_for_user_input_p) ? Qt : Qnil); + return (waiting_for_user_input_p ? Qt : Qnil); } /* Sending data to subprocess */ @@ -2208,15 +2541,19 @@ send_process_trap () longjmp (send_process_frame, 1); } -send_process (proc, buf, len) - Lisp_Object proc; +/* Send some data to process PROC. + BUF is the beginning of the data; LEN is the number of characters. + OBJECT is the Lisp object that the data comes from. */ + +send_process (proc, buf, len, object) + volatile Lisp_Object proc; char *buf; int len; + Lisp_Object object; { - /* Don't use register vars; longjmp can lose them. */ + /* Use volatile to protect variables from being clobbered by longjmp. */ int rv; - unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data; - + volatile unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data; #ifdef VMS struct Lisp_Process *p = XPROCESS (proc); @@ -2235,51 +2572,111 @@ send_process (proc, buf, len) else if (write_to_vms_process (vs, buf, len)) ; #else + + if (pty_max_bytes == 0) + { +#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON) + pty_max_bytes = fpathconf (XFASTINT (XPROCESS (proc)->outfd), + _PC_MAX_CANON); + if (pty_max_bytes < 0) + pty_max_bytes = 250; +#else + pty_max_bytes = 250; +#endif + /* Deduct one, to leave space for the eof. */ + pty_max_bytes--; + } + if (!setjmp (send_process_frame)) while (len > 0) { int this = len; SIGTYPE (*old_sigpipe)(); + int flush_pty = 0; - /* Don't send more than 500 bytes at a time. */ - if (this > 500) - this = 500; - old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap); - rv = write (XINT (XPROCESS (proc)->outfd), buf, this); - signal (SIGPIPE, old_sigpipe); - if (rv < 0) + /* Decide how much data we can send in one batch. + Long lines need to be split into multiple batches. */ + if (!NILP (XPROCESS (proc)->pty_flag)) { - if (0 -#ifdef EWOULDBLOCK - || errno == EWOULDBLOCK -#endif -#ifdef EAGAIN - || errno == EAGAIN -#endif - ) + /* Starting this at zero is always correct when not the first iteration + because the previous iteration ended by sending C-d. + It may not be correct for the first iteration + if a partial line was sent in a separate send_process call. + If that proves worth handling, we need to save linepos + in the process object. */ + int linepos = 0; + char *ptr = buf; + char *end = buf + len; + + /* Scan through this text for a line that is too long. */ + while (ptr != end && linepos < pty_max_bytes) { - /* It would be nice to accept process output here, - but that is difficult. For example, it could - garbage what we are sending if that is from a buffer. */ - immediate_quit = 1; - QUIT; - sleep (1); - immediate_quit = 0; - continue; + if (*ptr == '\n') + linepos = 0; + else + linepos++; + ptr++; } - report_file_error ("writing to process", Fcons (proc, Qnil)); + /* If we found one, break the line there + and put in a C-d to force the buffer through. */ + this = ptr - buf; } - buf += rv; - len -= rv; - /* Allow input from processes between bursts of sending. - Otherwise things may get stopped up. */ - if (len > 0) + + /* Send this batch, using one or more write calls. */ + while (this > 0) { - Lisp_Object zero; + old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap); + rv = write (XINT (XPROCESS (proc)->outfd), buf, this); + signal (SIGPIPE, old_sigpipe); - XFASTINT (zero) = 0; - wait_reading_process_input (-1, 0, zero, 0); + if (rv < 0) + { + if (0 +#ifdef EWOULDBLOCK + || errno == EWOULDBLOCK +#endif +#ifdef EAGAIN + || errno == EAGAIN +#endif + ) + /* Buffer is full. Wait, accepting input; + that may allow the program + to finish doing output and read more. */ + { + Lisp_Object zero; + int offset; + + /* Running filters might relocate buffers or strings. + Arrange to relocate BUF. */ + if (BUFFERP (object)) + offset = BUF_PTR_CHAR_POS (XBUFFER (object), + (unsigned char *) buf); + else if (STRINGP (object)) + offset = buf - (char *) XSTRING (object)->data; + + XSETFASTINT (zero, 0); + wait_reading_process_input (1, 0, zero, 0); + + if (BUFFERP (object)) + buf = (char *) BUF_CHAR_ADDRESS (XBUFFER (object), offset); + else if (STRINGP (object)) + buf = offset + (char *) XSTRING (object)->data; + + rv = 0; + } + else + /* This is a real error. */ + report_file_error ("writing to process", Fcons (proc, Qnil)); + } + buf += rv; + len -= rv; + this -= rv; } + + /* If we sent just part of the string, put in an EOF + to force it through, before we send the rest. */ + if (len > 0) + Fprocess_send_eof (proc); } #endif else @@ -2319,7 +2716,8 @@ Output from processes can arrive in between bunches.") move_gap (start); start1 = XINT (start); - send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start)); + send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start), + Fcurrent_buffer ()); return Qnil; } @@ -2338,7 +2736,7 @@ Output from processes can arrive in between bunches.") Lisp_Object proc; CHECK_STRING (string, 1); proc = get_process (process); - send_process (proc, XSTRING (string)->data, XSTRING (string)->size); + send_process (proc, XSTRING (string)->data, XSTRING (string)->size, string); return Qnil; } @@ -2350,7 +2748,7 @@ Output from processes can arrive in between bunches.") right away. If we can, we try to signal PROCESS by sending control characters - down the pipe. This allows us to signal inferiors who have changed + down the pty. This allows us to signal inferiors who have changed their uid, for which killpg would return an EPERM error. */ static void @@ -2394,20 +2792,20 @@ process_send_signal (process, signo, current_group, nomsg) { case SIGINT: tcgetattr (XINT (p->infd), &t); - send_process (proc, &t.c_cc[VINTR], 1); + send_process (proc, &t.c_cc[VINTR], 1, Qnil); return; case SIGQUIT: tcgetattr (XINT (p->infd), &t); - send_process (proc, &t.c_cc[VQUIT], 1); + send_process (proc, &t.c_cc[VQUIT], 1, Qnil); return; case SIGTSTP: tcgetattr (XINT (p->infd), &t); -#if defined (VSWTCH) && !defined (IRIX5) - send_process (proc, &t.c_cc[VSWTCH], 1); +#if defined (VSWTCH) && !defined (PREFER_VSUSP) + send_process (proc, &t.c_cc[VSWTCH], 1, Qnil); #else - send_process (proc, &t.c_cc[VSUSP], 1); + send_process (proc, &t.c_cc[VSUSP], 1, Qnil); #endif return; } @@ -2425,16 +2823,16 @@ process_send_signal (process, signo, current_group, nomsg) { case SIGINT: ioctl (XINT (p->infd), TIOCGETC, &c); - send_process (proc, &c.t_intrc, 1); + send_process (proc, &c.t_intrc, 1, Qnil); return; case SIGQUIT: ioctl (XINT (p->infd), TIOCGETC, &c); - send_process (proc, &c.t_quitc, 1); + send_process (proc, &c.t_quitc, 1, Qnil); return; #ifdef SIGTSTP case SIGTSTP: ioctl (XINT (p->infd), TIOCGLTC, &lc); - send_process (proc, &lc.t_suspc, 1); + send_process (proc, &lc.t_suspc, 1, Qnil); return; #endif /* ! defined (SIGTSTP) */ } @@ -2449,16 +2847,16 @@ process_send_signal (process, signo, current_group, nomsg) { case SIGINT: ioctl (XINT (p->infd), TCGETA, &t); - send_process (proc, &t.c_cc[VINTR], 1); + send_process (proc, &t.c_cc[VINTR], 1, Qnil); return; case SIGQUIT: ioctl (XINT (p->infd), TCGETA, &t); - send_process (proc, &t.c_cc[VQUIT], 1); + send_process (proc, &t.c_cc[VQUIT], 1, Qnil); return; #ifdef SIGTSTP case SIGTSTP: ioctl (XINT (p->infd), TCGETA, &t); - send_process (proc, &t.c_cc[VSWTCH], 1); + send_process (proc, &t.c_cc[VSWTCH], 1, Qnil); return; #endif /* ! defined (SIGTSTP) */ } @@ -2519,12 +2917,12 @@ process_send_signal (process, signo, current_group, nomsg) #endif /* ! defined (SIGCONT) */ case SIGINT: #ifdef VMS - send_process (proc, "\003", 1); /* ^C */ + send_process (proc, "\003", 1, Qnil); /* ^C */ goto whoosh; #endif case SIGQUIT: #ifdef VMS - send_process (proc, "\031", 1); /* ^Y */ + send_process (proc, "\031", 1, Qnil); /* ^Y */ goto whoosh; #endif case SIGKILL: @@ -2562,7 +2960,7 @@ process_send_signal (process, signo, current_group, nomsg) DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0, "Interrupt process PROCESS. May be process or name of one.\n\ PROCESS may be a process, a buffer, or the name of a process or buffer.\n\ -Nil or no arg means current buffer's process.\n\ +nil or no arg means current buffer's process.\n\ Second arg CURRENT-GROUP non-nil means send signal to\n\ the current process-group of the process's controlling terminal\n\ rather than to the process's own process group.\n\ @@ -2625,21 +3023,141 @@ 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 + +#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, "Make PROCESS see end-of-file in its input.\n\ Eof comes after any text already sent to it.\n\ PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ -nil, indicating the current buffer's process.") +nil, indicating the current buffer's process.\n\ +If PROCESS is a network connection, or is a process communicating\n\ +through a pipe (as opposed to a pty), then you cannot send any more\n\ +text to PROCESS after you call this function.") (process) Lisp_Object process; { @@ -2653,26 +3171,17 @@ nil, indicating the current buffer's process.") if (! EQ (XPROCESS (proc)->status, Qrun)) error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data); - /* Sending a zero-length record is supposed to mean eof - when TIOCREMOTE is turned on. */ -#ifdef DID_REMOTE - { - char buf[1]; - write (XINT (XPROCESS (proc)->outfd), buf, 0); - } -#else /* did not do TOICREMOTE */ #ifdef VMS - send_process (proc, "\032", 1); /* ^z */ + send_process (proc, "\032", 1, Qnil); /* ^z */ #else if (!NILP (XPROCESS (proc)->pty_flag)) - send_process (proc, "\004", 1); + send_process (proc, "\004", 1, Qnil); else { close (XINT (XPROCESS (proc)->outfd)); - XSET (XPROCESS (proc)->outfd, Lisp_Int, open (NULL_DEVICE, O_WRONLY)); + XSETINT (XPROCESS (proc)->outfd, open (NULL_DEVICE, O_WRONLY)); } #endif /* VMS */ -#endif /* did not do TOICREMOTE */ return process; } @@ -2684,15 +3193,14 @@ 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)) - deactivate_process (proc); + Fdelete_process (proc); else if (XINT (XPROCESS (proc)->infd) >= 0) process_send_signal (proc, SIGHUP, Qnil, 1); } @@ -2791,7 +3299,7 @@ sigchld_handler (signo) { 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; } @@ -2800,16 +3308,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. */ @@ -2827,11 +3343,24 @@ sigchld_handler (signo) if (WIFEXITED (w)) synch_process_retcode = WRETCODE (w); else if (WIFSIGNALED (w)) + { + int code = WTERMSIG (w); + char *signame = 0; + + if (code < NSIG) + { #ifndef VMS - synch_process_death = (char *) sys_siglist[WTERMSIG (w)]; + /* Suppress warning if the table has const char *. */ + signame = (char *) sys_siglist[code]; #else - synch_process_death = sys_errlist[WTERMSIG (w)]; + signame = sys_errlist[code]; #endif + } + if (signame == 0) + signame = "unknown"; + + synch_process_death = signame; + } /* Tell wait_reading_process_input that it needs to wake up and look around. */ @@ -2844,7 +3373,7 @@ 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)) +#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG)) || defined (WINDOWSNT) #ifdef USG signal (signo, sigchld_handler); #endif @@ -2863,14 +3392,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; + 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; + XSETBUFFER (obuffer, current_buffer); + okeymap = current_buffer->keymap; + sentinel = p->sentinel; if (NILP (sentinel)) return; @@ -2881,7 +3426,28 @@ exec_sentinel (proc, reason) record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel)); /* Inhibit quit so that random quits don't screw up a running filter. */ specbind (Qinhibit_quit, Qt); - call2 (sentinel, proc, reason); + specbind (Qlast_nonmenu_event, Qt); + + running_asynch_code = 1; + internal_condition_case_1 (read_process_output_call, + Fcons (sentinel, + Fcons (proc, Fcons (reason, Qnil))), + !NILP (Vdebug_on_error) ? Qnil : Qerror, + exec_sentinel_error_handler); + running_asynch_code = 0; + restore_match_data (); + + Vdeactivate_mark = odeactivate; +#if 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 (); + unbind_to (count, Qnil); } @@ -2892,16 +3458,21 @@ exec_sentinel (proc, reason) status_notify () { register Lisp_Object proc, buffer; - Lisp_Object tail = Qnil; - Lisp_Object msg = Qnil; + Lisp_Object tail, msg; struct gcpro gcpro1, gcpro2; + tail = Qnil; + msg = Qnil; /* We need to gcpro tail; if read_process_output calls a filter which deletes a process and removes the cons to which tail points from Vprocess_alist, and then causes a GC, tail is an unprotected 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; @@ -2928,7 +3499,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) @@ -2947,11 +3518,12 @@ status_notify () when a process becomes runnable. */ else if (!EQ (symbol, Qrun) && !NILP (buffer)) { - Lisp_Object ro = XBUFFER (buffer)->read_only; - Lisp_Object tem; + Lisp_Object ro, tem; struct buffer *old = current_buffer; int opoint; + ro = XBUFFER (buffer)->read_only; + /* Avoid error if buffer is deleted (probably that's why the process is dead, too) */ if (NILP (XBUFFER (buffer)->name)) @@ -2986,11 +3558,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; @@ -3003,9 +3627,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++) @@ -3015,17 +3640,6 @@ 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 @@ -3051,6 +3665,9 @@ syms_of_process () Qclosed = intern ("closed"); staticpro (&Qclosed); + Qlast_nonmenu_event = intern ("last-nonmenu-event"); + staticpro (&Qlast_nonmenu_event); + staticpro (&Vprocess_alist); DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes, @@ -3061,9 +3678,10 @@ nil means don't delete them until `list-processes' is run."); DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type, "Control type of device used to communicate with subprocesses.\n\ -Values are nil to use a pipe, and t or 'pty for a pty. Note that if\n\ -pty's are not available, this variable will be ignored. The value takes\n\ -effect when `start-process' is called."); +Values are nil to use a pipe, or t or `pty' to use a pty.\n\ +The value has no effect if the system has no ptys or if all ptys are busy:\n\ +then a pipe is used in any case.\n\ +The value takes effect when `start-process' is called."); Vprocess_connection_type = Qt; defsubr (&Sprocessp); @@ -3074,6 +3692,7 @@ 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); @@ -3081,6 +3700,7 @@ 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 (&Sprocess_kill_without_query); defsubr (&Slist_processes); @@ -3112,6 +3732,7 @@ effect when `start-process' is called."); #include "lisp.h" #include "systime.h" #include "termopts.h" +#include "sysselect.h" extern int frame_garbaged; @@ -3134,7 +3755,7 @@ extern int frame_garbaged; `subprocesses' isn't defined. do_display != 0 means redisplay should be done to show subprocess - output that arrives. This version of the function ignores it. + output that arrives. Return true iff we received input from any process. */ @@ -3167,9 +3788,6 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* It's infinite. */ timeout_p = 0; - /* This must come before stop_polling. */ - prepare_menu_bars (); - /* Turn off periodic alarms (in case they are in use) because the select emulator uses alarms. */ stop_polling (); @@ -3201,13 +3819,14 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* If a frame has been newly mapped and needs updating, reprocess its display stuff. */ - if (frame_garbaged) + if (frame_garbaged && do_display) redisplay_preserve_echo_area (); if (XINT (read_kbd) && detect_input_pending ()) nfds = 0; else - nfds = select (1, &waitchannels, 0, 0, timeout_p); + nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0, + timeout_p); /* Make C-g and alarm signals set flags again */ clear_waiting_for_input (); @@ -3245,7 +3864,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0, - /* Don't confused make-docfile by having two doc strings for this function. + /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ 0) (name)