160432Shibler /* Asynchronous subprocess control for GNU Emacs.
260432Shibler Copyright (C) 1985, 1986, 1987, 1988, 1990 Free Software Foundation, Inc.
360432Shibler
460432Shibler This file is part of GNU Emacs.
560432Shibler
660432Shibler GNU Emacs is free software; you can redistribute it and/or modify
760432Shibler it under the terms of the GNU General Public License as published by
860432Shibler the Free Software Foundation; either version 1, or (at your option)
960432Shibler any later version.
1060432Shibler
1160432Shibler GNU Emacs is distributed in the hope that it will be useful,
1260432Shibler but WITHOUT ANY WARRANTY; without even the implied warranty of
1360432Shibler MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1460432Shibler GNU General Public License for more details.
1560432Shibler
1660432Shibler You should have received a copy of the GNU General Public License
1760432Shibler along with GNU Emacs; see the file COPYING. If not, write to
1860432Shibler the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
1960432Shibler
2060432Shibler
2160432Shibler #include <signal.h>
2260432Shibler
2360432Shibler #include "config.h"
2460432Shibler
2560432Shibler #ifdef subprocesses
2660432Shibler /* The entire file is within this conditional */
2760432Shibler
2860432Shibler #include <stdio.h>
2960432Shibler #include <errno.h>
3060432Shibler #include <setjmp.h>
3160432Shibler #include <sys/types.h> /* some typedefs are used in sys/file.h */
3260432Shibler #include <sys/file.h>
3360432Shibler #include <sys/stat.h>
3460432Shibler
3560432Shibler #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
3660432Shibler #include <sys/socket.h>
3760432Shibler #include <netdb.h>
3860432Shibler #include <netinet/in.h>
3960432Shibler #endif /* HAVE_SOCKETS */
4060432Shibler
4160432Shibler #if defined(BSD) || defined(STRIDE)
4260432Shibler #include <sys/ioctl.h>
4360432Shibler #if !defined (O_NDELAY) && defined (HAVE_PTYS)
4460432Shibler #include <fcntl.h>
4560432Shibler #endif /* HAVE_PTYS and no O_NDELAY */
4660432Shibler #endif /* BSD or STRIDE */
4760432Shibler #ifdef USG
4860432Shibler #include <termio.h>
4960432Shibler #include <fcntl.h>
5060432Shibler #endif /* USG */
5160432Shibler
5260432Shibler #ifdef NEED_BSDTTY
5360432Shibler #include <sys/bsdtty.h>
5460432Shibler #endif
5560432Shibler
5660432Shibler #ifdef HPUX
5760432Shibler #undef TIOCGPGRP
5860432Shibler #endif
5960432Shibler
6060432Shibler #ifdef IRIS
6160432Shibler #include <sys/sysmacros.h> /* for "minor" */
6260432Shibler #include <sys/time.h>
6360432Shibler #else
6460432Shibler #ifdef UNIPLUS
6560432Shibler #include <sys/time.h>
6660432Shibler
6760432Shibler #else /* not IRIS, not UNIPLUS */
6860432Shibler #ifdef HAVE_TIMEVAL
6960432Shibler /* _h_BSDTYPES is checked because on ISC unix, socket.h includes
7060432Shibler both time.h and sys/time.h, and the latter file is protected
7160432Shibler from repeated inclusion. */
7260432Shibler #if defined(USG) && !defined(AIX) && !defined(_h_BSDTYPES) && !defined(USG_SYS_TIME)
7360432Shibler #include <time.h>
7460432Shibler #else /* AIX or USG_SYS_TIME, or not USG */
7560432Shibler #include <sys/time.h>
7660432Shibler #endif /* AIX or USG_SYS_TIME, or not USG */
7760432Shibler #endif /* HAVE_TIMEVAL */
7860432Shibler
7960432Shibler #endif /* not UNIPLUS */
8060432Shibler #endif /* not IRIS */
8160432Shibler
8260432Shibler #if defined (HPUX) && defined (HAVE_PTYS)
8360432Shibler #include <sys/ptyio.h>
8460432Shibler #endif
8560432Shibler
8660432Shibler #ifdef AIX
8760432Shibler #include <sys/pty.h>
8860432Shibler #include <unistd.h>
8960432Shibler #endif /* AIX */
9060432Shibler
9160432Shibler #ifdef SYSV_PTYS
9260432Shibler #include <sys/tty.h>
9360432Shibler #include <sys/pty.h>
9460432Shibler #endif
9560432Shibler
9660432Shibler #undef NULL
9760432Shibler #include "lisp.h"
9860432Shibler #include "window.h"
9960432Shibler #include "buffer.h"
10060432Shibler #include "process.h"
10160432Shibler #include "termhooks.h"
10260432Shibler #include "termopts.h"
10360432Shibler #include "commands.h"
10460432Shibler
10560432Shibler Lisp_Object Qrun, Qstop, Qsignal, Qexit, Qopen, Qclosed;
10660432Shibler
10760432Shibler /* a process object is a network connection when its childp field is neither
10860432Shibler Qt nor Qnil but is instead a string (name of foreign host we
10960432Shibler are connected to + name of port we are connected to) */
11060432Shibler
11160432Shibler #ifdef HAVE_SOCKETS
11260432Shibler #define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String)
11360432Shibler #else
11460432Shibler #define NETCONN_P(p) 0
11560432Shibler #endif /* HAVE_SOCKETS */
11660432Shibler
11760432Shibler /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
11860432Shibler testing SIGCHLD. */
11960432Shibler
12060432Shibler #if !defined (SIGCHLD) && defined (SIGCLD)
12160432Shibler #define SIGCHLD SIGCLD
12260432Shibler #endif /* SIGCLD */
12360432Shibler
12460432Shibler /* Define the structure that the wait system call stores.
12560432Shibler On many systems, there is a structure defined for this.
12660432Shibler But on vanilla-ish USG systems there is not. */
12760432Shibler
12860432Shibler #ifndef WAITTYPE
12960432Shibler #if !defined (BSD) && !defined (UNIPLUS) && !defined (STRIDE) && !(defined (HPUX) && !defined (NOMULTIPLEJOBS)) && !defined (HAVE_WAIT_HEADER)
13060432Shibler #define WAITTYPE int
13160432Shibler #define WIFSTOPPED(w) ((w&0377) == 0177)
13260432Shibler #define WIFSIGNALED(w) ((w&0377) != 0177 && (w&~0377) == 0)
13360432Shibler #define WIFEXITED(w) ((w&0377) == 0)
13460432Shibler #define WRETCODE(w) (w >> 8)
13560432Shibler #define WSTOPSIG(w) (w >> 8)
13660432Shibler #define WTERMSIG(w) (w & 0377)
13760432Shibler #ifndef WCOREDUMP
13860432Shibler #define WCOREDUMP(w) ((w&0200) != 0)
13960432Shibler #endif
14060432Shibler #else
14160432Shibler #ifdef BSD4_1
14260432Shibler #include <wait.h>
14360432Shibler #else
14460432Shibler #include <sys/wait.h>
14560432Shibler #endif /* not BSD 4.1 */
14660432Shibler
14760432Shibler #define WAITTYPE union wait
14860432Shibler #ifndef WRETCODE
14960432Shibler #define WRETCODE(w) w.w_retcode
15060432Shibler #endif
15160432Shibler #ifndef WCOREDUMP
15260432Shibler #define WCOREDUMP(w) w.w_coredump
15360432Shibler #endif
15460432Shibler
15560432Shibler #ifdef HPUX
15660432Shibler /* HPUX version 7 has broken definitions of these. */
15760432Shibler #undef WTERMSIG
15860432Shibler #undef WSTOPSIG
15960432Shibler #undef WIFSTOPPED
16060432Shibler #undef WIFSIGNALED
16160432Shibler #undef WIFEXITED
16260432Shibler #endif
16360432Shibler
16460432Shibler #ifndef WTERMSIG
16560432Shibler #define WTERMSIG(w) w.w_termsig
16660432Shibler #endif
16760432Shibler #ifndef WSTOPSIG
16860432Shibler #define WSTOPSIG(w) w.w_stopsig
16960432Shibler #endif
17060432Shibler #ifndef WIFSTOPPED
17160432Shibler #define WIFSTOPPED(w) (WTERMSIG (w) == 0177)
17260432Shibler #endif
17360432Shibler #ifndef WIFSIGNALED
17460432Shibler #define WIFSIGNALED(w) (WTERMSIG (w) != 0177 && (WSTOPSIG (w)) == 0)
17560432Shibler #endif
17660432Shibler #ifndef WIFEXITED
17760432Shibler #define WIFEXITED(w) (WTERMSIG (w) == 0)
17860432Shibler #endif
17960432Shibler #endif /* BSD or UNIPLUS or STRIDE */
18060432Shibler #endif /* no WAITTYPE */
18160432Shibler
18260432Shibler #ifndef BSD4_4
18360432Shibler extern errno;
18460432Shibler extern sys_nerr;
18560432Shibler extern char *sys_errlist[];
18660432Shibler #endif
18760432Shibler
18860432Shibler #ifndef BSD4_1
18960432Shibler #ifndef BSD4_4
19060432Shibler extern char *sys_siglist[];
19160432Shibler #endif
19260432Shibler #else
19360432Shibler char *sys_siglist[] =
19460432Shibler {
19560432Shibler "bum signal!!",
19660432Shibler "hangup",
19760432Shibler "interrupt",
19860432Shibler "quit",
19960432Shibler "illegal instruction",
20060432Shibler "trace trap",
20160432Shibler "iot instruction",
20260432Shibler "emt instruction",
20360432Shibler "floating point exception",
20460432Shibler "kill",
20560432Shibler "bus error",
20660432Shibler "segmentation violation",
20760432Shibler "bad argument to system call",
20860432Shibler "write on a pipe with no one to read it",
20960432Shibler "alarm clock",
21060432Shibler "software termination signal from kill",
21160432Shibler "status signal",
21260432Shibler "sendable stop signal not from tty",
21360432Shibler "stop signal from tty",
21460432Shibler "continue a stopped process",
21560432Shibler "child status has changed",
21660432Shibler "background read attempted from control tty",
21760432Shibler "background write attempted from control tty",
21860432Shibler "input record available at control tty",
21960432Shibler "exceeded CPU time limit",
22060432Shibler "exceeded file size limit"
22160432Shibler };
22260432Shibler #endif
22360432Shibler
22460432Shibler #ifdef vipc
22560432Shibler
22660432Shibler #include "vipc.h"
22760432Shibler extern int comm_server;
22860432Shibler extern int net_listen_address;
22960432Shibler #endif /* vipc */
23060432Shibler
23160432Shibler /* t means use pty, nil means use a pipe,
23260432Shibler maybe other values to come. */
23360432Shibler Lisp_Object Vprocess_connection_type;
23460432Shibler
23560432Shibler #ifdef SKTPAIR
23660432Shibler #ifndef HAVE_SOCKETS
23760432Shibler #include <sys/socket.h>
23860432Shibler #endif
23960432Shibler #endif /* SKTPAIR */
24060432Shibler
24160432Shibler /* Number of events of change of status of a process. */
24260432Shibler int process_tick;
24360432Shibler
24460432Shibler /* Number of events for which the user or sentinel has been notified. */
24560432Shibler int update_tick;
24660432Shibler
24760432Shibler int delete_exited_processes;
24860432Shibler
24960432Shibler #ifdef FD_SET
25060432Shibler /* We could get this from param.h, but better not to depend on finding that.
25160432Shibler And better not to risk that it might define other symbols used in this
25260432Shibler file. */
25360432Shibler #define MAXDESC 64
25460432Shibler #define SELECT_TYPE fd_set
25560432Shibler #else /* no FD_SET */
25660432Shibler #define MAXDESC 32
25760432Shibler #define SELECT_TYPE int
25860432Shibler
25960432Shibler /* Define the macros to access a single-int bitmap of descriptors. */
26060432Shibler #define FD_SET(n, p) (*(p) |= (1 << (n)))
26160432Shibler #define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
26260432Shibler #define FD_ISSET(n, p) (*(p) & (1 << (n)))
26360432Shibler #define FD_ZERO(p) (*(p) = 0)
26460432Shibler #endif /* no FD_SET */
26560432Shibler
26660432Shibler /* Mask of bits indicating the descriptors that we wait for input on */
26760432Shibler
26860432Shibler SELECT_TYPE input_wait_mask;
26960432Shibler
27060432Shibler /* Indexed by descriptor, gives the process (if any) for that descriptor */
27160432Shibler Lisp_Object chan_process[MAXDESC];
27260432Shibler
27360432Shibler /* Alist of elements (NAME . PROCESS) */
27460432Shibler Lisp_Object Vprocess_alist;
27560432Shibler
27660432Shibler Lisp_Object Qprocessp;
27760432Shibler
27860432Shibler Lisp_Object get_process ();
27960432Shibler
28060432Shibler /* Buffered-ahead input char from process, indexed by channel.
28160432Shibler -1 means empty (no char is buffered).
28260432Shibler Used on sys V where the only way to tell if there is any
28360432Shibler output from the process is to read at least one char.
28460432Shibler Always -1 on systems that support FIONREAD. */
28560432Shibler
28660432Shibler int proc_buffered_char[MAXDESC];
28760432Shibler
28860432Shibler /* These variables hold the filter about to be run, and its args,
28960432Shibler between read_process_output and run_filter.
29060432Shibler Also used in exec_sentinel for sentinels. */
29160432Shibler Lisp_Object this_filter;
29260432Shibler Lisp_Object filter_process, filter_string;
29360432Shibler
29460432Shibler /* Compute the Lisp form of the process status, p->status,
29560432Shibler from the numeric status that was returned by `wait'. */
29660432Shibler
29760432Shibler update_status (p)
29860432Shibler struct Lisp_Process *p;
29960432Shibler {
30060432Shibler union { int i; WAITTYPE wt; } u;
30160432Shibler u.i = XFASTINT (p->raw_status_low) + (XFASTINT (p->raw_status_high) << 16);
30260432Shibler p->status = status_convert (u.wt);
30360432Shibler p->raw_status_low = Qnil;
30460432Shibler p->raw_status_high = Qnil;
30560432Shibler }
30660432Shibler
30760432Shibler /* Convert a process status word in Unix format
30860432Shibler to the list that we use internally. */
30960432Shibler
31060432Shibler Lisp_Object
status_convert(w)31160432Shibler status_convert (w)
31260432Shibler WAITTYPE w;
31360432Shibler {
31460432Shibler if (WIFSTOPPED (w))
31560432Shibler return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
31660432Shibler else if (WIFEXITED (w))
31760432Shibler return Fcons (Qexit, Fcons (make_number (WRETCODE (w)),
31860432Shibler WCOREDUMP (w) ? Qt : Qnil));
31960432Shibler else if (WIFSIGNALED (w))
32060432Shibler return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
32160432Shibler WCOREDUMP (w) ? Qt : Qnil));
32260432Shibler else
32360432Shibler return Qrun;
32460432Shibler }
32560432Shibler
32660432Shibler /* Given a status-list, extract the three pieces of information
32760432Shibler and store them individually through the three pointers. */
32860432Shibler
32960432Shibler void
decode_status(l,symbol,code,coredump)33060432Shibler decode_status (l, symbol, code, coredump)
33160432Shibler Lisp_Object l;
33260432Shibler Lisp_Object *symbol;
33360432Shibler int *code;
33460432Shibler int *coredump;
33560432Shibler {
33660432Shibler Lisp_Object tem;
33760432Shibler
33860432Shibler if (XTYPE (l) == Lisp_Symbol)
33960432Shibler {
34060432Shibler *symbol = l;
34160432Shibler *code = 0;
34260432Shibler *coredump = 0;
34360432Shibler }
34460432Shibler else
34560432Shibler {
34660432Shibler *symbol = XCONS (l)->car;
34760432Shibler tem = XCONS (l)->cdr;
34860432Shibler *code = XFASTINT (XCONS (tem)->car);
34960432Shibler tem = XFASTINT (XCONS (tem)->cdr);
35060432Shibler *coredump = !NULL (tem);
35160432Shibler }
35260432Shibler }
35360432Shibler
35460432Shibler /* Return a string describing a process status list. */
35560432Shibler
35660432Shibler Lisp_Object
status_message(status)35760432Shibler status_message (status)
35860432Shibler Lisp_Object status;
35960432Shibler {
36060432Shibler Lisp_Object symbol;
36160432Shibler int code, coredump;
36260432Shibler Lisp_Object string, string2;
36360432Shibler
36460432Shibler decode_status (status, &symbol, &code, &coredump);
36560432Shibler
36660432Shibler if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
36760432Shibler {
36860432Shibler string = build_string (code < NSIG ? sys_siglist[code] : "unknown");
36960432Shibler string2 = build_string (coredump ? " (core dumped)\n" : "\n");
37060432Shibler XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
37160432Shibler return concat2 (string, string2);
37260432Shibler }
37360432Shibler else if (EQ (symbol, Qexit))
37460432Shibler {
37560432Shibler if (code == 0)
37660432Shibler return build_string ("finished\n");
37760432Shibler string = Fint_to_string (make_number (code));
37860432Shibler string2 = build_string (coredump ? " (core dumped)\n" : "\n");
37960432Shibler return concat2 (build_string ("exited abnormally with code "),
38060432Shibler concat2 (string, string2));
38160432Shibler }
38260432Shibler else
38360432Shibler return Fcopy_sequence (Fsymbol_name (symbol));
38460432Shibler }
38560432Shibler
38660432Shibler #ifdef HAVE_PTYS
38760432Shibler
38860432Shibler /* Open an available pty, returning a file descriptor.
38960432Shibler Return -1 on failure.
39060432Shibler The file name of the terminal corresponding to the pty
39160432Shibler is left in the variable pty_name. */
39260432Shibler
39360432Shibler char pty_name[24];
39460432Shibler
39560432Shibler int
allocate_pty()39660432Shibler allocate_pty ()
39760432Shibler {
39860432Shibler struct stat stb;
39960432Shibler register c, i;
40060432Shibler int fd;
40160432Shibler
40260432Shibler #ifdef PTY_ITERATION
40360432Shibler PTY_ITERATION
40460432Shibler #else
40560432Shibler for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
40660432Shibler for (i = 0; i < 16; i++)
40760432Shibler #endif
40860432Shibler {
40960432Shibler #ifdef PTY_NAME_SPRINTF
41060432Shibler PTY_NAME_SPRINTF
41160432Shibler #else
41260432Shibler #ifdef HPUX
41360432Shibler sprintf (pty_name, "/dev/ptym/pty%c%x", c, i);
41460432Shibler #else
41560432Shibler #ifdef RTU
41660432Shibler sprintf (pty_name, "/dev/pty%x", i);
41760432Shibler #else
41860432Shibler sprintf (pty_name, "/dev/pty%c%x", c, i);
41960432Shibler #endif /* not RTU */
42060432Shibler #endif /* not HPUX */
42160432Shibler #endif /* no PTY_NAME_SPRINTF */
42260432Shibler
42360432Shibler #ifndef IRIS
42460432Shibler if (stat (pty_name, &stb) < 0)
42560432Shibler return -1;
42660432Shibler #ifdef O_NONBLOCK
42760432Shibler fd = open (pty_name, O_RDWR | O_NONBLOCK, 0);
42860432Shibler #else
42960432Shibler fd = open (pty_name, O_RDWR | O_NDELAY, 0);
43060432Shibler #endif
43160432Shibler #else /* Unusual IRIS code */
43260432Shibler fd = open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
43360432Shibler if (fd < 0)
43460432Shibler return -1;
43560432Shibler if (fstat (fd, &stb) < 0)
43660432Shibler return -1;
43760432Shibler #endif /* IRIS */
43860432Shibler
43960432Shibler if (fd >= 0)
44060432Shibler {
44160432Shibler /* check to make certain that both sides are available
44260432Shibler this avoids a nasty yet stupid bug in rlogins */
44360432Shibler #ifdef PTY_TTY_NAME_SPRINTF
44460432Shibler PTY_TTY_NAME_SPRINTF
44560432Shibler #else
44660432Shibler /* In version 19, make these special cases use the macro above. */
44760432Shibler #ifdef HPUX
44860432Shibler sprintf (pty_name, "/dev/pty/tty%c%x", c, i);
44960432Shibler #else
45060432Shibler #ifdef RTU
45160432Shibler sprintf (pty_name, "/dev/ttyp%x", i);
45260432Shibler #else
45360432Shibler #ifdef IRIS
45460432Shibler sprintf (pty_name, "/dev/ttyq%d", minor (stb.st_rdev));
45560432Shibler #else
45660432Shibler sprintf (pty_name, "/dev/tty%c%x", c, i);
45760432Shibler #endif /* not IRIS */
45860432Shibler #endif /* not RTU */
45960432Shibler #endif /* not HPUX */
46060432Shibler #endif /* no PTY_TTY_NAME_SPRINTF */
46160432Shibler #ifndef UNIPLUS
46260432Shibler if (access (pty_name, 6) != 0)
46360432Shibler {
46460432Shibler close (fd);
46560432Shibler #ifndef IRIS
46660432Shibler continue;
46760432Shibler #else
46860432Shibler return -1;
46960432Shibler #endif /* IRIS */
47060432Shibler }
47160432Shibler #endif /* not UNIPLUS */
47260432Shibler setup_pty (fd);
47360432Shibler return fd;
47460432Shibler }
47560432Shibler }
47660432Shibler return -1;
47760432Shibler }
47860432Shibler #endif /* HAVE_PTYS */
47960432Shibler
48060432Shibler Lisp_Object
make_process(name)48160432Shibler make_process (name)
48260432Shibler Lisp_Object name;
48360432Shibler {
48460432Shibler register Lisp_Object val, tem, name1;
48560432Shibler register struct Lisp_Process *p;
48660432Shibler char suffix[10];
48760432Shibler register int i;
48860432Shibler
48960432Shibler /* size of process structure includes the vector header,
49060432Shibler so deduct for that. But struct Lisp_Vector includes the first
49160432Shibler element, thus deducts too much, so add it back. */
49260432Shibler val = Fmake_vector (make_number ((sizeof (struct Lisp_Process)
49360432Shibler - sizeof (struct Lisp_Vector)
49460432Shibler + sizeof (Lisp_Object))
49560432Shibler / sizeof (Lisp_Object)),
49660432Shibler Qnil);
49760432Shibler XSETTYPE (val, Lisp_Process);
49860432Shibler
49960432Shibler p = XPROCESS (val);
50060432Shibler XFASTINT (p->infd) = 0;
50160432Shibler XFASTINT (p->outfd) = 0;
50260432Shibler XFASTINT (p->pid) = 0;
50360432Shibler XFASTINT (p->tick) = 0;
50460432Shibler XFASTINT (p->update_tick) = 0;
50560432Shibler p->raw_status_low = Qnil;
50660432Shibler p->raw_status_high = Qnil;
50760432Shibler p->status = Qrun;
50860432Shibler p->mark = Fmake_marker ();
50960432Shibler
51060432Shibler /* If name is already in use, modify it until it is unused. */
51160432Shibler
51260432Shibler name1 = name;
51360432Shibler for (i = 1; ; i++)
51460432Shibler {
51560432Shibler tem = Fget_process (name1);
51660432Shibler if (NULL (tem)) break;
51760432Shibler sprintf (suffix, "<%d>", i);
51860432Shibler name1 = concat2 (name, build_string (suffix));
51960432Shibler }
52060432Shibler name = name1;
52160432Shibler p->name = name;
52260432Shibler Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
52360432Shibler return val;
52460432Shibler }
52560432Shibler
remove_process(proc)52660432Shibler remove_process (proc)
52760432Shibler register Lisp_Object proc;
52860432Shibler {
52960432Shibler register Lisp_Object pair;
53060432Shibler
53160432Shibler pair = Frassq (proc, Vprocess_alist);
53260432Shibler Vprocess_alist = Fdelq (pair, Vprocess_alist);
53360432Shibler Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil);
53460432Shibler
53560432Shibler deactivate_process (proc);
53660432Shibler }
53760432Shibler
53860432Shibler DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
53960432Shibler "Return t if OBJECT is a process.")
54060432Shibler (obj)
54160432Shibler Lisp_Object obj;
54260432Shibler {
54360432Shibler return XTYPE (obj) == Lisp_Process ? Qt : Qnil;
54460432Shibler }
54560432Shibler
54660432Shibler DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
54760432Shibler "Return the process named NAME, or nil if there is none.")
54860432Shibler (name)
54960432Shibler register Lisp_Object name;
55060432Shibler {
55160432Shibler if (XTYPE (name) == Lisp_Process)
55260432Shibler return name;
55360432Shibler CHECK_STRING (name, 0);
55460432Shibler return Fcdr (Fassoc (name, Vprocess_alist));
55560432Shibler }
55660432Shibler
55760432Shibler DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
55860432Shibler "Return the (or, a) process associated with BUFFER.\n\
55960432Shibler BUFFER may be a buffer or the name of one.")
56060432Shibler (name)
56160432Shibler register Lisp_Object name;
56260432Shibler {
56360432Shibler register Lisp_Object buf, tail, proc;
56460432Shibler
56560432Shibler if (NULL (name)) return Qnil;
56660432Shibler buf = Fget_buffer (name);
56760432Shibler if (NULL (buf)) return Qnil;
56860432Shibler
56960432Shibler for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
57060432Shibler {
57160432Shibler proc = Fcdr (Fcar (tail));
57260432Shibler if (XTYPE (proc) == Lisp_Process && EQ (XPROCESS (proc)->buffer, buf))
57360432Shibler return proc;
57460432Shibler }
57560432Shibler return Qnil;
57660432Shibler }
57760432Shibler
57860432Shibler /* This is how commands for the user decode process arguments */
57960432Shibler
58060432Shibler Lisp_Object
get_process(name)58160432Shibler get_process (name)
58260432Shibler register Lisp_Object name;
58360432Shibler {
58460432Shibler register Lisp_Object proc;
58560432Shibler if (NULL (name))
58660432Shibler proc = Fget_buffer_process (Fcurrent_buffer ());
58760432Shibler else
58860432Shibler {
58960432Shibler proc = Fget_process (name);
59060432Shibler if (NULL (proc))
59160432Shibler proc = Fget_buffer_process (Fget_buffer (name));
59260432Shibler }
59360432Shibler
59460432Shibler if (!NULL (proc))
59560432Shibler return proc;
59660432Shibler
59760432Shibler if (NULL (name))
59860432Shibler error ("Current buffer has no process");
59960432Shibler else
60060432Shibler error ("Process %s does not exist", XSTRING (name)->data);
60160432Shibler /* NOTREACHED */
60260432Shibler }
60360432Shibler
60460432Shibler DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
60560432Shibler "Delete PROCESS: kill it and forget about it immediately.\n\
60660432Shibler PROCESS may be a process or the name of one, or a buffer name.")
60760432Shibler (proc)
60860432Shibler register Lisp_Object proc;
60960432Shibler {
61060432Shibler proc = get_process (proc);
61160432Shibler XPROCESS (proc)->raw_status_low = Qnil;
61260432Shibler XPROCESS (proc)->raw_status_high = Qnil;
61360432Shibler if (NETCONN_P (proc))
61460432Shibler {
61560432Shibler XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
61660432Shibler XSETINT (XPROCESS (proc)->tick, ++process_tick);
61760432Shibler }
61860432Shibler else if (XFASTINT (XPROCESS (proc)->infd))
61960432Shibler {
62060432Shibler Fkill_process (proc, Qnil);
62160432Shibler /* Do this now, since remove_process will make sigchld_handler do nothing. */
62260432Shibler XPROCESS (proc)->status
62360432Shibler = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
62460432Shibler XSETINT (XPROCESS (proc)->tick, ++process_tick);
62560432Shibler status_notify ();
62660432Shibler }
62760432Shibler remove_process (proc);
62860432Shibler return Qnil;
62960432Shibler }
63060432Shibler
63160432Shibler DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
63260432Shibler "Return the status of PROCESS: a symbol, one of these:\n\
63360432Shibler run -- for a process that is running.\n\
63460432Shibler stop -- for a process stopped but continuable.\n\
63560432Shibler exit -- for a process that has exited.\n\
63660432Shibler signal -- for a process that has got a fatal signal.\n\
63760432Shibler open -- for a network stream connection that is open.\n\
63860432Shibler closed -- for a network stream connection that is closed.\n\
63960432Shibler nil -- if arg is a process name and no such process exists.")
64060432Shibler /* command -- for a command channel opened to Emacs by another process.\n\
64160432Shibler external -- for an i/o channel opened to Emacs by another process.\n\ */
64260432Shibler (proc)
64360432Shibler register Lisp_Object proc;
64460432Shibler {
64560432Shibler register struct Lisp_Process *p;
64660432Shibler proc = Fget_process (proc);
64760432Shibler if (NULL (proc))
64860432Shibler return proc;
64960432Shibler p = XPROCESS (proc);
65060432Shibler if (!NULL (p->raw_status_low))
65160432Shibler update_status (p);
65260432Shibler if (XTYPE (p->status) == Lisp_Cons)
65360432Shibler return XCONS (p->status)->car;
65460432Shibler return p->status;
65560432Shibler }
65660432Shibler
65760432Shibler DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
65860432Shibler 1, 1, 0,
65960432Shibler "Return the exit status of PROCESS or the signal number that killed it.\n\
66060432Shibler If PROCESS has not yet exited or died, return 0.")
66160432Shibler (proc)
66260432Shibler register Lisp_Object proc;
66360432Shibler {
66460432Shibler CHECK_PROCESS (proc, 0);
66560432Shibler if (!NULL (XPROCESS (proc)->raw_status_low))
66660432Shibler update_status (XPROCESS (proc));
66760432Shibler if (XTYPE (XPROCESS (proc)->status) == Lisp_Cons)
66860432Shibler return XCONS (XCONS (XPROCESS (proc)->status)->cdr)->car;
66960432Shibler return make_number (0);
67060432Shibler }
67160432Shibler
67260432Shibler DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
67360432Shibler "Return the process id of PROCESS.\n\
67460432Shibler This is the pid of the Unix process which PROCESS uses or talks to.\n\
67560432Shibler For a network connection, this value is nil.")
67660432Shibler (proc)
67760432Shibler register Lisp_Object proc;
67860432Shibler {
67960432Shibler CHECK_PROCESS (proc, 0);
68060432Shibler return XPROCESS (proc)->pid;
68160432Shibler }
68260432Shibler
68360432Shibler DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
68460432Shibler "Return the name of PROCESS, as a string.\n\
68560432Shibler This is the name of the program invoked in PROCESS,\n\
68660432Shibler possibly modified to make it unique among process names.")
68760432Shibler (proc)
68860432Shibler register Lisp_Object proc;
68960432Shibler {
69060432Shibler CHECK_PROCESS (proc, 0);
69160432Shibler return XPROCESS (proc)->name;
69260432Shibler }
69360432Shibler
69460432Shibler DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
69560432Shibler "Return the command that was executed to start PROCESS.\n\
69660432Shibler This is a list of strings, the first string being the program executed\n\
69760432Shibler and the rest of the strings being the arguments given to it.\n\
69860432Shibler For a non-child channel, this is nil.")
69960432Shibler (proc)
70060432Shibler register Lisp_Object proc;
70160432Shibler {
70260432Shibler CHECK_PROCESS (proc, 0);
70360432Shibler return XPROCESS (proc)->command;
70460432Shibler }
70560432Shibler
70660432Shibler DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
70760432Shibler 2, 2, 0,
70860432Shibler "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
70960432Shibler (proc, buffer)
71060432Shibler register Lisp_Object proc, buffer;
71160432Shibler {
71260432Shibler CHECK_PROCESS (proc, 0);
71360432Shibler if (!NULL (buffer))
71460432Shibler CHECK_BUFFER (buffer, 1);
71560432Shibler XPROCESS (proc)->buffer = buffer;
71660432Shibler return buffer;
71760432Shibler }
71860432Shibler
71960432Shibler DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
72060432Shibler 1, 1, 0,
72160432Shibler "Return the buffer PROCESS is associated with.\n\
72260432Shibler Output from PROCESS is inserted in this buffer\n\
72360432Shibler unless PROCESS has a filter.")
72460432Shibler (proc)
72560432Shibler register Lisp_Object proc;
72660432Shibler {
72760432Shibler CHECK_PROCESS (proc, 0);
72860432Shibler return XPROCESS (proc)->buffer;
72960432Shibler }
73060432Shibler
73160432Shibler DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
73260432Shibler 1, 1, 0,
73360432Shibler "Return the marker for the end of the last output from PROCESS.")
73460432Shibler (proc)
73560432Shibler register Lisp_Object proc;
73660432Shibler {
73760432Shibler CHECK_PROCESS (proc, 0);
73860432Shibler return XPROCESS (proc)->mark;
73960432Shibler }
74060432Shibler
74160432Shibler DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
74260432Shibler 2, 2, 0,
74360432Shibler "Give PROCESS the filter function FILTER; nil means no filter.\n\
74460432Shibler When a process has a filter, each time it does output\n\
74560432Shibler the entire string of output is passed to the filter.\n\
74660432Shibler The filter gets two arguments: the process and the string of output.\n\
74760432Shibler If the process has a filter, its buffer is not used for output.")
74860432Shibler (proc, filter)
74960432Shibler register Lisp_Object proc, filter;
75060432Shibler {
75160432Shibler CHECK_PROCESS (proc, 0);
75260432Shibler XPROCESS (proc)->filter = filter;
75360432Shibler return filter;
75460432Shibler }
75560432Shibler
75660432Shibler DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
75760432Shibler 1, 1, 0,
75860432Shibler "Returns the filter function of PROCESS; nil if none.\n\
75960432Shibler See set-process-filter for more info on filter functions.")
76060432Shibler (proc)
76160432Shibler register Lisp_Object proc;
76260432Shibler {
76360432Shibler CHECK_PROCESS (proc, 0);
76460432Shibler return XPROCESS (proc)->filter;
76560432Shibler }
76660432Shibler
76760432Shibler DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
76860432Shibler 2, 2, 0,
76960432Shibler "Give PROCESS the sentinel SENTINEL; nil for none.\n\
77060432Shibler The sentinel is called as a function when the process changes state.\n\
77160432Shibler It gets two arguments: the process, and a string describing the change.")
77260432Shibler (proc, sentinel)
77360432Shibler register Lisp_Object proc, sentinel;
77460432Shibler {
77560432Shibler CHECK_PROCESS (proc, 0);
77660432Shibler XPROCESS (proc)->sentinel = sentinel;
77760432Shibler return sentinel;
77860432Shibler }
77960432Shibler
78060432Shibler DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
78160432Shibler 1, 1, 0,
78260432Shibler "Return the sentinel of PROCESS; nil if none.\n\
78360432Shibler See set-process-sentinel for more info on sentinels.")
78460432Shibler (proc)
78560432Shibler register Lisp_Object proc;
78660432Shibler {
78760432Shibler CHECK_PROCESS (proc, 0);
78860432Shibler return XPROCESS (proc)->sentinel;
78960432Shibler }
79060432Shibler
79160432Shibler DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
79260432Shibler Sprocess_kill_without_query, 1, 2, 0,
79360432Shibler "Say no query needed if PROCESS is running when Emacs is exited.\n\
79460432Shibler Optional second argument if non-nil says to require a query.\n\
79560432Shibler Value is t if a query was formerly required.")
79660432Shibler (proc, value)
79760432Shibler register Lisp_Object proc, value;
79860432Shibler {
79960432Shibler Lisp_Object tem;
80060432Shibler CHECK_PROCESS (proc, 0);
80160432Shibler tem = XPROCESS (proc)->kill_without_query;
80260432Shibler XPROCESS (proc)->kill_without_query = Fnull (value);
80360432Shibler return Fnull (tem);
80460432Shibler }
80560432Shibler
80660432Shibler Lisp_Object
list_processes_1()80760432Shibler list_processes_1 ()
80860432Shibler {
80960432Shibler register Lisp_Object tail, tem;
81060432Shibler Lisp_Object proc, minspace, tem1;
81160432Shibler register struct buffer *old = current_buffer;
81260432Shibler register struct Lisp_Process *p;
81360432Shibler register int state;
81460432Shibler char tembuf[80];
81560432Shibler
81660432Shibler XFASTINT (minspace) = 1;
81760432Shibler
81860432Shibler set_buffer_internal (XBUFFER (Vstandard_output));
81960432Shibler Fbuffer_flush_undo (Vstandard_output);
82060432Shibler
82160432Shibler current_buffer->truncate_lines = Qt;
82260432Shibler
82360432Shibler write_string ("\
82460432Shibler Proc Status Buffer Command\n\
82560432Shibler ---- ------ ------ -------\n", -1);
82660432Shibler
82760432Shibler for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
82860432Shibler {
82960432Shibler Lisp_Object symbol;
83060432Shibler
83160432Shibler proc = Fcdr (Fcar (tail));
83260432Shibler p = XPROCESS (proc);
83360432Shibler if (NULL (p->childp))
83460432Shibler continue;
83560432Shibler
83660432Shibler Finsert (1, &p->name);
83760432Shibler Findent_to (make_number (13), minspace);
83860432Shibler
83960432Shibler if (!NULL (p->raw_status_low))
84060432Shibler update_status (p);
84160432Shibler symbol = p->status;
84260432Shibler if (XTYPE (p->status) == Lisp_Cons)
84360432Shibler symbol = XCONS (p->status)->car;
84460432Shibler
84560432Shibler if (EQ (symbol, Qsignal))
84660432Shibler {
84760432Shibler Lisp_Object tem;
84860432Shibler tem = Fcar (Fcdr (p->status));
84960432Shibler if (XINT (tem) < NSIG)
85060432Shibler write_string (sys_siglist [XINT (tem)], -1);
85160432Shibler else
85260432Shibler Fprinc (symbol, Qnil);
85360432Shibler }
85460432Shibler else
85560432Shibler Fprinc (symbol, Qnil);
85660432Shibler
85760432Shibler if (EQ (symbol, Qexit))
85860432Shibler {
85960432Shibler Lisp_Object tem;
86060432Shibler tem = Fcar (Fcdr (p->status));
86160432Shibler if (XFASTINT (tem))
86260432Shibler {
86360432Shibler sprintf (tembuf, " %d", XFASTINT (tem));
86460432Shibler write_string (tembuf, -1);
86560432Shibler }
86660432Shibler }
86760432Shibler
86860432Shibler if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
86960432Shibler remove_process (proc);
87060432Shibler
87160432Shibler Findent_to (make_number (22), minspace);
87260432Shibler if (NULL (p->buffer))
87360432Shibler InsStr ("(none)");
87460432Shibler else if (NULL (XBUFFER (p->buffer)->name))
87560432Shibler InsStr ("(Killed)");
87660432Shibler else
87760432Shibler Finsert (1, &XBUFFER (p->buffer)->name);
87860432Shibler
87960432Shibler Findent_to (make_number (37), minspace);
88060432Shibler
88160432Shibler if (NETCONN_P (proc))
88260432Shibler {
88360432Shibler sprintf (tembuf, "(network stream connection to %s)\n",
88460432Shibler XSTRING (p->childp)->data);
88560432Shibler InsStr (tembuf);
88660432Shibler }
88760432Shibler else
88860432Shibler {
88960432Shibler tem = p->command;
89060432Shibler while (1)
89160432Shibler {
89260432Shibler tem1 = Fcar (tem);
89360432Shibler Finsert (1, &tem1);
89460432Shibler tem = Fcdr (tem);
89560432Shibler if (NULL (tem))
89660432Shibler break;
89760432Shibler InsStr (" ");
89860432Shibler }
89960432Shibler InsStr ("\n");
90060432Shibler }
90160432Shibler }
90260432Shibler
90360432Shibler return Qnil;
90460432Shibler }
90560432Shibler
90660432Shibler DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",
90760432Shibler "Display a list of all processes.\n\
90860432Shibler \(Any processes listed as Exited or Signaled are actually eliminated\n\
90960432Shibler after the listing is made.)")
91060432Shibler ()
91160432Shibler {
91260432Shibler internal_with_output_to_temp_buffer ("*Process List*",
91360432Shibler list_processes_1, Qnil);
91460432Shibler return Qnil;
91560432Shibler }
91660432Shibler
91760432Shibler DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
91860432Shibler "Return a list of all processes.")
91960432Shibler ()
92060432Shibler {
92160432Shibler return Fmapcar (Qcdr, Vprocess_alist);
92260432Shibler }
92360432Shibler
92460432Shibler DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
92560432Shibler "Start a program in a subprocess. Return the process object for it.\n\
92660432Shibler Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
92760432Shibler NAME is name for process. It is modified if necessary to make it unique.\n\
92860432Shibler BUFFER is the buffer or (buffer-name) to associate with the process.\n\
92960432Shibler Process output goes at end of that buffer, unless you specify\n\
93060432Shibler an output stream or filter function to handle the output.\n\
93160432Shibler BUFFER may be also nil, meaning that this process is not associated\n\
93260432Shibler with any buffer\n\
93360432Shibler Third arg is program file name. It is searched for as in the shell.\n\
93460432Shibler Remaining arguments are strings to give program as arguments.")
93560432Shibler (nargs, args)
93660432Shibler int nargs;
93760432Shibler register Lisp_Object *args;
93860432Shibler {
93960432Shibler Lisp_Object buffer, name, program, proc, tem;
94060432Shibler register unsigned char **new_argv;
94160432Shibler register int i;
94260432Shibler
94360432Shibler buffer = args[1];
94460432Shibler if (!NULL (buffer))
94560432Shibler buffer = Fget_buffer_create (buffer);
94660432Shibler
94760432Shibler name = args[0];
94860432Shibler CHECK_STRING (name, 0);
94960432Shibler
95060432Shibler program = args[2];
95160432Shibler
95260432Shibler CHECK_STRING (program, 2);
95360432Shibler
95460432Shibler new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
95560432Shibler
95660432Shibler for (i = 3; i < nargs; i++)
95760432Shibler {
95860432Shibler tem = args[i];
95960432Shibler CHECK_STRING (tem, i);
96060432Shibler new_argv[i - 2] = XSTRING (tem)->data;
96160432Shibler }
96260432Shibler new_argv[i - 2] = 0;
96360432Shibler new_argv[0] = XSTRING (program)->data;
96460432Shibler
96560432Shibler /* If program file name is not absolute, search our path for it */
96660432Shibler if (new_argv[0][0] != '/')
96760432Shibler {
96860432Shibler tem = Qnil;
96960432Shibler openp (Vexec_path, program, "", &tem, 1);
97060432Shibler if (NULL (tem))
97160432Shibler report_file_error ("Searching for program", Fcons (program, Qnil));
97260432Shibler new_argv[0] = XSTRING (tem)->data;
97360432Shibler }
97460432Shibler
97560432Shibler proc = make_process (name);
97660432Shibler
97760432Shibler XPROCESS (proc)->childp = Qt;
97860432Shibler XPROCESS (proc)->command_channel_p = Qnil;
97960432Shibler XPROCESS (proc)->buffer = buffer;
98060432Shibler XPROCESS (proc)->sentinel = Qnil;
98160432Shibler XPROCESS (proc)->filter = Qnil;
98260432Shibler XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
98360432Shibler
98460432Shibler create_process (proc, new_argv);
98560432Shibler
98660432Shibler return proc;
98760432Shibler }
98860432Shibler
create_process_1(signo)98960432Shibler create_process_1 (signo)
99060432Shibler int signo;
99160432Shibler {
99260432Shibler #ifdef USG
99360432Shibler /* USG systems forget handlers when they are used;
99460432Shibler must reestablish each time */
99560432Shibler signal (signo, create_process_1);
99660432Shibler #endif /* USG */
99760432Shibler }
99860432Shibler
99960432Shibler #if 0 /* This doesn't work; see the note before sigchld_handler. */
100060432Shibler #ifdef USG
100160432Shibler #ifdef SIGCHLD
100260432Shibler /* Mimic blocking of signals on system V, which doesn't really have it. */
100360432Shibler
100460432Shibler /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
100560432Shibler int sigchld_deferred;
100660432Shibler
100760432Shibler create_process_sigchld ()
100860432Shibler {
100960432Shibler signal (SIGCHLD, create_process_sigchld);
101060432Shibler
101160432Shibler sigchld_deferred = 1;
101260432Shibler }
101360432Shibler #endif
101460432Shibler #endif
101560432Shibler #endif
101660432Shibler
create_process(process,new_argv)101760432Shibler create_process (process, new_argv)
101860432Shibler Lisp_Object process;
101960432Shibler char **new_argv;
102060432Shibler {
102160432Shibler int pid, inchannel, outchannel, forkin, forkout;
102260432Shibler int sv[2];
102360432Shibler #ifdef SIGCHLD
102460432Shibler int (*sigchld)();
102560432Shibler #endif
102660432Shibler char **env;
102760432Shibler int pty_flag = 0;
102860432Shibler extern char **environ;
102960432Shibler
103060432Shibler #ifdef MAINTAIN_ENVIRONMENT
103160432Shibler env = (char **) alloca (size_of_current_environ ());
103260432Shibler get_current_environ (env);
103360432Shibler #else
103460432Shibler env = environ;
103560432Shibler #endif /* MAINTAIN_ENVIRONMENT */
103660432Shibler
103760432Shibler inchannel = outchannel = -1;
103860432Shibler
103960432Shibler #ifdef HAVE_PTYS
104060432Shibler if (EQ (Vprocess_connection_type, Qt))
104160432Shibler outchannel = inchannel = allocate_pty ();
104260432Shibler
104360432Shibler if (inchannel >= 0)
104460432Shibler {
104560432Shibler #ifndef USG
104660432Shibler /* On USG systems it does not work to open
104760432Shibler the pty's tty here and then close and reopen it in the child. */
104860432Shibler forkout = forkin = open (pty_name, O_RDWR, 0);
104960432Shibler if (forkin < 0)
105060432Shibler report_file_error ("Opening pty", Qnil);
105160432Shibler #else
105260432Shibler forkin = forkout = -1;
105360432Shibler #endif
105460432Shibler pty_flag = 1;
105560432Shibler }
105660432Shibler else
105760432Shibler #endif /* HAVE_PTYS */
105860432Shibler #ifdef SKTPAIR
105960432Shibler {
106060432Shibler if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0)
106160432Shibler report_file_error ("Opening socketpair", Qnil);
106260432Shibler outchannel = inchannel = sv[0];
106360432Shibler forkout = forkin = sv[1];
106460432Shibler }
106560432Shibler #else /* not SKTPAIR */
106660432Shibler {
106760432Shibler pipe (sv);
106860432Shibler inchannel = sv[0];
106960432Shibler forkout = sv[1];
107060432Shibler pipe (sv);
107160432Shibler outchannel = sv[1];
107260432Shibler forkin = sv[0];
107360432Shibler }
107460432Shibler #endif /* not SKTPAIR */
107560432Shibler
107660432Shibler #if 0
107760432Shibler /* Replaced by close_process_descs */
107860432Shibler set_exclusive_use (inchannel);
107960432Shibler set_exclusive_use (outchannel);
108060432Shibler #endif
108160432Shibler
108260432Shibler /* Stride people say it's a mystery why this is needed
108360432Shibler as well as the O_NDELAY, but that it fails without this. */
108460432Shibler #ifdef STRIDE
108560432Shibler {
108660432Shibler int one = 1;
108760432Shibler ioctl (inchannel, FIONBIO, &one);
108860432Shibler }
108960432Shibler #endif
109060432Shibler
109160432Shibler #ifdef O_NONBLOCK
109260432Shibler fcntl (inchannel, F_SETFL, O_NONBLOCK);
109360432Shibler #else
109460432Shibler #ifdef O_NDELAY
109560432Shibler fcntl (inchannel, F_SETFL, O_NDELAY);
109660432Shibler #endif
109760432Shibler #endif
109860432Shibler
109960432Shibler /* Record this as an active process, with its channels.
110060432Shibler As a result, child_setup will close Emacs's side of the pipes. */
110160432Shibler chan_process[inchannel] = process;
110260432Shibler XFASTINT (XPROCESS (process)->infd) = inchannel;
110360432Shibler XFASTINT (XPROCESS (process)->outfd) = outchannel;
110460432Shibler XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
110560432Shibler XPROCESS (process)->status = Qrun;
110660432Shibler
110760432Shibler /* Delay interrupts until we have a chance to store
110860432Shibler the new fork's pid in its process structure */
110960432Shibler #ifdef SIGCHLD
111060432Shibler #ifdef BSD4_1
111160432Shibler sighold (SIGCHLD);
111260432Shibler #else /* not BSD4_1 */
111360432Shibler #ifdef HPUX
111460432Shibler sigsetmask (1 << (SIGCHLD - 1));
111560432Shibler #else /* not HPUX */
111660432Shibler #if defined (BSD) || defined (UNIPLUS)
111760432Shibler sigsetmask (1 << (SIGCHLD - 1));
111860432Shibler #else /* ordinary USG */
111960432Shibler #if 0
112060432Shibler sigchld_deferred = 0;
112160432Shibler sigchld = (int (*)()) signal (SIGCHLD, create_process_sigchld);
112260432Shibler #endif
112360432Shibler #endif /* ordinary USG */
112460432Shibler #endif /* not HPUX */
112560432Shibler #endif /* not BSD4_1 */
112660432Shibler #endif /* SIGCHLD */
112760432Shibler
112860432Shibler /* Until we store the proper pid, enable sigchld_handler
112960432Shibler to recognize an unknown pid as standing for this process. */
113060432Shibler XSETINT (XPROCESS (process)->pid, -1);
113160432Shibler
113260432Shibler {
113360432Shibler /* child_setup must clobber environ on systems with true vfork.
113460432Shibler Protect it from permanent change. */
113560432Shibler char **save_environ = environ;
113660432Shibler
113760432Shibler pid = vfork ();
113860432Shibler if (pid == 0)
113960432Shibler {
114060432Shibler int xforkin = forkin;
114160432Shibler int xforkout = forkout;
114260432Shibler
114360432Shibler #if 0 /* This was probably a mistake--it duplicates code later on,
114460432Shibler but fails to handle all the cases. */
114560432Shibler /* Make SIGCHLD work again in the child. */
114660432Shibler sigsetmask (0);
114760432Shibler #endif
114860432Shibler
114960432Shibler /* Make the pty be the controlling terminal of the process. */
115060432Shibler #ifdef HAVE_PTYS
115160432Shibler /* First, disconnect its current controlling terminal. */
115260432Shibler #ifdef HAVE_SETSID
115360432Shibler setsid ();
1154*60433Shibler #ifdef TIOCSCTTY
1155*60433Shibler /* Make the pty's terminal the controlling terminal. */
1156*60433Shibler if (pty_flag && (ioctl (xforkin, TIOCSCTTY, 0) < 0))
1157*60433Shibler abort ();
1158*60433Shibler #endif
115960432Shibler #else /* not HAVE_SETSID */
116060432Shibler #ifdef USG
116160432Shibler /* It's very important to call setpgrp() here and no time
116260432Shibler afterwards. Otherwise, we lose our controlling tty which
116360432Shibler is set when we open the pty. */
116460432Shibler setpgrp ();
116560432Shibler #endif /* USG */
116660432Shibler #endif /* not HAVE_SETSID */
116760432Shibler #ifdef TIOCNOTTY
116860432Shibler /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
116960432Shibler can do TIOCSPGRP only to the process's controlling tty. */
117060432Shibler if (pty_flag)
117160432Shibler {
117260432Shibler /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
117360432Shibler I can't test it since I don't have 4.3. */
117460432Shibler int j = open ("/dev/tty", O_RDWR, 0);
117560432Shibler ioctl (j, TIOCNOTTY, 0);
117660432Shibler close (j);
117760432Shibler #ifndef USG
117860432Shibler /* In order to get a controlling terminal on some versions
117960432Shibler of BSD, it is necessary to put the process in pgrp 0
118060432Shibler before it opens the terminal. */
118160432Shibler setpgrp (0, 0);
118260432Shibler #endif
118360432Shibler }
118460432Shibler #endif /* TIOCNOTTY */
118560432Shibler
118660432Shibler #if !defined (RTU) && !defined (UNIPLUS)
118760432Shibler /*** There is a suggestion that this ought to be a
118860432Shibler conditional on TIOCSPGRP. */
118960432Shibler /* Now close the pty (if we had it open) and reopen it.
119060432Shibler This makes the pty the controlling terminal of the subprocess. */
119160432Shibler if (pty_flag)
119260432Shibler {
119360432Shibler /* I wonder if close (open (pty_name, ...)) would work? */
119460432Shibler if (xforkin >= 0)
119560432Shibler close (xforkin);
119660432Shibler xforkout = xforkin = open (pty_name, O_RDWR, 0);
119760432Shibler
119860432Shibler if (xforkin < 0)
119960432Shibler abort ();
120060432Shibler }
120160432Shibler #endif /* not UNIPLUS and not RTU */
120260432Shibler #ifdef SETUP_SLAVE_PTY
120360432Shibler SETUP_SLAVE_PTY;
120460432Shibler #endif /* SETUP_SLAVE_PTY */
120560432Shibler #ifdef AIX
120660432Shibler /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
120760432Shibler Now reenable it in the child, so it will die when we want it to. */
120860432Shibler if (pty_flag)
120960432Shibler signal (SIGHUP, SIG_DFL);
121060432Shibler #endif
121160432Shibler #endif /* HAVE_PTYS */
121260432Shibler #ifdef SIGCHLD
121360432Shibler #ifdef BSD4_1
121460432Shibler sigrelse (SIGCHLD);
121560432Shibler #else /* not BSD4_1 */
121660432Shibler #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
121760432Shibler sigsetmask (0);
121860432Shibler #else /* ordinary USG */
121960432Shibler signal (SIGCHLD, sigchld);
122060432Shibler #endif /* ordinary USG */
122160432Shibler #endif /* not BSD4_1 */
122260432Shibler #endif /* SIGCHLD */
122360432Shibler child_setup_tty (xforkout);
122460432Shibler child_setup (xforkin, xforkout, xforkout, new_argv, env);
122560432Shibler }
122660432Shibler environ = save_environ;
122760432Shibler }
122860432Shibler
122960432Shibler if (pid < 0)
123060432Shibler {
123160432Shibler remove_process (process);
123260432Shibler report_file_error ("Doing vfork", Qnil);
123360432Shibler }
123460432Shibler
123560432Shibler XFASTINT (XPROCESS (process)->pid) = pid;
123660432Shibler
123760432Shibler FD_SET (inchannel, &input_wait_mask);
123860432Shibler
123960432Shibler /* If the subfork execv fails, and it exits,
124060432Shibler this close hangs. I don't know why.
124160432Shibler So have an interrupt jar it loose. */
124260432Shibler stop_polling ();
124360432Shibler signal (SIGALRM, create_process_1);
124460432Shibler alarm (1);
124560432Shibler if (forkin >= 0)
124660432Shibler close (forkin);
124760432Shibler alarm (0);
124860432Shibler start_polling ();
124960432Shibler if (forkin != forkout && forkout >= 0)
125060432Shibler close (forkout);
125160432Shibler
125260432Shibler #ifdef SIGCHLD
125360432Shibler #ifdef BSD4_1
125460432Shibler sigrelse (SIGCHLD);
125560432Shibler #else /* not BSD4_1 */
125660432Shibler #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
125760432Shibler sigsetmask (0);
125860432Shibler #else /* ordinary USG */
125960432Shibler #if 0
126060432Shibler signal (SIGCHLD, sigchld);
126160432Shibler /* Now really handle any of these signals
126260432Shibler that came in during this function. */
126360432Shibler if (sigchld_deferred)
126460432Shibler kill (getpid (), SIGCHLD);
126560432Shibler #endif
126660432Shibler #endif /* ordinary USG */
126760432Shibler #endif /* not BSD4_1 */
126860432Shibler #endif /* SIGCHLD */
126960432Shibler }
127060432Shibler
127160432Shibler #ifdef HAVE_SOCKETS
127260432Shibler
127360432Shibler /* open a TCP network connection to a given HOST/SERVICE. Treated
127460432Shibler exactly like a normal process when reading and writing. Only
127560432Shibler differences are in status display and process deletion. A network
127660432Shibler connection has no PID; you cannot signal it. All you can do is
127760432Shibler deactivate and close it via delete-process */
127860432Shibler
127960432Shibler DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,
128060432Shibler 4, 4, 0,
128160432Shibler "Open a TCP connection for a service to a host.\n\
128260432Shibler Returns a subprocess-object to represent the connection.\n\
128360432Shibler Input and output work as for subprocesses; `delete-process' closes it.\n\
128460432Shibler Args are NAME BUFFER HOST SERVICE.\n\
128560432Shibler NAME is name for process. It is modified if necessary to make it unique.\n\
128660432Shibler BUFFER is the buffer (or buffer-name) to associate with the process.\n\
128760432Shibler Process output goes at end of that buffer, unless you specify\n\
128860432Shibler an output stream or filter function to handle the output.\n\
128960432Shibler BUFFER may be also nil, meaning that this process is not associated\n\
129060432Shibler with any buffer\n\
129160432Shibler Third arg is name of the host to connect to.\n\
129260432Shibler Fourth arg SERVICE is name of the service desired, or an integer\n\
129360432Shibler specifying a port number to connect to.")
129460432Shibler (name, buffer, host, service)
129560432Shibler Lisp_Object name, buffer, host, service;
129660432Shibler {
129760432Shibler Lisp_Object proc;
129860432Shibler register int i;
129960432Shibler struct sockaddr_in address;
130060432Shibler struct servent *svc_info;
130160432Shibler struct hostent *host_info;
130260432Shibler int s, outch, inch;
130360432Shibler char errstring[80];
130460432Shibler int port;
130560432Shibler struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
130660432Shibler
130760432Shibler GCPRO4 (name, buffer, host, service);
130860432Shibler CHECK_STRING (name, 0);
130960432Shibler CHECK_STRING (host, 0);
131060432Shibler if (XTYPE(service) == Lisp_Int)
131160432Shibler port = htons ((unsigned short) XINT (service));
131260432Shibler else
131360432Shibler {
131460432Shibler CHECK_STRING (service, 0);
131560432Shibler svc_info = getservbyname (XSTRING (service)->data, "tcp");
131660432Shibler if (svc_info == 0)
131760432Shibler error ("Unknown service \"%s\"", XSTRING (service)->data);
131860432Shibler port = svc_info->s_port;
131960432Shibler }
132060432Shibler
132160432Shibler host_info = gethostbyname (XSTRING (host)->data);
132260432Shibler if (host_info == 0)
132360432Shibler error ("Unknown host \"%s\"", XSTRING(host)->data);
132460432Shibler
132560432Shibler bzero (&address, sizeof address);
132660432Shibler bcopy (host_info->h_addr, (char *) &address.sin_addr, host_info->h_length);
132760432Shibler address.sin_family = host_info->h_addrtype;
132860432Shibler address.sin_port = port;
132960432Shibler
133060432Shibler s = socket (host_info->h_addrtype, SOCK_STREAM, 0);
133160432Shibler if (s < 0)
133260432Shibler report_file_error ("error creating socket", Fcons (name, Qnil));
133360432Shibler
133460432Shibler if (connect (s, &address, sizeof address) == -1)
133560432Shibler {
133660432Shibler close (s);
133760432Shibler error ("Host \"%s\" not responding", XSTRING (host)->data);
133860432Shibler }
133960432Shibler
134060432Shibler inch = s;
134160432Shibler outch = dup (s);
134260432Shibler if (outch < 0)
134360432Shibler report_file_error ("error duplicating socket", Fcons (name, Qnil));
134460432Shibler
134560432Shibler if (!NULL (buffer))
134660432Shibler buffer = Fget_buffer_create (buffer);
134760432Shibler proc = make_process (name);
134860432Shibler
134960432Shibler chan_process[inch] = proc;
135060432Shibler
135160432Shibler #ifdef O_NONBLOCK
135260432Shibler fcntl (inch, F_SETFL, O_NONBLOCK);
135360432Shibler #else
135460432Shibler #ifdef O_NDELAY
135560432Shibler fcntl (inch, F_SETFL, O_NDELAY);
135660432Shibler #endif
135760432Shibler #endif
135860432Shibler
135960432Shibler XPROCESS (proc)->childp = host;
136060432Shibler XPROCESS (proc)->command_channel_p = Qnil;
136160432Shibler XPROCESS (proc)->buffer = buffer;
136260432Shibler XPROCESS (proc)->sentinel = Qnil;
136360432Shibler XPROCESS (proc)->filter = Qnil;
136460432Shibler XPROCESS (proc)->command = Qnil;
136560432Shibler XPROCESS (proc)->pid = Qnil;
136660432Shibler XPROCESS (proc)->kill_without_query = Qt;
136760432Shibler XFASTINT (XPROCESS (proc)->infd) = s;
136860432Shibler XFASTINT (XPROCESS (proc)->outfd) = outch;
136960432Shibler XPROCESS (proc)->status = Qrun;
137060432Shibler FD_SET (inch, &input_wait_mask);
137160432Shibler
137260432Shibler UNGCPRO;
137360432Shibler return proc;
137460432Shibler }
137560432Shibler #endif /* HAVE_SOCKETS */
137660432Shibler
deactivate_process(proc)137760432Shibler deactivate_process (proc)
137860432Shibler Lisp_Object proc;
137960432Shibler {
138060432Shibler register int inchannel, outchannel;
138160432Shibler register struct Lisp_Process *p = XPROCESS (proc);
138260432Shibler
138360432Shibler inchannel = XFASTINT (p->infd);
138460432Shibler outchannel = XFASTINT (p->outfd);
138560432Shibler
138660432Shibler if (inchannel)
138760432Shibler {
138860432Shibler /* Beware SIGCHLD hereabouts. */
138960432Shibler flush_pending_output (inchannel);
139060432Shibler close (inchannel);
139160432Shibler if (outchannel && outchannel != inchannel)
139260432Shibler close (outchannel);
139360432Shibler
139460432Shibler XFASTINT (p->infd) = 0;
139560432Shibler XFASTINT (p->outfd) = 0;
139660432Shibler chan_process[inchannel] = Qnil;
139760432Shibler FD_CLR (inchannel, &input_wait_mask);
139860432Shibler }
139960432Shibler }
140060432Shibler
140160432Shibler /* Close all descriptors currently in use for communication
140260432Shibler with subprocess. This is used in a newly-forked subprocess
140360432Shibler to get rid of irrelevant descriptors. */
140460432Shibler
close_process_descs()140560432Shibler close_process_descs ()
140660432Shibler {
140760432Shibler int i;
140860432Shibler for (i = 0; i < MAXDESC; i++)
140960432Shibler {
141060432Shibler Lisp_Object process;
141160432Shibler process = chan_process[i];
141260432Shibler if (!NULL (process))
141360432Shibler {
141460432Shibler int in = XFASTINT (XPROCESS (process)->infd);
141560432Shibler int out = XFASTINT (XPROCESS (process)->outfd);
141660432Shibler close (in);
141760432Shibler if (in != out)
141860432Shibler close (out);
141960432Shibler }
142060432Shibler }
142160432Shibler }
142260432Shibler
142360432Shibler DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
142460432Shibler 0, 1, 0,
142560432Shibler "Allow any pending output from subprocesses to be read by Emacs.\n\
142660432Shibler It is read into the process' buffers or given to their filter functions.\n\
142760432Shibler Non-nil arg PROCESS means do not return until some output has been received\n\
142860432Shibler from PROCESS.")
142960432Shibler (proc)
143060432Shibler register Lisp_Object proc;
143160432Shibler {
143260432Shibler if (NULL (proc))
143360432Shibler wait_reading_process_input (-1, 0, 0);
143460432Shibler else
143560432Shibler {
143660432Shibler proc = get_process (proc);
143760432Shibler wait_reading_process_input (0, XPROCESS (proc), 0);
143860432Shibler }
143960432Shibler return Qnil;
144060432Shibler }
144160432Shibler
144260432Shibler /* This variable is different from waiting_for_input in keyboard.c.
144360432Shibler It is used to communicate to a lisp process-filter/sentinel (via the
144460432Shibler function Fwaiting_for_user_input_p below) whether emacs was waiting
144560432Shibler for user-input when that process-filter was called.
144660432Shibler waiting_for_input cannot be used as that is by definition 0 when
144760432Shibler lisp code is being evalled */
144860432Shibler static int waiting_for_user_input_p;
144960432Shibler
145060432Shibler /* Read and dispose of subprocess output
145160432Shibler while waiting for timeout to elapse and/or keyboard input to be available.
145260432Shibler
145360432Shibler time_limit is the timeout in seconds, or zero for no limit.
145460432Shibler -1 means gobble data available immediately but don't wait for any.
145560432Shibler
145660432Shibler read_kbd is 1 to return when input is available.
145760432Shibler -1 means caller will actually read the input.
145860432Shibler A pointer to a struct Lisp_Process means wait until
145960432Shibler something arrives from that process.
146060432Shibler
146160432Shibler do_display means redisplay should be done to show
146260432Shibler subprocess output that arrives. */
146360432Shibler
wait_reading_process_input(time_limit,read_kbd,do_display)146460432Shibler wait_reading_process_input (time_limit, read_kbd, do_display)
146560432Shibler int time_limit, read_kbd, do_display;
146660432Shibler {
146760432Shibler register int channel, nfds, m;
146860432Shibler SELECT_TYPE Available;
146960432Shibler SELECT_TYPE Exception;
147060432Shibler int xerrno;
147160432Shibler Lisp_Object proc;
147260432Shibler #ifdef HAVE_TIMEVAL
147360432Shibler struct timeval timeout, end_time, garbage;
147460432Shibler #else
147560432Shibler long timeout, end_time, temp;
147660432Shibler #endif /* not HAVE_TIMEVAL */
147760432Shibler SELECT_TYPE Atemp;
147860432Shibler int wait_channel = 0;
147960432Shibler struct Lisp_Process *wait_proc = 0;
148060432Shibler extern kbd_count;
148160432Shibler
148260432Shibler /* Detect when read_kbd is really the address of a Lisp_Process. */
148360432Shibler if (read_kbd > 10 || read_kbd < -1)
148460432Shibler {
148560432Shibler wait_proc = (struct Lisp_Process *) read_kbd;
148660432Shibler wait_channel = XFASTINT (wait_proc->infd);
148760432Shibler read_kbd = 0;
148860432Shibler }
148960432Shibler waiting_for_user_input_p = read_kbd;
149060432Shibler
149160432Shibler /* Since we may need to wait several times,
149260432Shibler compute the absolute time to return at. */
149360432Shibler if (time_limit)
149460432Shibler {
149560432Shibler #ifdef HAVE_TIMEVAL
149660432Shibler gettimeofday (&end_time, &garbage);
149760432Shibler end_time.tv_sec += time_limit;
149860432Shibler #else /* not HAVE_TIMEVAL */
149960432Shibler time (&end_time);
150060432Shibler end_time += time_limit;
150160432Shibler #endif /* not HAVE_TIMEVAL */
150260432Shibler }
150360432Shibler
150460432Shibler #if 0 /* Select emulator claims to preserve alarms.
150560432Shibler And there are many ways to get out of this function by longjmp. */
150660432Shibler /* Turn off periodic alarms (in case they are in use)
150760432Shibler because the select emulator uses alarms. */
150860432Shibler stop_polling ();
150960432Shibler #endif
151060432Shibler
151160432Shibler while (1)
151260432Shibler {
151360432Shibler /* If calling from keyboard input, do not quit
151460432Shibler since we want to return C-g as an input character.
151560432Shibler Otherwise, do pending quit if requested. */
151660432Shibler if (read_kbd >= 0)
151760432Shibler {
151860432Shibler #if 0
151960432Shibler /* This is the same condition tested by QUIT.
152060432Shibler We need to resume polling if we are going to quit. */
152160432Shibler if (!NULL (Vquit_flag) && NULL (Vinhibit_quit))
152260432Shibler {
152360432Shibler start_polling ();
152460432Shibler QUIT;
152560432Shibler }
152660432Shibler #endif
152760432Shibler QUIT;
152860432Shibler }
152960432Shibler
153060432Shibler /* If status of something has changed, and no input is available,
153160432Shibler notify the user of the change right away */
153260432Shibler if (update_tick != process_tick && do_display)
153360432Shibler {
153460432Shibler Atemp = input_wait_mask;
153560432Shibler #ifdef HAVE_TIMEVAL
153660432Shibler timeout.tv_sec=0; timeout.tv_usec=0;
153760432Shibler #else /* not HAVE_TIMEVAL */
153860432Shibler timeout = 0;
153960432Shibler #endif /* not HAVE_TIMEVAL */
154060432Shibler if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0)
154160432Shibler status_notify ();
154260432Shibler }
154360432Shibler
154460432Shibler /* Don't wait for output from a non-running process. */
154560432Shibler if (wait_proc != 0 && !NULL (wait_proc->raw_status_low))
154660432Shibler update_status (wait_proc);
154760432Shibler if (wait_proc != 0
154860432Shibler && ! EQ (wait_proc->status, Qrun))
154960432Shibler break;
155060432Shibler
155160432Shibler if (fix_screen_hook)
155260432Shibler (*fix_screen_hook) ();
155360432Shibler
155460432Shibler /* Compute time from now till when time limit is up */
155560432Shibler /* Exit if already run out */
155660432Shibler if (time_limit == -1)
155760432Shibler {
155860432Shibler /* -1 specified for timeout means
155960432Shibler gobble output available now
156060432Shibler but don't wait at all. */
156160432Shibler #ifdef HAVE_TIMEVAL
156260432Shibler timeout.tv_sec = 0;
156360432Shibler timeout.tv_usec = 0;
156460432Shibler #else
156560432Shibler timeout = 0;
156660432Shibler #endif /* not HAVE_TIMEVAL */
156760432Shibler }
156860432Shibler else if (time_limit)
156960432Shibler {
157060432Shibler #ifdef HAVE_TIMEVAL
157160432Shibler gettimeofday (&timeout, &garbage);
157260432Shibler timeout.tv_sec = end_time.tv_sec - timeout.tv_sec;
157360432Shibler timeout.tv_usec = end_time.tv_usec - timeout.tv_usec;
157460432Shibler if (timeout.tv_usec < 0)
157560432Shibler timeout.tv_usec += 1000000,
157660432Shibler timeout.tv_sec--;
157760432Shibler if (timeout.tv_sec < 0)
157860432Shibler break;
157960432Shibler #else /* not HAVE_TIMEVAL */
158060432Shibler time (&temp);
158160432Shibler timeout = end_time - temp;
158260432Shibler if (timeout < 0)
158360432Shibler break;
158460432Shibler #endif /* not HAVE_TIMEVAL */
158560432Shibler }
158660432Shibler else
158760432Shibler {
158860432Shibler #ifdef HAVE_TIMEVAL
158960432Shibler /* If no real timeout, loop sleeping with a big timeout
159060432Shibler so that input interrupt can wake us up by zeroing it */
159160432Shibler timeout.tv_sec = 100;
159260432Shibler timeout.tv_usec = 0;
159360432Shibler #else /* not HAVE_TIMEVAL */
159460432Shibler timeout = 100000; /* 100000 recognized by the select emulator */
159560432Shibler #endif /* not HAVE_TIMEVAL */
159660432Shibler }
159760432Shibler
159860432Shibler /* Cause quitting and alarm signals to take immediate action,
159960432Shibler and cause input available signals to zero out timeout */
160060432Shibler if (read_kbd < 0)
160160432Shibler set_waiting_for_input (&timeout);
160260432Shibler
160360432Shibler /* Wait till there is something to do */
160460432Shibler
160560432Shibler Available = Exception = input_wait_mask;
160660432Shibler if (!read_kbd)
160760432Shibler FD_CLR (0, &Available);
160860432Shibler
160960432Shibler if (read_kbd && kbd_count)
161060432Shibler nfds = 0;
161160432Shibler else
161260432Shibler #ifdef IBMRTAIX
161360432Shibler nfds = select (MAXDESC, &Available, 0, 0, &timeout);
161460432Shibler #else
161560432Shibler #ifdef HPUX
161660432Shibler nfds = select (MAXDESC, &Available, 0, 0, &timeout);
161760432Shibler #else
161860432Shibler nfds = select (MAXDESC, &Available, 0, &Exception, &timeout);
161960432Shibler #endif
162060432Shibler #endif
162160432Shibler xerrno = errno;
162260432Shibler
162360432Shibler if (fix_screen_hook)
162460432Shibler (*fix_screen_hook) ();
162560432Shibler
162660432Shibler /* Make C-g and alarm signals set flags again */
162760432Shibler clear_waiting_for_input ();
162860432Shibler
162960432Shibler /* If we woke up due to SIGWINCH, actually change size now. */
163060432Shibler do_pending_window_change ();
163160432Shibler
163260432Shibler if (time_limit && nfds == 0) /* timeout elapsed */
163360432Shibler break;
163460432Shibler if (nfds < 0)
163560432Shibler {
163660432Shibler if (xerrno == EINTR)
163760432Shibler FD_ZERO (&Available);
163860432Shibler #ifdef ALLIANT
163960432Shibler /* This happens for no known reason on ALLIANT.
164060432Shibler I am guessing that this is the right response. -- RMS. */
164160432Shibler else if (xerrno == EFAULT)
164260432Shibler FD_ZERO (&Available);
164360432Shibler #endif
164460432Shibler else if (xerrno == EBADF)
164560432Shibler #ifdef AIX
164660432Shibler /* AIX will return EBADF on a call to select involving a ptc if the
164760432Shibler associated pts isn't open. Since this will only happen just as
164860432Shibler a child is dying, just ignore the situation -- SIGCHLD will come
164960432Shibler along quite quickly, and after cleanup the ptc will no longer be
165060432Shibler checked, so this error will stop recurring. */
165160432Shibler FD_ZERO (&Available); /* Cannot depend on values returned. */
165260432Shibler #else /* not AIX */
165360432Shibler abort ();
165460432Shibler #endif /* not AIX */
165560432Shibler else
165660432Shibler error("select error: %s", sys_errlist[xerrno]);
165760432Shibler }
165860432Shibler #ifdef sun
165960432Shibler else if (nfds > 0 && FD_ISSET (0, &Available) && interrupt_input)
166060432Shibler /* System sometimes fails to deliver SIGIO. */
166160432Shibler kill (getpid (), SIGIO);
166260432Shibler #endif
166360432Shibler
166460432Shibler /* Check for keyboard input */
166560432Shibler /* If there is any, return immediately
166660432Shibler to give it higher priority than subprocesses */
166760432Shibler
166860432Shibler if (read_kbd && detect_input_pending ())
166960432Shibler break;
167060432Shibler
167160432Shibler #ifdef vipc
167260432Shibler /* Check for connection from other process */
167360432Shibler
167460432Shibler if (FD_ISSET (comm_server, &Available))
167560432Shibler {
167660432Shibler FD_CLR (comm_server, &Available);
167760432Shibler create_commchan ();
167860432Shibler }
167960432Shibler #endif vipc
168060432Shibler
168160432Shibler /* Check for data from a process or a command channel */
168260432Shibler
168360432Shibler for (channel = 3; channel < MAXDESC; channel++)
168460432Shibler {
168560432Shibler if (FD_ISSET (channel, &Available))
168660432Shibler {
168760432Shibler int nread;
168860432Shibler
168960432Shibler FD_CLR (channel, &Available);
169060432Shibler /* If waiting for this channel,
169160432Shibler arrange to return as soon as no more input
169260432Shibler to be processed. No more waiting. */
169360432Shibler if (wait_channel == channel)
169460432Shibler {
169560432Shibler wait_channel = 0;
169660432Shibler time_limit = -1;
169760432Shibler }
169860432Shibler proc = chan_process[channel];
169960432Shibler if (NULL (proc))
170060432Shibler continue;
170160432Shibler
170260432Shibler #ifdef vipc
170360432Shibler /* It's a command channel */
170460432Shibler if (!NULL (XPROCESS (proc)->command_channel_p))
170560432Shibler {
170660432Shibler ProcessCommChan (channel, proc);
170760432Shibler if (NULL (XPROCESS (proc)->command_channel_p))
170860432Shibler {
170960432Shibler /* It has ceased to be a command channel! */
171060432Shibler int bytes_available;
171160432Shibler if (ioctl (channel, FIONREAD, &bytes_available) < 0)
171260432Shibler bytes_available = 0;
171360432Shibler if (bytes_available)
171460432Shibler FD_SET (channel, &Available);
171560432Shibler }
171660432Shibler continue;
171760432Shibler }
171860432Shibler #endif vipc
171960432Shibler
172060432Shibler /* Read data from the process, starting with our
172160432Shibler buffered-ahead character if we have one. */
172260432Shibler
172360432Shibler nread = read_process_output (proc, channel);
172460432Shibler if (nread > 0)
172560432Shibler {
172660432Shibler /* Since read_process_output can run a filter,
172760432Shibler which can call accept-process-output,
172860432Shibler don't try to read from any other processes
172960432Shibler before doing the select again. */
173060432Shibler FD_ZERO (&Available);
173160432Shibler
173260432Shibler if (do_display)
173360432Shibler redisplay_preserve_echo_area ();
173460432Shibler }
173560432Shibler #ifdef EWOULDBLOCK
173660432Shibler else if (nread == -1 && errno == EWOULDBLOCK)
173760432Shibler ;
173860432Shibler #else
173960432Shibler #ifdef O_NONBLOCK
174060432Shibler else if (nread == -1 && errno == EAGAIN)
174160432Shibler ;
174260432Shibler #else
174360432Shibler #ifdef O_NDELAY
174460432Shibler else if (nread == -1 && errno == EAGAIN)
174560432Shibler ;
174660432Shibler /* Note that we cannot distinguish between no input
174760432Shibler available now and a closed pipe.
174860432Shibler With luck, a closed pipe will be accompanied by
174960432Shibler subprocess termination and SIGCHLD. */
175060432Shibler else if (nread == 0)
175160432Shibler ;
175260432Shibler #endif /* O_NDELAY */
175360432Shibler #endif /* O_NONBLOCK */
175460432Shibler #endif /* EWOULDBLOCK */
175560432Shibler #ifdef HAVE_PTYS
175660432Shibler /* On some OSs with ptys, when the process on one end of
175760432Shibler a pty exits, the other end gets an error reading with
175860432Shibler errno = EIO instead of getting an EOF (0 bytes read).
175960432Shibler Therefore, if we get an error reading and errno =
176060432Shibler EIO, just continue, because the child process has
176160432Shibler exited and should clean itself up soon (e.g. when we
176260432Shibler get a SIGCHLD). */
176360432Shibler else if (nread == -1 && errno == EIO)
176460432Shibler ;
176560432Shibler #endif /* HAVE_PTYS */
176660432Shibler /* If we can detect process termination, don't consider the process
176760432Shibler gone just because its pipe is closed. */
176860432Shibler #ifdef SIGCHLD
176960432Shibler else if (nread == 0)
177060432Shibler ;
177160432Shibler #endif
177260432Shibler else
177360432Shibler {
177460432Shibler /* Preserve status of processes already terminated. */
177560432Shibler XSETINT (XPROCESS (proc)->tick, ++process_tick);
177660432Shibler deactivate_process (proc);
177760432Shibler if (!NULL (XPROCESS (proc)->raw_status_low))
177860432Shibler update_status (XPROCESS (proc));
177960432Shibler if (EQ (XPROCESS (proc)->status, Qrun))
178060432Shibler XPROCESS (proc)->status
178160432Shibler = Fcons (Qexit, Fcons (make_number (256), Qnil));
178260432Shibler }
178360432Shibler }
178460432Shibler } /* end for */
178560432Shibler } /* end while */
178660432Shibler
178760432Shibler #if 0
178860432Shibler /* Resume periodic signals to poll for input, if necessary. */
178960432Shibler start_polling ();
179060432Shibler #endif
179160432Shibler }
179260432Shibler
179360432Shibler /* Actually call the filter. This gets the information via variables
179460432Shibler because internal_condition_case won't pass arguments. */
179560432Shibler
179660432Shibler Lisp_Object
run_filter()179760432Shibler run_filter ()
179860432Shibler {
179960432Shibler return call2 (this_filter, filter_process, filter_string);
180060432Shibler }
180160432Shibler
180260432Shibler /* Read pending output from the process channel,
180360432Shibler starting with our buffered-ahead character if we have one.
180460432Shibler Yield number of characters read.
180560432Shibler
180660432Shibler This function reads at most 1024 characters.
180760432Shibler If you want to read all available subprocess output,
180860432Shibler you must call it repeatedly until it returns zero. */
180960432Shibler
read_process_output(proc,channel)181060432Shibler read_process_output (proc, channel)
181160432Shibler Lisp_Object proc;
181260432Shibler register int channel;
181360432Shibler {
181460432Shibler register int nchars;
181560432Shibler char chars[1024];
181660432Shibler register Lisp_Object outstream;
181760432Shibler register struct buffer *old = current_buffer;
181860432Shibler register struct Lisp_Process *p = XPROCESS (proc);
181960432Shibler register int opoint;
182060432Shibler
182160432Shibler if (proc_buffered_char[channel] < 0)
182260432Shibler nchars = read (channel, chars, sizeof chars);
182360432Shibler else
182460432Shibler {
182560432Shibler chars[0] = proc_buffered_char[channel];
182660432Shibler proc_buffered_char[channel] = -1;
182760432Shibler nchars = read (channel, chars + 1, sizeof chars - 1);
182860432Shibler if (nchars < 0)
182960432Shibler nchars = 1;
183060432Shibler else
183160432Shibler nchars = nchars + 1;
183260432Shibler }
183360432Shibler
183460432Shibler if (nchars <= 0) return nchars;
183560432Shibler
183660432Shibler outstream = p->filter;
183760432Shibler if (!NULL (outstream))
183860432Shibler {
183960432Shibler int count = specpdl_ptr - specpdl;
184060432Shibler specbind (Qinhibit_quit, Qt);
184160432Shibler this_filter = outstream;
184260432Shibler filter_process = proc;
184360432Shibler filter_string = make_string (chars, nchars);
184460432Shibler call2 (this_filter, filter_process, filter_string);
184560432Shibler /* internal_condition_case (run_filter, Qerror, Fidentity); */
184660432Shibler unbind_to (count);
184760432Shibler return nchars;
184860432Shibler }
184960432Shibler
185060432Shibler /* If no filter, write into buffer if it isn't dead. */
185160432Shibler if (!NULL (p->buffer) && !NULL (XBUFFER (p->buffer)->name))
185260432Shibler {
185360432Shibler Lisp_Object tem;
185460432Shibler
185560432Shibler Fset_buffer (p->buffer);
185660432Shibler opoint = point;
185760432Shibler
185860432Shibler /* Insert new output into buffer
185960432Shibler at the current end-of-output marker,
186060432Shibler thus preserving logical ordering of input and output. */
186160432Shibler if (XMARKER (p->mark)->buffer)
186260432Shibler SET_PT (marker_position (p->mark));
186360432Shibler else
186460432Shibler SET_PT (ZV);
186560432Shibler if (point <= opoint)
186660432Shibler opoint += nchars;
186760432Shibler
186860432Shibler tem = current_buffer->read_only;
186960432Shibler current_buffer->read_only = Qnil;
187060432Shibler insert (chars, nchars);
187160432Shibler current_buffer->read_only = tem;
187260432Shibler Fset_marker (p->mark, make_number (point), p->buffer);
187360432Shibler update_mode_lines++;
187460432Shibler
187560432Shibler SET_PT (opoint);
187660432Shibler set_buffer_internal (old);
187760432Shibler }
187860432Shibler return nchars;
187960432Shibler }
188060432Shibler
188160432Shibler DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
188260432Shibler 0, 0, 0,
188360432Shibler "Returns non-NIL if emacs is waiting for input from the user.\n\
188460432Shibler This is intended for use by asynchronous process output filters and sentinels.")
188560432Shibler ()
188660432Shibler {
188760432Shibler return ((waiting_for_user_input_p) ? Qt : Qnil);
188860432Shibler }
188960432Shibler
189060432Shibler /* Sending data to subprocess */
189160432Shibler
189260432Shibler jmp_buf send_process_frame;
189360432Shibler
send_process_trap()189460432Shibler send_process_trap ()
189560432Shibler {
189660432Shibler #ifdef BSD4_1
189760432Shibler sigrelse (SIGPIPE);
189860432Shibler sigrelse (SIGALRM);
189960432Shibler #endif /* BSD4_1 */
190060432Shibler longjmp (send_process_frame, 1);
190160432Shibler }
190260432Shibler
send_process(proc,buf,len)190360432Shibler send_process (proc, buf, len)
190460432Shibler Lisp_Object proc;
190560432Shibler char *buf;
190660432Shibler int len;
190760432Shibler {
190860432Shibler /* Don't use register vars; longjmp can lose them. */
190960432Shibler int rv;
191060432Shibler unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
191160432Shibler
191260432Shibler if (!NULL (XPROCESS (proc)->raw_status_low))
191360432Shibler update_status (XPROCESS (proc));
191460432Shibler if (! EQ (XPROCESS (proc)->status, Qrun))
191560432Shibler error ("Process %s not running", procname);
191660432Shibler
191760432Shibler if (!setjmp (send_process_frame))
191860432Shibler while (len > 0)
191960432Shibler {
192060432Shibler signal (SIGPIPE, send_process_trap);
192160432Shibler rv = write (XFASTINT (XPROCESS (proc)->outfd), buf, len);
192260432Shibler signal (SIGPIPE, SIG_DFL);
192360432Shibler if (rv < 0)
192460432Shibler {
192560432Shibler #ifdef EWOULDBLOCK
192660432Shibler if (errno == EWOULDBLOCK)
192760432Shibler {
192860432Shibler /* It would be nice to accept process output here,
192960432Shibler but that is difficult. For example, it could
193060432Shibler garbage what we are sending if that is from a buffer. */
193160432Shibler immediate_quit = 1;
193260432Shibler QUIT;
193360432Shibler sleep (1);
193460432Shibler immediate_quit = 0;
193560432Shibler continue;
193660432Shibler }
193760432Shibler #endif
193860432Shibler report_file_error ("writing to process", Fcons (proc, Qnil));
193960432Shibler }
194060432Shibler buf += rv;
194160432Shibler len -= rv;
194260432Shibler }
194360432Shibler else
194460432Shibler {
194560432Shibler XPROCESS (proc)->raw_status_low = Qnil;
194660432Shibler XPROCESS (proc)->raw_status_high = Qnil;
194760432Shibler XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
194860432Shibler XSETINT (XPROCESS (proc)->tick, ++process_tick);
194960432Shibler deactivate_process (proc);
195060432Shibler error ("SIGPIPE raised on process %s; closed it", procname);
195160432Shibler }
195260432Shibler }
195360432Shibler
195460432Shibler DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
195560432Shibler 3, 3, 0,
195660432Shibler "Send current contents of region as input to PROCESS.\n\
195760432Shibler PROCESS may be a process name.\n\
195860432Shibler Called from program, takes three arguments, PROCESS, START and END.")
195960432Shibler (process, start, end)
196060432Shibler Lisp_Object process, start, end;
196160432Shibler {
196260432Shibler Lisp_Object proc;
196360432Shibler int start1;
196460432Shibler
196560432Shibler proc = get_process (process);
196660432Shibler validate_region (&start, &end);
196760432Shibler
196860432Shibler if (XINT (start) < GPT && XINT (end) > GPT)
196960432Shibler move_gap (start);
197060432Shibler
197160432Shibler start1 = XINT (start);
197260432Shibler send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start));
197360432Shibler
197460432Shibler return Qnil;
197560432Shibler }
197660432Shibler
197760432Shibler DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
197860432Shibler 2, 2, 0,
197960432Shibler "Send PROCESS the contents of STRING as input.\n\
198060432Shibler PROCESS may be a process name.")
198160432Shibler (process, string)
198260432Shibler Lisp_Object process, string;
198360432Shibler {
198460432Shibler Lisp_Object proc;
198560432Shibler CHECK_STRING (string, 1);
198660432Shibler proc = get_process (process);
198760432Shibler send_process (proc, XSTRING (string)->data, XSTRING (string)->size);
198860432Shibler return Qnil;
198960432Shibler }
199060432Shibler
199160432Shibler /* send a signal number SIGNO to PROCESS.
199260432Shibler CURRENT_GROUP means send to the process group that currently owns
199360432Shibler the terminal being used to communicate with PROCESS.
199460432Shibler This is used for various commands in shell mode.
199560432Shibler If NOMSG is zero, insert signal-announcements into process's buffers
199660432Shibler right away. */
199760432Shibler
process_send_signal(process,signo,current_group,nomsg)199860432Shibler process_send_signal (process, signo, current_group, nomsg)
199960432Shibler Lisp_Object process;
200060432Shibler int signo;
200160432Shibler Lisp_Object current_group;
200260432Shibler int nomsg;
200360432Shibler {
200460432Shibler Lisp_Object proc;
200560432Shibler register struct Lisp_Process *p;
200660432Shibler int gid;
200760432Shibler
200860432Shibler proc = get_process (process);
200960432Shibler p = XPROCESS (proc);
201060432Shibler
201160432Shibler if (!EQ (p->childp, Qt))
201260432Shibler error ("Process %s is not a subprocess",
201360432Shibler XSTRING (p->name)->data);
201460432Shibler if (!XFASTINT (p->infd))
201560432Shibler error ("Process %s is not active",
201660432Shibler XSTRING (p->name)->data);
201760432Shibler
201860432Shibler if (NULL (p->pty_flag))
201960432Shibler current_group = Qnil;
202060432Shibler
202160432Shibler #ifdef TIOCGPGRP /* Not sure about this! (fnf) */
202260432Shibler /* If we are using pgrps, get a pgrp number and make it negative. */
202360432Shibler if (!NULL (current_group))
202460432Shibler {
202560432Shibler ioctl (XFASTINT (p->infd), TIOCGPGRP, &gid);
202660432Shibler gid = - gid;
202760432Shibler }
202860432Shibler else
202960432Shibler gid = - XFASTINT (p->pid);
203060432Shibler #else /* not using pgrps */
203160432Shibler /* Can't select pgrps on this system, so we know that
203260432Shibler the child itself heads the pgrp. */
203360432Shibler gid = - XFASTINT (p->pid);
203460432Shibler #endif /* not using pgrps */
203560432Shibler
203660432Shibler switch (signo)
203760432Shibler {
203860432Shibler #ifdef SIGCONT
203960432Shibler case SIGCONT:
204060432Shibler p->raw_status_low = Qnil;
204160432Shibler p->raw_status_high = Qnil;
204260432Shibler p->status = Qrun;
204360432Shibler XSETINT (p->tick, ++process_tick);
204460432Shibler if (!nomsg)
204560432Shibler status_notify ();
204660432Shibler break;
204760432Shibler #endif
204860432Shibler case SIGINT:
204960432Shibler case SIGQUIT:
205060432Shibler case SIGKILL:
205160432Shibler flush_pending_output (XFASTINT (p->infd));
205260432Shibler break;
205360432Shibler }
205460432Shibler /* gid may be a pid, or minus a pgrp's number */
205560432Shibler #ifdef TIOCSIGSEND
205660432Shibler if (!NULL (current_group))
205760432Shibler ioctl (XFASTINT (p->infd), TIOCSIGSEND, signo);
205860432Shibler else
205960432Shibler {
206060432Shibler gid = - XFASTINT (p->pid);
206160432Shibler kill (gid, signo);
206260432Shibler }
206360432Shibler #else /* no TIOCSIGSEND */
206460432Shibler #ifdef BSD
206560432Shibler /* On bsd, [man says] kill does not accept a negative number to kill a pgrp.
206660432Shibler Must do that differently. */
206760432Shibler killpg (-gid, signo);
206860432Shibler #else /* Not BSD. */
206960432Shibler kill (gid, signo);
207060432Shibler #endif /* Not BSD. */
207160432Shibler #endif /* no TIOCSIGSEND */
207260432Shibler }
207360432Shibler
207460432Shibler DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
207560432Shibler "Interrupt process PROCESS. May be process or name of one.\n\
207660432Shibler Nil or no arg means current buffer's process.\n\
207760432Shibler Second arg CURRENT-GROUP non-nil means send signal to\n\
207860432Shibler the current process-group of the process's controlling terminal\n\
207960432Shibler rather than to the process's own process group.\n\
208060432Shibler If the process is a shell, this means interrupt current subjob\n\
208160432Shibler rather than the shell.")
208260432Shibler (process, current_group)
208360432Shibler Lisp_Object process, current_group;
208460432Shibler {
208560432Shibler process_send_signal (process, SIGINT, current_group, 0);
208660432Shibler return process;
208760432Shibler }
208860432Shibler
208960432Shibler DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
209060432Shibler "Kill process PROCESS. May be process or name of one.\n\
209160432Shibler See function interrupt-process for more details on usage.")
209260432Shibler (process, current_group)
209360432Shibler Lisp_Object process, current_group;
209460432Shibler {
209560432Shibler process_send_signal (process, SIGKILL, current_group, 0);
209660432Shibler return process;
209760432Shibler }
209860432Shibler
209960432Shibler DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
210060432Shibler "Send QUIT signal to process PROCESS. May be process or name of one.\n\
210160432Shibler See function interrupt-process for more details on usage.")
210260432Shibler (process, current_group)
210360432Shibler Lisp_Object process, current_group;
210460432Shibler {
210560432Shibler process_send_signal (process, SIGQUIT, current_group, 0);
210660432Shibler return process;
210760432Shibler }
210860432Shibler
210960432Shibler DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
211060432Shibler "Stop process PROCESS. May be process or name of one.\n\
211160432Shibler See function interrupt-process for more details on usage.")
211260432Shibler (process, current_group)
211360432Shibler Lisp_Object process, current_group;
211460432Shibler {
211560432Shibler #ifndef SIGTSTP
211660432Shibler error ("no SIGTSTP support");
211760432Shibler #else
211860432Shibler process_send_signal (process, SIGTSTP, current_group, 0);
211960432Shibler #endif
212060432Shibler return process;
212160432Shibler }
212260432Shibler
212360432Shibler DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
212460432Shibler "Continue process PROCESS. May be process or name of one.\n\
212560432Shibler See function interrupt-process for more details on usage.")
212660432Shibler (process, current_group)
212760432Shibler Lisp_Object process, current_group;
212860432Shibler {
212960432Shibler #ifdef SIGCONT
213060432Shibler process_send_signal (process, SIGCONT, current_group, 0);
213160432Shibler #else
213260432Shibler error ("no SIGCONT support");
213360432Shibler #endif
213460432Shibler return process;
213560432Shibler }
213660432Shibler
213760432Shibler DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
213860432Shibler "Make PROCESS see end-of-file in its input.\n\
213960432Shibler Eof comes after any text already sent to it.\n\
214060432Shibler nil or no arg means current buffer's process.")
214160432Shibler (process)
214260432Shibler Lisp_Object process;
214360432Shibler {
214460432Shibler Lisp_Object proc;
214560432Shibler
214660432Shibler proc = get_process (process);
214760432Shibler /* Sending a zero-length record is supposed to mean eof
214860432Shibler when TIOCREMOTE is turned on. */
214960432Shibler #ifdef DID_REMOTE
215060432Shibler {
215160432Shibler char buf[1];
215260432Shibler write (XFASTINT (XPROCESS (proc)->outfd), buf, 0);
215360432Shibler }
215460432Shibler #else /* did not do TOICREMOTE */
215560432Shibler send_process (proc, "\004", 1);
215660432Shibler #endif /* did not do TOICREMOTE */
215760432Shibler return process;
215860432Shibler }
215960432Shibler
216060432Shibler /* Kill all processes associated with `buffer'.
216160432Shibler If `buffer' is nil, kill all processes */
216260432Shibler
kill_buffer_processes(buffer)216360432Shibler kill_buffer_processes (buffer)
216460432Shibler Lisp_Object buffer;
216560432Shibler {
216660432Shibler Lisp_Object tail, proc;
216760432Shibler
216860432Shibler for (tail = Vprocess_alist; XGCTYPE (tail) == Lisp_Cons;
216960432Shibler tail = XCONS (tail)->cdr)
217060432Shibler {
217160432Shibler proc = XCONS (XCONS (tail)->car)->cdr;
217260432Shibler if (XGCTYPE (proc) == Lisp_Process
217360432Shibler && (NULL (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
217460432Shibler {
217560432Shibler if (NETCONN_P (proc))
217660432Shibler deactivate_process (proc);
217760432Shibler else if (XFASTINT (XPROCESS (proc)->infd))
217860432Shibler process_send_signal (proc, SIGHUP, Qnil, 1);
217960432Shibler }
218060432Shibler }
218160432Shibler }
218260432Shibler
218360432Shibler /* On receipt of a signal that a child status has changed,
218460432Shibler loop asking about children with changed statuses until
218560432Shibler the system says there are no more.
218660432Shibler All we do is change the status;
218760432Shibler we do not run sentinels or print notifications.
218860432Shibler That is saved for the next time keyboard input is done,
218960432Shibler in order to avoid timing errors. */
219060432Shibler
219160432Shibler /** WARNING: this can be called during garbage collection.
219260432Shibler Therefore, it must not be fooled by the presence of mark bits in
219360432Shibler Lisp objects. */
219460432Shibler
219560432Shibler /** USG WARNING: Although it is not obvious from the documentation
219660432Shibler in signal(2), on a USG system the SIGCLD handler MUST NOT call
219760432Shibler signal() before executing at least one wait(), otherwise the handler
219860432Shibler will be called again, resulting in an infinite loop. The relevant
219960432Shibler portion of the documentation reads "SIGCLD signals will be queued
220060432Shibler and the signal-catching function will be continually reentered until
220160432Shibler the queue is empty". Invoking signal() causes the kernel to reexamine
220260432Shibler the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
220360432Shibler
sigchld_handler(signo)220460432Shibler sigchld_handler (signo)
220560432Shibler int signo;
220660432Shibler {
220760432Shibler int old_errno = errno;
220860432Shibler Lisp_Object proc;
220960432Shibler register struct Lisp_Process *p;
221060432Shibler
221160432Shibler #ifdef BSD4_1
221260432Shibler extern int synch_process_pid;
221360432Shibler extern int sigheld;
221460432Shibler sigheld |= sigbit (SIGCHLD);
221560432Shibler #endif
221660432Shibler
221760432Shibler while (1)
221860432Shibler {
221960432Shibler register int pid;
222060432Shibler WAITTYPE w;
222160432Shibler Lisp_Object tail;
222260432Shibler
222360432Shibler #ifdef WNOHANG
222460432Shibler #ifndef WUNTRACED
222560432Shibler #define WUNTRACED 0
222660432Shibler #endif /* no WUNTRACED */
222760432Shibler /* Keep trying to get a status until we get a definitive result. */
222860432Shibler do
222960432Shibler {
223060432Shibler errno = 0;
223160432Shibler pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
223260432Shibler }
223360432Shibler while (pid <= 0 && errno == EINTR);
223460432Shibler
223560432Shibler if (pid <= 0)
223660432Shibler {
223760432Shibler /* A real failure. We have done all our job, so return. */
223860432Shibler
223960432Shibler /* USG systems forget handlers when they are used;
224060432Shibler must reestablish each time */
224160432Shibler #ifdef USG
224260432Shibler signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
224360432Shibler #endif
224460432Shibler #ifdef BSD4_1
224560432Shibler sigheld &= ~sigbit (SIGCHLD);
224660432Shibler sigrelse (SIGCHLD);
224760432Shibler #endif
224860432Shibler errno = old_errno;
224960432Shibler return;
225060432Shibler }
225160432Shibler #else
225260432Shibler pid = wait (&w);
225360432Shibler #endif /* no WNOHANG */
225460432Shibler
225560432Shibler #ifdef BSD4_1
225660432Shibler if (synch_process_pid == pid)
225760432Shibler synch_process_pid = 0; /* Zero it to show process has died. */
225860432Shibler #endif
225960432Shibler
226060432Shibler /* Find the process that signaled us, and record its status. */
226160432Shibler
226260432Shibler p = 0;
226360432Shibler for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
226460432Shibler {
226560432Shibler proc = XCONS (XCONS (tail)->car)->cdr;
226660432Shibler p = XPROCESS (proc);
226760432Shibler if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
226860432Shibler break;
226960432Shibler p = 0;
227060432Shibler }
227160432Shibler
227260432Shibler /* If we don't recognize the pid number,
227360432Shibler look for a process being created. */
227460432Shibler
227560432Shibler if (p == 0)
227660432Shibler for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
227760432Shibler {
227860432Shibler proc = XCONS (XCONS (tail)->car)->cdr;
227960432Shibler p = XPROCESS (proc);
228060432Shibler if (XINT (p->pid) == -1)
228160432Shibler break;
228260432Shibler p = 0;
228360432Shibler }
228460432Shibler
228560432Shibler /* Change the status of the process that was found. */
228660432Shibler
228760432Shibler if (p != 0)
228860432Shibler {
228960432Shibler union { int i; WAITTYPE wt; } u;
229060432Shibler
229160432Shibler XSETINT (p->tick, ++process_tick);
229260432Shibler u.wt = w;
229360432Shibler XFASTINT (p->raw_status_low) = u.i & 0xffff;
229460432Shibler XFASTINT (p->raw_status_high) = u.i >> 16;
229560432Shibler
229660432Shibler /* If process has terminated, stop waiting for its output. */
229760432Shibler if (WIFSIGNALED (w) || WIFEXITED (w))
229860432Shibler if (p->infd)
229960432Shibler FD_CLR (p->infd, &input_wait_mask);
230060432Shibler }
230160432Shibler
230260432Shibler /* On some systems, we must return right away.
230360432Shibler If any more processes want to signal us, we will
230460432Shibler get another signal.
230560432Shibler Otherwise (on systems that have WNOHANG), loop around
230660432Shibler to use up all the processes that have something to tell us. */
230760432Shibler #if defined (USG) && ! (defined (HPUX) && defined (WNOHANG))
230860432Shibler #ifdef USG
230960432Shibler signal (signo, sigchld_handler);
231060432Shibler #endif
231160432Shibler errno = old_errno;
231260432Shibler return;
231360432Shibler #endif /* USG, but not HPUX with WNOHANG */
231460432Shibler }
231560432Shibler }
231660432Shibler
231760432Shibler /* Report all recent events of a change in process status
231860432Shibler (either run the sentinel or output a message).
231960432Shibler This is done while Emacs is waiting for keyboard input. */
232060432Shibler
status_notify()232160432Shibler status_notify ()
232260432Shibler {
232360432Shibler register Lisp_Object tail, proc, buffer;
232460432Shibler
232560432Shibler for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
232660432Shibler {
232760432Shibler Lisp_Object symbol, msg;
232860432Shibler register struct Lisp_Process *p;
232960432Shibler
233060432Shibler proc = Fcdr (Fcar (tail));
233160432Shibler p = XPROCESS (proc);
233260432Shibler
233360432Shibler if (XINT (p->tick) != XINT (p->update_tick))
233460432Shibler {
233560432Shibler struct gcpro gcpro1;
233660432Shibler
233760432Shibler XSETINT (p->update_tick, XINT (p->tick));
233860432Shibler
233960432Shibler /* If process is still active, read any output that remains. */
234060432Shibler if (XFASTINT (p->infd))
234160432Shibler while (read_process_output (proc, XFASTINT (p->infd)) > 0);
234260432Shibler
234360432Shibler buffer = p->buffer;
234460432Shibler
234560432Shibler /* Get the text to use for the message. */
234660432Shibler if (!NULL (p->raw_status_low))
234760432Shibler update_status (p);
234860432Shibler msg = status_message (p->status);
234960432Shibler GCPRO1 (msg);
235060432Shibler
235160432Shibler /* If process is terminated, deactivate it or delete it. */
235260432Shibler symbol = p->status;
235360432Shibler if (XTYPE (p->status) == Lisp_Cons)
235460432Shibler symbol = XCONS (p->status)->car;
235560432Shibler
235660432Shibler if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
235760432Shibler || EQ (symbol, Qclosed))
235860432Shibler {
235960432Shibler if (delete_exited_processes)
236060432Shibler remove_process (proc);
236160432Shibler else
236260432Shibler deactivate_process (proc);
236360432Shibler }
236460432Shibler UNGCPRO;
236560432Shibler
236660432Shibler /* Now output the message suitably. */
236760432Shibler if (!NULL (p->sentinel))
236860432Shibler exec_sentinel (proc, msg);
236960432Shibler /* Don't bother with a message in the buffer
237060432Shibler when a process becomes runnable. */
237160432Shibler else if (!EQ (symbol, Qrun) && !NULL (buffer))
237260432Shibler {
237360432Shibler Lisp_Object ro = XBUFFER (buffer)->read_only;
237460432Shibler Lisp_Object tem;
237560432Shibler struct buffer *old = current_buffer;
237660432Shibler int opoint;
237760432Shibler
237860432Shibler /* Avoid error if buffer is deleted
237960432Shibler (probably that's why the process is dead, too) */
238060432Shibler if (NULL (XBUFFER (buffer)->name))
238160432Shibler continue;
238260432Shibler Fset_buffer (buffer);
238360432Shibler opoint = point;
238460432Shibler /* Insert new output into buffer
238560432Shibler at the current end-of-output marker,
238660432Shibler thus preserving logical ordering of input and output. */
238760432Shibler if (XMARKER (p->mark)->buffer)
238860432Shibler SET_PT (marker_position (p->mark));
238960432Shibler else
239060432Shibler SET_PT (ZV);
239160432Shibler if (point <= opoint)
239260432Shibler opoint += XSTRING (msg)->size + XSTRING (p->name)->size + 10;
239360432Shibler
239460432Shibler tem = current_buffer->read_only;
239560432Shibler current_buffer->read_only = Qnil;
239660432Shibler GCPRO1 (msg);
239760432Shibler InsStr ("\nProcess ");
239860432Shibler Finsert (1, &p->name);
239960432Shibler InsStr (" ");
240060432Shibler Finsert (1, &msg);
240160432Shibler current_buffer->read_only = tem;
240260432Shibler Fset_marker (p->mark, make_number (point), p->buffer);
240360432Shibler UNGCPRO;
240460432Shibler
240560432Shibler SET_PT (opoint);
240660432Shibler set_buffer_internal (old);
240760432Shibler }
240860432Shibler }
240960432Shibler } /* end for */
241060432Shibler
241160432Shibler update_mode_lines++; /* in case buffers use %s in mode-line-format */
241260432Shibler redisplay_preserve_echo_area ();
241360432Shibler
241460432Shibler update_tick = process_tick;
241560432Shibler }
241660432Shibler
exec_sentinel(proc,reason)241760432Shibler exec_sentinel (proc, reason)
241860432Shibler Lisp_Object proc, reason;
241960432Shibler {
242060432Shibler Lisp_Object sentinel;
242160432Shibler register struct Lisp_Process *p = XPROCESS (proc);
242260432Shibler int count = specpdl_ptr - specpdl;
242360432Shibler
242460432Shibler sentinel = p->sentinel;
242560432Shibler if (NULL (sentinel))
242660432Shibler return;
242760432Shibler
242860432Shibler p->sentinel = Qnil;
242960432Shibler specbind (Qinhibit_quit, Qt);
243060432Shibler this_filter = sentinel;
243160432Shibler filter_process = proc;
243260432Shibler filter_string = reason;
243360432Shibler call2 (this_filter, filter_process, filter_string);
243460432Shibler /* internal_condition_case (run_filter, Qerror, Fidentity); */
243560432Shibler unbind_to (count);
243660432Shibler p->sentinel = sentinel;
243760432Shibler }
243860432Shibler
init_process()243960432Shibler init_process ()
244060432Shibler {
244160432Shibler register int i;
244260432Shibler
244360432Shibler #ifdef SIGCHLD
244460432Shibler #ifndef CANNOT_DUMP
244560432Shibler if (! noninteractive || initialized)
244660432Shibler #endif
244760432Shibler signal (SIGCHLD, sigchld_handler);
244860432Shibler #endif
244960432Shibler
245060432Shibler FD_ZERO (&input_wait_mask);
245160432Shibler FD_SET (0, &input_wait_mask);
245260432Shibler Vprocess_alist = Qnil;
245360432Shibler for (i = 0; i < MAXDESC; i++)
245460432Shibler {
245560432Shibler chan_process[i] = Qnil;
245660432Shibler proc_buffered_char[i] = -1;
245760432Shibler }
245860432Shibler }
245960432Shibler
syms_of_process()246060432Shibler syms_of_process ()
246160432Shibler {
246260432Shibler Qprocessp = intern ("processp");
246360432Shibler staticpro (&Qprocessp);
246460432Shibler Qrun = intern ("run");
246560432Shibler staticpro (&Qrun);
246660432Shibler Qstop = intern ("stop");
246760432Shibler staticpro (&Qstop);
246860432Shibler Qsignal = intern ("signal");
246960432Shibler staticpro (&Qsignal);
247060432Shibler Qexit = intern ("exit");
247160432Shibler staticpro (&Qexit);
247260432Shibler Qopen = intern ("open");
247360432Shibler staticpro (&Qopen);
247460432Shibler Qclosed = intern ("closed");
247560432Shibler staticpro (&Qclosed);
247660432Shibler
247760432Shibler staticpro (&Vprocess_alist);
247860432Shibler
247960432Shibler DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
248060432Shibler "*Non-nil means delete processes immediately when they exit.\n\
248160432Shibler nil means don't delete them until `list-processes' is run.");
248260432Shibler
248360432Shibler delete_exited_processes = 1;
248460432Shibler
248560432Shibler DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
248660432Shibler "Control type of device used to communicate with subprocesses.\n\
248760432Shibler Values are nil to use a pipe, t for a pty (or pipe if ptys not supported).\n\
248860432Shibler Value takes effect when `start-process' is called.");
248960432Shibler Vprocess_connection_type = Qt;
249060432Shibler
249160432Shibler defsubr (&Sprocessp);
249260432Shibler defsubr (&Sget_process);
249360432Shibler defsubr (&Sget_buffer_process);
249460432Shibler defsubr (&Sdelete_process);
249560432Shibler defsubr (&Sprocess_status);
249660432Shibler defsubr (&Sprocess_exit_status);
249760432Shibler defsubr (&Sprocess_id);
249860432Shibler defsubr (&Sprocess_name);
249960432Shibler defsubr (&Sprocess_command);
250060432Shibler defsubr (&Sset_process_buffer);
250160432Shibler defsubr (&Sprocess_buffer);
250260432Shibler defsubr (&Sprocess_mark);
250360432Shibler defsubr (&Sset_process_filter);
250460432Shibler defsubr (&Sprocess_filter);
250560432Shibler defsubr (&Sset_process_sentinel);
250660432Shibler defsubr (&Sprocess_sentinel);
250760432Shibler defsubr (&Sprocess_kill_without_query);
250860432Shibler defsubr (&Slist_processes);
250960432Shibler defsubr (&Sprocess_list);
251060432Shibler defsubr (&Sstart_process);
251160432Shibler #ifdef HAVE_SOCKETS
251260432Shibler defsubr (&Sopen_network_stream);
251360432Shibler #endif /* HAVE_SOCKETS */
251460432Shibler defsubr (&Saccept_process_output);
251560432Shibler defsubr (&Sprocess_send_region);
251660432Shibler defsubr (&Sprocess_send_string);
251760432Shibler defsubr (&Sinterrupt_process);
251860432Shibler defsubr (&Skill_process);
251960432Shibler defsubr (&Squit_process);
252060432Shibler defsubr (&Sstop_process);
252160432Shibler defsubr (&Scontinue_process);
252260432Shibler defsubr (&Sprocess_send_eof);
252360432Shibler defsubr (&Swaiting_for_user_input_p);
252460432Shibler }
252560432Shibler
252660432Shibler #endif subprocesses
2527