X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/99e3d726dc0b8ca7d6b9617d8036dd2512168808..c7dd82a34d3b058a81d11823a7f730f6607bd43d:/src/process.c diff --git a/src/process.c b/src/process.c index 5d79878617..1230887888 100644 --- a/src/process.c +++ b/src/process.c @@ -1,5 +1,5 @@ /* Asynchronous subprocess control for GNU Emacs. - Copyright (C) 1985, 1986, 1987, 1988, 1993 Free Software Foundation, Inc. + Copyright (C) 1985, 86, 87, 88, 93, 94 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -38,6 +38,14 @@ 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 @@ -51,8 +59,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 +101,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 +111,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 */ @@ -125,16 +134,24 @@ static Lisp_Object stream_process; #include "syswait.h" -extern errno; -extern sys_nerr; +extern int errno; +extern char *strerror (); +#ifdef VMS 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 -#else +#endif /* not LINUX */ +#else /* BSD4_1 */ char *sys_siglist[] = { "bum signal!!", @@ -164,8 +181,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. */ @@ -177,48 +196,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" -/* Mask of bits indicating the descriptors that we wait for input on */ +/* If we support X Windows, turn on the code to poll periodically + to detect C-g. It isn't actually used when doing interrupt input. */ +#ifdef HAVE_X_WINDOWS +#define POLL_FOR_INPUT +#endif + +/* 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). @@ -226,9 +240,20 @@ 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; + +/* Open an available pty, returning a file descriptor. + Return -1 on failure. + The file name of the terminal corresponding to the pty + is left in the variable pty_name. */ + +static char pty_name[24]; /* Compute the Lisp form of the process status, p->status, from the numeric status that was returned by `wait'. */ @@ -276,7 +301,7 @@ decode_status (l, symbol, code, coredump) { Lisp_Object tem; - if (XTYPE (l) == Lisp_Symbol) + if (SYMBOLP (l)) { *symbol = l; *code = 0; @@ -306,11 +331,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); @@ -330,13 +363,6 @@ status_message (status) #ifdef HAVE_PTYS -/* Open an available pty, returning a file descriptor. - Return -1 on failure. - The file name of the terminal corresponding to the pty - is left in the variable pty_name. */ - -char pty_name[24]; - int allocate_pty () { @@ -423,27 +449,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; @@ -461,6 +483,7 @@ make_process (name) } name = name1; p->name = name; + XSETPROCESS (val, p); Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist); return val; } @@ -482,7 +505,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, @@ -490,7 +513,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)); @@ -511,7 +534,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; @@ -526,24 +549,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, @@ -590,14 +623,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)) { @@ -619,7 +658,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); } @@ -658,6 +697,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).") @@ -706,9 +756,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; } @@ -748,10 +804,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; @@ -788,7 +860,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); @@ -796,8 +868,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)) { @@ -814,7 +886,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; @@ -865,6 +937,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", @@ -956,9 +1035,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)); @@ -997,24 +1076,31 @@ 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)); new_argv[0] = XSTRING (tem)->data; } + else + 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); @@ -1031,6 +1117,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); @@ -1044,7 +1135,7 @@ static Lisp_Object start_process_unwind (proc) Lisp_Object proc; { - if (XTYPE (proc) != Lisp_Process) + if (!PROCESSP (proc)) abort (); /* Was PROC started successfully? */ @@ -1102,7 +1193,7 @@ create_process (process, new_argv, current_dir) inchannel = outchannel = -1; #ifdef HAVE_PTYS - if (EQ (Vprocess_connection_type, Qt)) + if (!NILP (Vprocess_connection_type)) outchannel = inchannel = allocate_pty (); if (inchannel >= 0) @@ -1135,12 +1226,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 */ @@ -1170,13 +1271,13 @@ 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; @@ -1197,6 +1298,11 @@ create_process (process, new_argv, current_dir) #endif /* not BSD4_1 */ #endif /* SIGCHLD */ + 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. It is very important not to let this `marker' value stay @@ -1210,8 +1316,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; @@ -1226,22 +1334,45 @@ 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 + /* It's very important to call setpgrp here and no time afterwards. Otherwise, we lose our controlling tty which is set when we open the pty. */ setpgrp (); #endif /* USG */ #endif /* not HAVE_SETSID */ +#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; + 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. */ @@ -1256,7 +1387,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 */ @@ -1287,7 +1422,10 @@ create_process (process, new_argv, current_dir) } #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. @@ -1311,19 +1449,36 @@ create_process (process, new_argv, current_dir) #endif /* not BSD4_1 */ #endif /* SIGCHLD */ - child_setup_tty (xforkout); + signal (SIGINT, SIG_DFL); + signal (SIGQUIT, SIG_DFL); + + 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. @@ -1339,6 +1494,8 @@ create_process (process, new_argv, current_dir) if (forkin != forkout && forkout >= 0) close (forkout); + XPROCESS (process)->tty_name = build_string (pty_name); + #ifdef SIGCHLD #ifdef BSD4_1 sigrelse (SIGCHLD); @@ -1397,11 +1554,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 { @@ -1413,7 +1572,18 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ } #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 */ { @@ -1446,17 +1616,53 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ if (s < 0) report_file_error ("error creating socket", Fcons (name, Qnil)); + /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) + when connect is interrupted. So let's not let it get interrupted. + Note we do not turn off polling, because polling is only used + when not interrupt_input, and thus not normally used on the systems + which have this bug. On systems which use polling, there's no way + to quit if polling is turned off. */ + if (interrupt_input) + unrequest_sigio (); + + /* Slow down polling to every ten seconds. + Some kernels have a bug which causes retrying connect to fail + after a connect. */ +#ifdef POLL_FOR_INPUT + bind_polling_period (10); +#endif + loop: - if (connect (s, (struct sockaddr *) &address, sizeof address) == -1) + if (connect (s, (struct sockaddr *) &address, sizeof address) == -1 + && errno != EISCONN) { int xerrno = errno; + if (errno == EINTR) goto loop; + if (errno == EADDRINUSE && retry < 20) + { + retry++; + goto loop; + } + close (s); + + if (interrupt_input) + request_sigio (); + errno = xerrno; report_file_error ("connection failed", Fcons (host, Fcons (name, Qnil))); } + +#ifdef POLL_FOR_INPUT + unbind_to (count, Qnil); +#endif + + if (interrupt_input) + request_sigio (); + #else /* TERM */ s = connect_server (0); if (s < 0) @@ -1491,10 +1697,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; @@ -1528,10 +1737,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; + } } } @@ -1541,6 +1761,7 @@ deactivate_process (proc) close_process_descs () { +#ifndef WINDOWSNT int i; for (i = 0; i < MAXDESC; i++) { @@ -1556,6 +1777,7 @@ close_process_descs () close (out); } } +#endif } DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output, @@ -1578,8 +1800,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; @@ -1616,7 +1838,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) @@ -1628,7 +1850,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 @@ -1649,7 +1874,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 @@ -1683,18 +1908,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); @@ -1710,7 +1935,8 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* It would not be safe to call this below, where we call redisplay_preserve_echo_area. */ - prepare_menu_bars (); + if (do_display && frame_garbaged) + prepare_menu_bars (); while (1) { @@ -1766,7 +1992,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0) { /* It's okay for us to do this and then continue with - the loop, since timeout has already been zeroed out. */ + the loop, since timeout has already been zeroed out. */ clear_waiting_for_input (); status_notify (); } @@ -1784,19 +2010,17 @@ 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) + if (frame_garbaged && do_display) redisplay_preserve_echo_area (); if (XINT (read_kbd) && detect_input_pending ()) @@ -1844,7 +2068,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) the ptc file descriptor is automatically closed, yielding EBADF here or at select() call above. So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF - in m-ibmrt-aix.h), and here we just ignore the select error. + in m/ibmrt-aix.h), and here we just ignore the select error. Cleanup occurs c/o status_notify after SIGCLD. */ FD_ZERO (&Available); /* Cannot depend on values returned */ #else @@ -1852,10 +2076,10 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) #endif } else - error("select error: %s", sys_errlist[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. @@ -1871,9 +2095,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 (); @@ -1892,7 +2116,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 @@ -1907,10 +2131,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; @@ -1994,6 +2218,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. */ @@ -2007,6 +2233,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)); +} + /* Read pending output from the process channel, starting with our buffered-ahead character if we have one. Yield number of characters read. @@ -2053,12 +2298,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 @@ -2076,19 +2329,43 @@ 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 (! EQ (Fcurrent_buffer (), obuffer) + || ! EQ (current_buffer->keymap, okeymap)) + record_asynch_buffer_change (); + + if (waiting_for_user_input_p) + prepare_menu_bars (); + #ifdef VMS start_vms_process_read (vs); #endif - unbind_to (count); + unbind_to (count, Qnil); return nchars; } @@ -2104,8 +2381,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; @@ -2113,7 +2390,7 @@ read_process_output (proc, channel) at the current end-of-output marker, thus preserving logical ordering of input and output. */ if (XMARKER (p->mark)->buffer) - SET_PT (marker_position (p->mark)); + SET_PT (clip_to_bounds (BEGV, marker_position (p->mark), ZV)); else SET_PT (ZV); @@ -2129,9 +2406,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. */ @@ -2159,11 +2436,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 */ @@ -2180,16 +2457,20 @@ send_process_trap () longjmp (send_process_frame, 1); } -send_process (proc, buf, len) +/* 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) Lisp_Object proc; char *buf; int len; + Lisp_Object object; { /* Don't use register vars; longjmp can lose them. */ int rv; unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data; - #ifdef VMS struct Lisp_Process *p = XPROCESS (proc); VMS_PROC_STUFF *vs, *get_vms_process_pointer(); @@ -2207,51 +2488,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 @@ -2291,7 +2632,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; } @@ -2310,7 +2652,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; } @@ -2322,7 +2664,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 @@ -2366,20 +2708,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; } @@ -2397,16 +2739,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) */ } @@ -2421,16 +2763,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) */ } @@ -2491,12 +2833,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: @@ -2534,7 +2876,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\ @@ -2604,14 +2946,22 @@ Both PID and CODE are integers.") { CHECK_NUMBER (pid, 0); CHECK_NUMBER (sig, 1); +#ifdef WINDOWSNT + /* Only works for kill-type signals */ + return make_number (win32_kill_process (XINT (pid), XINT (sig))); +#else return make_number (kill (XINT (pid), XINT (sig))); +#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; { @@ -2625,26 +2975,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; } @@ -2656,15 +2997,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); } @@ -2763,7 +3103,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; } @@ -2772,16 +3112,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; + XSETFASTINT (p->raw_status_low, u.i & 0xffff); + XSETFASTINT (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. */ @@ -2799,11 +3147,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. */ @@ -2816,7 +3177,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 @@ -2835,14 +3196,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)); +} + 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; @@ -2853,8 +3230,25 @@ 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); - unbind_to (count); + specbind (Qlast_nonmenu_event, Qt); + + running_asynch_code = 1; + internal_condition_case_1 (read_process_output_call, + Fcons (sentinel, + Fcons (proc, Fcons (reason, Qnil))), + !NILP (Vdebug_on_error) ? Qnil : Qerror, + exec_sentinel_error_handler); + running_asynch_code = 0; + restore_match_data (); + + Vdeactivate_mark = odeactivate; + if (! EQ (Fcurrent_buffer (), obuffer) + || ! EQ (current_buffer->keymap, okeymap)) + record_asynch_buffer_change (); + + if (waiting_for_user_input_p) + prepare_menu_bars (); + unbind_to (count, Qnil); } /* Report all recent events of a change in process status @@ -2864,10 +3258,11 @@ 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 @@ -2900,7 +3295,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) @@ -2919,11 +3314,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)) @@ -2963,6 +3359,60 @@ status_notify () 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; @@ -2975,9 +3425,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++) @@ -2987,17 +3438,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 @@ -3023,6 +3463,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, @@ -3033,9 +3476,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); @@ -3046,6 +3490,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); @@ -3053,6 +3498,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); @@ -3106,7 +3552,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. */ @@ -3173,7 +3619,7 @@ 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 ()) @@ -3217,7 +3663,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)