1*60432Shibler /* Asynchronous subprocess control for GNU Emacs.
2*60432Shibler    Copyright (C) 1985, 1986, 1987, 1988, 1990 Free Software Foundation, Inc.
3*60432Shibler 
4*60432Shibler This file is part of GNU Emacs.
5*60432Shibler 
6*60432Shibler GNU Emacs is free software; you can redistribute it and/or modify
7*60432Shibler it under the terms of the GNU General Public License as published by
8*60432Shibler the Free Software Foundation; either version 1, or (at your option)
9*60432Shibler any later version.
10*60432Shibler 
11*60432Shibler GNU Emacs is distributed in the hope that it will be useful,
12*60432Shibler but WITHOUT ANY WARRANTY; without even the implied warranty of
13*60432Shibler MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14*60432Shibler GNU General Public License for more details.
15*60432Shibler 
16*60432Shibler You should have received a copy of the GNU General Public License
17*60432Shibler along with GNU Emacs; see the file COPYING.  If not, write to
18*60432Shibler the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
19*60432Shibler 
20*60432Shibler 
21*60432Shibler #include <signal.h>
22*60432Shibler 
23*60432Shibler #include "config.h"
24*60432Shibler 
25*60432Shibler #ifdef subprocesses
26*60432Shibler /* The entire file is within this conditional */
27*60432Shibler 
28*60432Shibler #include <stdio.h>
29*60432Shibler #include <errno.h>
30*60432Shibler #include <setjmp.h>
31*60432Shibler #include <sys/types.h>		/* some typedefs are used in sys/file.h */
32*60432Shibler #include <sys/file.h>
33*60432Shibler #include <sys/stat.h>
34*60432Shibler 
35*60432Shibler #ifdef HAVE_SOCKETS	/* TCP connection support, if kernel can do it */
36*60432Shibler #include <sys/socket.h>
37*60432Shibler #include <netdb.h>
38*60432Shibler #include <netinet/in.h>
39*60432Shibler #endif /* HAVE_SOCKETS */
40*60432Shibler 
41*60432Shibler #if defined(BSD) || defined(STRIDE)
42*60432Shibler #include <sys/ioctl.h>
43*60432Shibler #if !defined (O_NDELAY) && defined (HAVE_PTYS)
44*60432Shibler #include <fcntl.h>
45*60432Shibler #endif /* HAVE_PTYS and no O_NDELAY */
46*60432Shibler #endif /* BSD or STRIDE */
47*60432Shibler #ifdef USG
48*60432Shibler #include <termio.h>
49*60432Shibler #include <fcntl.h>
50*60432Shibler #endif /* USG */
51*60432Shibler 
52*60432Shibler #ifdef NEED_BSDTTY
53*60432Shibler #include <sys/bsdtty.h>
54*60432Shibler #endif
55*60432Shibler 
56*60432Shibler #ifdef HPUX
57*60432Shibler #undef TIOCGPGRP
58*60432Shibler #endif
59*60432Shibler 
60*60432Shibler #ifdef IRIS
61*60432Shibler #include <sys/sysmacros.h>	/* for "minor" */
62*60432Shibler #include <sys/time.h>
63*60432Shibler #else
64*60432Shibler #ifdef UNIPLUS
65*60432Shibler #include <sys/time.h>
66*60432Shibler 
67*60432Shibler #else /* not IRIS, not UNIPLUS */
68*60432Shibler #ifdef HAVE_TIMEVAL
69*60432Shibler /* _h_BSDTYPES is checked because on ISC unix, socket.h includes
70*60432Shibler    both time.h and sys/time.h, and the latter file is protected
71*60432Shibler    from repeated inclusion.  */
72*60432Shibler #if defined(USG) && !defined(AIX) && !defined(_h_BSDTYPES) && !defined(USG_SYS_TIME)
73*60432Shibler #include <time.h>
74*60432Shibler #else /* AIX or USG_SYS_TIME, or not USG */
75*60432Shibler #include <sys/time.h>
76*60432Shibler #endif /* AIX or USG_SYS_TIME, or not USG */
77*60432Shibler #endif /* HAVE_TIMEVAL */
78*60432Shibler 
79*60432Shibler #endif /* not UNIPLUS */
80*60432Shibler #endif /* not IRIS */
81*60432Shibler 
82*60432Shibler #if defined (HPUX) && defined (HAVE_PTYS)
83*60432Shibler #include <sys/ptyio.h>
84*60432Shibler #endif
85*60432Shibler 
86*60432Shibler #ifdef AIX
87*60432Shibler #include <sys/pty.h>
88*60432Shibler #include <unistd.h>
89*60432Shibler #endif /* AIX */
90*60432Shibler 
91*60432Shibler #ifdef SYSV_PTYS
92*60432Shibler #include <sys/tty.h>
93*60432Shibler #include <sys/pty.h>
94*60432Shibler #endif
95*60432Shibler 
96*60432Shibler #undef NULL
97*60432Shibler #include "lisp.h"
98*60432Shibler #include "window.h"
99*60432Shibler #include "buffer.h"
100*60432Shibler #include "process.h"
101*60432Shibler #include "termhooks.h"
102*60432Shibler #include "termopts.h"
103*60432Shibler #include "commands.h"
104*60432Shibler 
105*60432Shibler Lisp_Object Qrun, Qstop, Qsignal, Qexit, Qopen, Qclosed;
106*60432Shibler 
107*60432Shibler /* a process object is a network connection when its childp field is neither
108*60432Shibler    Qt nor Qnil but is instead a string (name of foreign host we
109*60432Shibler    are connected to + name of port we are connected to) */
110*60432Shibler 
111*60432Shibler #ifdef HAVE_SOCKETS
112*60432Shibler #define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String)
113*60432Shibler #else
114*60432Shibler #define NETCONN_P(p) 0
115*60432Shibler #endif /* HAVE_SOCKETS */
116*60432Shibler 
117*60432Shibler /* Define SIGCHLD as an alias for SIGCLD.  There are many conditionals
118*60432Shibler    testing SIGCHLD.  */
119*60432Shibler 
120*60432Shibler #if !defined (SIGCHLD) && defined (SIGCLD)
121*60432Shibler #define SIGCHLD SIGCLD
122*60432Shibler #endif /* SIGCLD */
123*60432Shibler 
124*60432Shibler /* Define the structure that the wait system call stores.
125*60432Shibler    On many systems, there is a structure defined for this.
126*60432Shibler    But on vanilla-ish USG systems there is not.  */
127*60432Shibler 
128*60432Shibler #ifndef WAITTYPE
129*60432Shibler #if !defined (BSD) && !defined (UNIPLUS) && !defined (STRIDE) && !(defined (HPUX) && !defined (NOMULTIPLEJOBS)) && !defined (HAVE_WAIT_HEADER)
130*60432Shibler #define WAITTYPE int
131*60432Shibler #define WIFSTOPPED(w) ((w&0377) == 0177)
132*60432Shibler #define WIFSIGNALED(w) ((w&0377) != 0177 && (w&~0377) == 0)
133*60432Shibler #define WIFEXITED(w) ((w&0377) == 0)
134*60432Shibler #define WRETCODE(w) (w >> 8)
135*60432Shibler #define WSTOPSIG(w) (w >> 8)
136*60432Shibler #define WTERMSIG(w) (w & 0377)
137*60432Shibler #ifndef WCOREDUMP
138*60432Shibler #define WCOREDUMP(w) ((w&0200) != 0)
139*60432Shibler #endif
140*60432Shibler #else
141*60432Shibler #ifdef BSD4_1
142*60432Shibler #include <wait.h>
143*60432Shibler #else
144*60432Shibler #include <sys/wait.h>
145*60432Shibler #endif /* not BSD 4.1 */
146*60432Shibler 
147*60432Shibler #define WAITTYPE union wait
148*60432Shibler #ifndef WRETCODE
149*60432Shibler #define WRETCODE(w) w.w_retcode
150*60432Shibler #endif
151*60432Shibler #ifndef WCOREDUMP
152*60432Shibler #define WCOREDUMP(w) w.w_coredump
153*60432Shibler #endif
154*60432Shibler 
155*60432Shibler #ifdef HPUX
156*60432Shibler /* HPUX version 7 has broken definitions of these.  */
157*60432Shibler #undef WTERMSIG
158*60432Shibler #undef WSTOPSIG
159*60432Shibler #undef WIFSTOPPED
160*60432Shibler #undef WIFSIGNALED
161*60432Shibler #undef WIFEXITED
162*60432Shibler #endif
163*60432Shibler 
164*60432Shibler #ifndef WTERMSIG
165*60432Shibler #define WTERMSIG(w) w.w_termsig
166*60432Shibler #endif
167*60432Shibler #ifndef WSTOPSIG
168*60432Shibler #define WSTOPSIG(w) w.w_stopsig
169*60432Shibler #endif
170*60432Shibler #ifndef WIFSTOPPED
171*60432Shibler #define WIFSTOPPED(w) (WTERMSIG (w) == 0177)
172*60432Shibler #endif
173*60432Shibler #ifndef WIFSIGNALED
174*60432Shibler #define WIFSIGNALED(w) (WTERMSIG (w) != 0177 && (WSTOPSIG (w)) == 0)
175*60432Shibler #endif
176*60432Shibler #ifndef WIFEXITED
177*60432Shibler #define WIFEXITED(w) (WTERMSIG (w) == 0)
178*60432Shibler #endif
179*60432Shibler #endif /* BSD or UNIPLUS or STRIDE */
180*60432Shibler #endif /* no WAITTYPE */
181*60432Shibler 
182*60432Shibler #ifndef BSD4_4
183*60432Shibler extern errno;
184*60432Shibler extern sys_nerr;
185*60432Shibler extern char *sys_errlist[];
186*60432Shibler #endif
187*60432Shibler 
188*60432Shibler #ifndef BSD4_1
189*60432Shibler #ifndef BSD4_4
190*60432Shibler extern char *sys_siglist[];
191*60432Shibler #endif
192*60432Shibler #else
193*60432Shibler char *sys_siglist[] =
194*60432Shibler   {
195*60432Shibler     "bum signal!!",
196*60432Shibler     "hangup",
197*60432Shibler     "interrupt",
198*60432Shibler     "quit",
199*60432Shibler     "illegal instruction",
200*60432Shibler     "trace trap",
201*60432Shibler     "iot instruction",
202*60432Shibler     "emt instruction",
203*60432Shibler     "floating point exception",
204*60432Shibler     "kill",
205*60432Shibler     "bus error",
206*60432Shibler     "segmentation violation",
207*60432Shibler     "bad argument to system call",
208*60432Shibler     "write on a pipe with no one to read it",
209*60432Shibler     "alarm clock",
210*60432Shibler     "software termination signal from kill",
211*60432Shibler     "status signal",
212*60432Shibler     "sendable stop signal not from tty",
213*60432Shibler     "stop signal from tty",
214*60432Shibler     "continue a stopped process",
215*60432Shibler     "child status has changed",
216*60432Shibler     "background read attempted from control tty",
217*60432Shibler     "background write attempted from control tty",
218*60432Shibler     "input record available at control tty",
219*60432Shibler     "exceeded CPU time limit",
220*60432Shibler     "exceeded file size limit"
221*60432Shibler     };
222*60432Shibler #endif
223*60432Shibler 
224*60432Shibler #ifdef vipc
225*60432Shibler 
226*60432Shibler #include "vipc.h"
227*60432Shibler extern int comm_server;
228*60432Shibler extern int net_listen_address;
229*60432Shibler #endif /* vipc */
230*60432Shibler 
231*60432Shibler /* t means use pty, nil means use a pipe,
232*60432Shibler    maybe other values to come.  */
233*60432Shibler Lisp_Object Vprocess_connection_type;
234*60432Shibler 
235*60432Shibler #ifdef SKTPAIR
236*60432Shibler #ifndef HAVE_SOCKETS
237*60432Shibler #include <sys/socket.h>
238*60432Shibler #endif
239*60432Shibler #endif /* SKTPAIR */
240*60432Shibler 
241*60432Shibler /* Number of events of change of status of a process.  */
242*60432Shibler int process_tick;
243*60432Shibler 
244*60432Shibler /* Number of events for which the user or sentinel has been notified.  */
245*60432Shibler int update_tick;
246*60432Shibler 
247*60432Shibler int delete_exited_processes;
248*60432Shibler 
249*60432Shibler #ifdef FD_SET
250*60432Shibler /* We could get this from param.h, but better not to depend on finding that.
251*60432Shibler    And better not to risk that it might define other symbols used in this
252*60432Shibler    file.  */
253*60432Shibler #define MAXDESC 64
254*60432Shibler #define SELECT_TYPE fd_set
255*60432Shibler #else /* no FD_SET */
256*60432Shibler #define MAXDESC 32
257*60432Shibler #define SELECT_TYPE int
258*60432Shibler 
259*60432Shibler /* Define the macros to access a single-int bitmap of descriptors.  */
260*60432Shibler #define FD_SET(n, p) (*(p) |= (1 << (n)))
261*60432Shibler #define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
262*60432Shibler #define FD_ISSET(n, p) (*(p) & (1 << (n)))
263*60432Shibler #define FD_ZERO(p) (*(p) = 0)
264*60432Shibler #endif /* no FD_SET */
265*60432Shibler 
266*60432Shibler /* Mask of bits indicating the descriptors that we wait for input on */
267*60432Shibler 
268*60432Shibler SELECT_TYPE input_wait_mask;
269*60432Shibler 
270*60432Shibler /* Indexed by descriptor, gives the process (if any) for that descriptor */
271*60432Shibler Lisp_Object chan_process[MAXDESC];
272*60432Shibler 
273*60432Shibler /* Alist of elements (NAME . PROCESS) */
274*60432Shibler Lisp_Object Vprocess_alist;
275*60432Shibler 
276*60432Shibler Lisp_Object Qprocessp;
277*60432Shibler 
278*60432Shibler Lisp_Object get_process ();
279*60432Shibler 
280*60432Shibler /* Buffered-ahead input char from process, indexed by channel.
281*60432Shibler    -1 means empty (no char is buffered).
282*60432Shibler    Used on sys V where the only way to tell if there is any
283*60432Shibler    output from the process is to read at least one char.
284*60432Shibler    Always -1 on systems that support FIONREAD.  */
285*60432Shibler 
286*60432Shibler int proc_buffered_char[MAXDESC];
287*60432Shibler 
288*60432Shibler /* These variables hold the filter about to be run, and its args,
289*60432Shibler    between read_process_output and run_filter.
290*60432Shibler    Also used in exec_sentinel for sentinels.  */
291*60432Shibler Lisp_Object this_filter;
292*60432Shibler Lisp_Object filter_process, filter_string;
293*60432Shibler 
294*60432Shibler /* Compute the Lisp form of the process status, p->status,
295*60432Shibler    from the numeric status that was returned by `wait'.  */
296*60432Shibler 
297*60432Shibler update_status (p)
298*60432Shibler      struct Lisp_Process *p;
299*60432Shibler {
300*60432Shibler   union { int i; WAITTYPE wt; } u;
301*60432Shibler   u.i = XFASTINT (p->raw_status_low) + (XFASTINT (p->raw_status_high) << 16);
302*60432Shibler   p->status = status_convert (u.wt);
303*60432Shibler   p->raw_status_low = Qnil;
304*60432Shibler   p->raw_status_high = Qnil;
305*60432Shibler }
306*60432Shibler 
307*60432Shibler /* Convert a process status word in Unix format
308*60432Shibler    to the list that we use internally.  */
309*60432Shibler 
310*60432Shibler Lisp_Object
311*60432Shibler status_convert (w)
312*60432Shibler      WAITTYPE w;
313*60432Shibler {
314*60432Shibler   if (WIFSTOPPED (w))
315*60432Shibler     return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
316*60432Shibler   else if (WIFEXITED (w))
317*60432Shibler     return Fcons (Qexit, Fcons (make_number (WRETCODE (w)),
318*60432Shibler 				WCOREDUMP (w) ? Qt : Qnil));
319*60432Shibler   else if (WIFSIGNALED (w))
320*60432Shibler     return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
321*60432Shibler 				  WCOREDUMP (w) ? Qt : Qnil));
322*60432Shibler   else
323*60432Shibler     return Qrun;
324*60432Shibler }
325*60432Shibler 
326*60432Shibler /* Given a status-list, extract the three pieces of information
327*60432Shibler    and store them individually through the three pointers.  */
328*60432Shibler 
329*60432Shibler void
330*60432Shibler decode_status (l, symbol, code, coredump)
331*60432Shibler      Lisp_Object l;
332*60432Shibler      Lisp_Object *symbol;
333*60432Shibler      int *code;
334*60432Shibler      int *coredump;
335*60432Shibler {
336*60432Shibler   Lisp_Object tem;
337*60432Shibler 
338*60432Shibler   if (XTYPE (l) == Lisp_Symbol)
339*60432Shibler     {
340*60432Shibler       *symbol = l;
341*60432Shibler       *code = 0;
342*60432Shibler       *coredump = 0;
343*60432Shibler     }
344*60432Shibler   else
345*60432Shibler     {
346*60432Shibler       *symbol = XCONS (l)->car;
347*60432Shibler       tem = XCONS (l)->cdr;
348*60432Shibler       *code = XFASTINT (XCONS (tem)->car);
349*60432Shibler       tem = XFASTINT (XCONS (tem)->cdr);
350*60432Shibler       *coredump = !NULL (tem);
351*60432Shibler     }
352*60432Shibler }
353*60432Shibler 
354*60432Shibler /* Return a string describing a process status list.  */
355*60432Shibler 
356*60432Shibler Lisp_Object
357*60432Shibler status_message (status)
358*60432Shibler      Lisp_Object status;
359*60432Shibler {
360*60432Shibler   Lisp_Object symbol;
361*60432Shibler   int code, coredump;
362*60432Shibler   Lisp_Object string, string2;
363*60432Shibler 
364*60432Shibler   decode_status (status, &symbol, &code, &coredump);
365*60432Shibler 
366*60432Shibler   if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
367*60432Shibler     {
368*60432Shibler       string = build_string (code < NSIG ? sys_siglist[code] : "unknown");
369*60432Shibler       string2 = build_string (coredump ? " (core dumped)\n" : "\n");
370*60432Shibler       XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
371*60432Shibler       return concat2 (string, string2);
372*60432Shibler     }
373*60432Shibler   else if (EQ (symbol, Qexit))
374*60432Shibler     {
375*60432Shibler       if (code == 0)
376*60432Shibler 	return build_string ("finished\n");
377*60432Shibler       string = Fint_to_string (make_number (code));
378*60432Shibler       string2 = build_string (coredump ? " (core dumped)\n" : "\n");
379*60432Shibler       return concat2 (build_string ("exited abnormally with code "),
380*60432Shibler 		      concat2 (string, string2));
381*60432Shibler     }
382*60432Shibler   else
383*60432Shibler     return Fcopy_sequence (Fsymbol_name (symbol));
384*60432Shibler }
385*60432Shibler 
386*60432Shibler #ifdef HAVE_PTYS
387*60432Shibler 
388*60432Shibler /* Open an available pty, returning a file descriptor.
389*60432Shibler    Return -1 on failure.
390*60432Shibler    The file name of the terminal corresponding to the pty
391*60432Shibler    is left in the variable pty_name.  */
392*60432Shibler 
393*60432Shibler char pty_name[24];
394*60432Shibler 
395*60432Shibler int
396*60432Shibler allocate_pty ()
397*60432Shibler {
398*60432Shibler   struct stat stb;
399*60432Shibler   register c, i;
400*60432Shibler   int fd;
401*60432Shibler 
402*60432Shibler #ifdef PTY_ITERATION
403*60432Shibler   PTY_ITERATION
404*60432Shibler #else
405*60432Shibler   for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
406*60432Shibler     for (i = 0; i < 16; i++)
407*60432Shibler #endif
408*60432Shibler       {
409*60432Shibler #ifdef PTY_NAME_SPRINTF
410*60432Shibler 	PTY_NAME_SPRINTF
411*60432Shibler #else
412*60432Shibler #ifdef HPUX
413*60432Shibler 	sprintf (pty_name, "/dev/ptym/pty%c%x", c, i);
414*60432Shibler #else
415*60432Shibler #ifdef RTU
416*60432Shibler 	sprintf (pty_name, "/dev/pty%x", i);
417*60432Shibler #else
418*60432Shibler 	sprintf (pty_name, "/dev/pty%c%x", c, i);
419*60432Shibler #endif /* not RTU */
420*60432Shibler #endif /* not HPUX */
421*60432Shibler #endif /* no PTY_NAME_SPRINTF */
422*60432Shibler 
423*60432Shibler #ifndef IRIS
424*60432Shibler 	if (stat (pty_name, &stb) < 0)
425*60432Shibler 	  return -1;
426*60432Shibler #ifdef O_NONBLOCK
427*60432Shibler 	fd = open (pty_name, O_RDWR | O_NONBLOCK, 0);
428*60432Shibler #else
429*60432Shibler 	fd = open (pty_name, O_RDWR | O_NDELAY, 0);
430*60432Shibler #endif
431*60432Shibler #else /* Unusual IRIS code */
432*60432Shibler  	fd = open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
433*60432Shibler  	if (fd < 0)
434*60432Shibler  	  return -1;
435*60432Shibler 	if (fstat (fd, &stb) < 0)
436*60432Shibler 	  return -1;
437*60432Shibler #endif /* IRIS */
438*60432Shibler 
439*60432Shibler 	if (fd >= 0)
440*60432Shibler 	  {
441*60432Shibler 	    /* check to make certain that both sides are available
442*60432Shibler 	       this avoids a nasty yet stupid bug in rlogins */
443*60432Shibler #ifdef PTY_TTY_NAME_SPRINTF
444*60432Shibler 	    PTY_TTY_NAME_SPRINTF
445*60432Shibler #else
446*60432Shibler 	    /* In version 19, make these special cases use the macro above.  */
447*60432Shibler #ifdef HPUX
448*60432Shibler             sprintf (pty_name, "/dev/pty/tty%c%x", c, i);
449*60432Shibler #else
450*60432Shibler #ifdef RTU
451*60432Shibler             sprintf (pty_name, "/dev/ttyp%x", i);
452*60432Shibler #else
453*60432Shibler #ifdef IRIS
454*60432Shibler  	    sprintf (pty_name, "/dev/ttyq%d", minor (stb.st_rdev));
455*60432Shibler #else
456*60432Shibler             sprintf (pty_name, "/dev/tty%c%x", c, i);
457*60432Shibler #endif /* not IRIS */
458*60432Shibler #endif /* not RTU */
459*60432Shibler #endif /* not HPUX */
460*60432Shibler #endif /* no PTY_TTY_NAME_SPRINTF */
461*60432Shibler #ifndef UNIPLUS
462*60432Shibler 	    if (access (pty_name, 6) != 0)
463*60432Shibler 	      {
464*60432Shibler 		close (fd);
465*60432Shibler #ifndef IRIS
466*60432Shibler 		continue;
467*60432Shibler #else
468*60432Shibler 		return -1;
469*60432Shibler #endif /* IRIS */
470*60432Shibler 	      }
471*60432Shibler #endif /* not UNIPLUS */
472*60432Shibler 	    setup_pty (fd);
473*60432Shibler 	    return fd;
474*60432Shibler 	  }
475*60432Shibler       }
476*60432Shibler   return -1;
477*60432Shibler }
478*60432Shibler #endif /* HAVE_PTYS */
479*60432Shibler 
480*60432Shibler Lisp_Object
481*60432Shibler make_process (name)
482*60432Shibler      Lisp_Object name;
483*60432Shibler {
484*60432Shibler   register Lisp_Object val, tem, name1;
485*60432Shibler   register struct Lisp_Process *p;
486*60432Shibler   char suffix[10];
487*60432Shibler   register int i;
488*60432Shibler 
489*60432Shibler   /* size of process structure includes the vector header,
490*60432Shibler      so deduct for that.  But struct Lisp_Vector includes the first
491*60432Shibler      element, thus deducts too much, so add it back.  */
492*60432Shibler   val = Fmake_vector (make_number ((sizeof (struct Lisp_Process)
493*60432Shibler 				    - sizeof (struct Lisp_Vector)
494*60432Shibler 				    + sizeof (Lisp_Object))
495*60432Shibler 				   / sizeof (Lisp_Object)),
496*60432Shibler 		      Qnil);
497*60432Shibler   XSETTYPE (val, Lisp_Process);
498*60432Shibler 
499*60432Shibler   p = XPROCESS (val);
500*60432Shibler   XFASTINT (p->infd) = 0;
501*60432Shibler   XFASTINT (p->outfd) = 0;
502*60432Shibler   XFASTINT (p->pid) = 0;
503*60432Shibler   XFASTINT (p->tick) = 0;
504*60432Shibler   XFASTINT (p->update_tick) = 0;
505*60432Shibler   p->raw_status_low = Qnil;
506*60432Shibler   p->raw_status_high = Qnil;
507*60432Shibler   p->status = Qrun;
508*60432Shibler   p->mark = Fmake_marker ();
509*60432Shibler 
510*60432Shibler   /* If name is already in use, modify it until it is unused.  */
511*60432Shibler 
512*60432Shibler   name1 = name;
513*60432Shibler   for (i = 1; ; i++)
514*60432Shibler     {
515*60432Shibler       tem = Fget_process (name1);
516*60432Shibler       if (NULL (tem)) break;
517*60432Shibler       sprintf (suffix, "<%d>", i);
518*60432Shibler       name1 = concat2 (name, build_string (suffix));
519*60432Shibler     }
520*60432Shibler   name = name1;
521*60432Shibler   p->name = name;
522*60432Shibler   Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
523*60432Shibler   return val;
524*60432Shibler }
525*60432Shibler 
526*60432Shibler remove_process (proc)
527*60432Shibler      register Lisp_Object proc;
528*60432Shibler {
529*60432Shibler   register Lisp_Object pair;
530*60432Shibler 
531*60432Shibler   pair = Frassq (proc, Vprocess_alist);
532*60432Shibler   Vprocess_alist = Fdelq (pair, Vprocess_alist);
533*60432Shibler   Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil);
534*60432Shibler 
535*60432Shibler   deactivate_process (proc);
536*60432Shibler }
537*60432Shibler 
538*60432Shibler DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
539*60432Shibler   "Return t if OBJECT is a process.")
540*60432Shibler   (obj)
541*60432Shibler      Lisp_Object obj;
542*60432Shibler {
543*60432Shibler   return XTYPE (obj) == Lisp_Process ? Qt : Qnil;
544*60432Shibler }
545*60432Shibler 
546*60432Shibler DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
547*60432Shibler   "Return the process named NAME, or nil if there is none.")
548*60432Shibler   (name)
549*60432Shibler      register Lisp_Object name;
550*60432Shibler {
551*60432Shibler   if (XTYPE (name) == Lisp_Process)
552*60432Shibler     return name;
553*60432Shibler   CHECK_STRING (name, 0);
554*60432Shibler   return Fcdr (Fassoc (name, Vprocess_alist));
555*60432Shibler }
556*60432Shibler 
557*60432Shibler DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
558*60432Shibler   "Return the (or, a) process associated with BUFFER.\n\
559*60432Shibler BUFFER may be a buffer or the name of one.")
560*60432Shibler   (name)
561*60432Shibler      register Lisp_Object name;
562*60432Shibler {
563*60432Shibler   register Lisp_Object buf, tail, proc;
564*60432Shibler 
565*60432Shibler   if (NULL (name)) return Qnil;
566*60432Shibler   buf = Fget_buffer (name);
567*60432Shibler   if (NULL (buf)) return Qnil;
568*60432Shibler 
569*60432Shibler   for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
570*60432Shibler     {
571*60432Shibler       proc = Fcdr (Fcar (tail));
572*60432Shibler       if (XTYPE (proc) == Lisp_Process && EQ (XPROCESS (proc)->buffer, buf))
573*60432Shibler 	return proc;
574*60432Shibler     }
575*60432Shibler   return Qnil;
576*60432Shibler }
577*60432Shibler 
578*60432Shibler /* This is how commands for the user decode process arguments */
579*60432Shibler 
580*60432Shibler Lisp_Object
581*60432Shibler get_process (name)
582*60432Shibler      register Lisp_Object name;
583*60432Shibler {
584*60432Shibler   register Lisp_Object proc;
585*60432Shibler   if (NULL (name))
586*60432Shibler     proc = Fget_buffer_process (Fcurrent_buffer ());
587*60432Shibler   else
588*60432Shibler     {
589*60432Shibler       proc = Fget_process (name);
590*60432Shibler       if (NULL (proc))
591*60432Shibler 	proc = Fget_buffer_process (Fget_buffer (name));
592*60432Shibler     }
593*60432Shibler 
594*60432Shibler   if (!NULL (proc))
595*60432Shibler     return proc;
596*60432Shibler 
597*60432Shibler   if (NULL (name))
598*60432Shibler     error ("Current buffer has no process");
599*60432Shibler   else
600*60432Shibler     error ("Process %s does not exist", XSTRING (name)->data);
601*60432Shibler   /* NOTREACHED */
602*60432Shibler }
603*60432Shibler 
604*60432Shibler DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
605*60432Shibler   "Delete PROCESS: kill it and forget about it immediately.\n\
606*60432Shibler PROCESS may be a process or the name of one, or a buffer name.")
607*60432Shibler   (proc)
608*60432Shibler      register Lisp_Object proc;
609*60432Shibler {
610*60432Shibler   proc = get_process (proc);
611*60432Shibler   XPROCESS (proc)->raw_status_low = Qnil;
612*60432Shibler   XPROCESS (proc)->raw_status_high = Qnil;
613*60432Shibler   if (NETCONN_P (proc))
614*60432Shibler     {
615*60432Shibler       XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
616*60432Shibler       XSETINT (XPROCESS (proc)->tick, ++process_tick);
617*60432Shibler     }
618*60432Shibler   else if (XFASTINT (XPROCESS (proc)->infd))
619*60432Shibler     {
620*60432Shibler       Fkill_process (proc, Qnil);
621*60432Shibler       /* Do this now, since remove_process will make sigchld_handler do nothing.  */
622*60432Shibler       XPROCESS (proc)->status
623*60432Shibler 	= Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
624*60432Shibler       XSETINT (XPROCESS (proc)->tick, ++process_tick);
625*60432Shibler       status_notify ();
626*60432Shibler     }
627*60432Shibler   remove_process (proc);
628*60432Shibler   return Qnil;
629*60432Shibler }
630*60432Shibler 
631*60432Shibler DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
632*60432Shibler   "Return the status of PROCESS: a symbol, one of these:\n\
633*60432Shibler run  -- for a process that is running.\n\
634*60432Shibler stop -- for a process stopped but continuable.\n\
635*60432Shibler exit -- for a process that has exited.\n\
636*60432Shibler signal -- for a process that has got a fatal signal.\n\
637*60432Shibler open -- for a network stream connection that is open.\n\
638*60432Shibler closed -- for a network stream connection that is closed.\n\
639*60432Shibler nil -- if arg is a process name and no such process exists.")
640*60432Shibler /* command -- for a command channel opened to Emacs by another process.\n\
641*60432Shibler    external -- for an i/o channel opened to Emacs by another process.\n\  */
642*60432Shibler   (proc)
643*60432Shibler      register Lisp_Object proc;
644*60432Shibler {
645*60432Shibler   register struct Lisp_Process *p;
646*60432Shibler   proc = Fget_process (proc);
647*60432Shibler   if (NULL (proc))
648*60432Shibler     return proc;
649*60432Shibler   p = XPROCESS (proc);
650*60432Shibler   if (!NULL (p->raw_status_low))
651*60432Shibler     update_status (p);
652*60432Shibler   if (XTYPE (p->status) == Lisp_Cons)
653*60432Shibler     return XCONS (p->status)->car;
654*60432Shibler   return p->status;
655*60432Shibler }
656*60432Shibler 
657*60432Shibler DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
658*60432Shibler        1, 1, 0,
659*60432Shibler   "Return the exit status of PROCESS or the signal number that killed it.\n\
660*60432Shibler If PROCESS has not yet exited or died, return 0.")
661*60432Shibler   (proc)
662*60432Shibler      register Lisp_Object proc;
663*60432Shibler {
664*60432Shibler   CHECK_PROCESS (proc, 0);
665*60432Shibler   if (!NULL (XPROCESS (proc)->raw_status_low))
666*60432Shibler     update_status (XPROCESS (proc));
667*60432Shibler   if (XTYPE (XPROCESS (proc)->status) == Lisp_Cons)
668*60432Shibler     return XCONS (XCONS (XPROCESS (proc)->status)->cdr)->car;
669*60432Shibler   return make_number (0);
670*60432Shibler }
671*60432Shibler 
672*60432Shibler DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
673*60432Shibler   "Return the process id of PROCESS.\n\
674*60432Shibler This is the pid of the Unix process which PROCESS uses or talks to.\n\
675*60432Shibler For a network connection, this value is nil.")
676*60432Shibler   (proc)
677*60432Shibler      register Lisp_Object proc;
678*60432Shibler {
679*60432Shibler   CHECK_PROCESS (proc, 0);
680*60432Shibler   return XPROCESS (proc)->pid;
681*60432Shibler }
682*60432Shibler 
683*60432Shibler DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
684*60432Shibler   "Return the name of PROCESS, as a string.\n\
685*60432Shibler This is the name of the program invoked in PROCESS,\n\
686*60432Shibler possibly modified to make it unique among process names.")
687*60432Shibler   (proc)
688*60432Shibler      register Lisp_Object proc;
689*60432Shibler {
690*60432Shibler   CHECK_PROCESS (proc, 0);
691*60432Shibler   return XPROCESS (proc)->name;
692*60432Shibler }
693*60432Shibler 
694*60432Shibler DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
695*60432Shibler   "Return the command that was executed to start PROCESS.\n\
696*60432Shibler This is a list of strings, the first string being the program executed\n\
697*60432Shibler and the rest of the strings being the arguments given to it.\n\
698*60432Shibler For a non-child channel, this is nil.")
699*60432Shibler   (proc)
700*60432Shibler      register Lisp_Object proc;
701*60432Shibler {
702*60432Shibler   CHECK_PROCESS (proc, 0);
703*60432Shibler   return XPROCESS (proc)->command;
704*60432Shibler }
705*60432Shibler 
706*60432Shibler DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
707*60432Shibler   2, 2, 0,
708*60432Shibler   "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
709*60432Shibler   (proc, buffer)
710*60432Shibler      register Lisp_Object proc, buffer;
711*60432Shibler {
712*60432Shibler   CHECK_PROCESS (proc, 0);
713*60432Shibler   if (!NULL (buffer))
714*60432Shibler     CHECK_BUFFER (buffer, 1);
715*60432Shibler   XPROCESS (proc)->buffer = buffer;
716*60432Shibler   return buffer;
717*60432Shibler }
718*60432Shibler 
719*60432Shibler DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
720*60432Shibler   1, 1, 0,
721*60432Shibler   "Return the buffer PROCESS is associated with.\n\
722*60432Shibler Output from PROCESS is inserted in this buffer\n\
723*60432Shibler unless PROCESS has a filter.")
724*60432Shibler   (proc)
725*60432Shibler      register Lisp_Object proc;
726*60432Shibler {
727*60432Shibler   CHECK_PROCESS (proc, 0);
728*60432Shibler   return XPROCESS (proc)->buffer;
729*60432Shibler }
730*60432Shibler 
731*60432Shibler DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
732*60432Shibler   1, 1, 0,
733*60432Shibler   "Return the marker for the end of the last output from PROCESS.")
734*60432Shibler   (proc)
735*60432Shibler      register Lisp_Object proc;
736*60432Shibler {
737*60432Shibler   CHECK_PROCESS (proc, 0);
738*60432Shibler   return XPROCESS (proc)->mark;
739*60432Shibler }
740*60432Shibler 
741*60432Shibler DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
742*60432Shibler   2, 2, 0,
743*60432Shibler   "Give PROCESS the filter function FILTER; nil means no filter.\n\
744*60432Shibler When a process has a filter, each time it does output\n\
745*60432Shibler the entire string of output is passed to the filter.\n\
746*60432Shibler The filter gets two arguments: the process and the string of output.\n\
747*60432Shibler If the process has a filter, its buffer is not used for output.")
748*60432Shibler   (proc, filter)
749*60432Shibler      register Lisp_Object proc, filter;
750*60432Shibler {
751*60432Shibler   CHECK_PROCESS (proc, 0);
752*60432Shibler   XPROCESS (proc)->filter = filter;
753*60432Shibler   return filter;
754*60432Shibler }
755*60432Shibler 
756*60432Shibler DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
757*60432Shibler   1, 1, 0,
758*60432Shibler   "Returns the filter function of PROCESS; nil if none.\n\
759*60432Shibler See set-process-filter for more info on filter functions.")
760*60432Shibler   (proc)
761*60432Shibler      register Lisp_Object proc;
762*60432Shibler {
763*60432Shibler   CHECK_PROCESS (proc, 0);
764*60432Shibler   return XPROCESS (proc)->filter;
765*60432Shibler }
766*60432Shibler 
767*60432Shibler DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
768*60432Shibler   2, 2, 0,
769*60432Shibler   "Give PROCESS the sentinel SENTINEL; nil for none.\n\
770*60432Shibler The sentinel is called as a function when the process changes state.\n\
771*60432Shibler It gets two arguments: the process, and a string describing the change.")
772*60432Shibler   (proc, sentinel)
773*60432Shibler      register Lisp_Object proc, sentinel;
774*60432Shibler {
775*60432Shibler   CHECK_PROCESS (proc, 0);
776*60432Shibler   XPROCESS (proc)->sentinel = sentinel;
777*60432Shibler   return sentinel;
778*60432Shibler }
779*60432Shibler 
780*60432Shibler DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
781*60432Shibler   1, 1, 0,
782*60432Shibler   "Return the sentinel of PROCESS; nil if none.\n\
783*60432Shibler See set-process-sentinel for more info on sentinels.")
784*60432Shibler   (proc)
785*60432Shibler      register Lisp_Object proc;
786*60432Shibler {
787*60432Shibler   CHECK_PROCESS (proc, 0);
788*60432Shibler   return XPROCESS (proc)->sentinel;
789*60432Shibler }
790*60432Shibler 
791*60432Shibler DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
792*60432Shibler   Sprocess_kill_without_query, 1, 2, 0,
793*60432Shibler   "Say no query needed if PROCESS is running when Emacs is exited.\n\
794*60432Shibler Optional second argument if non-nil says to require a query.\n\
795*60432Shibler Value is t if a query was formerly required.")
796*60432Shibler   (proc, value)
797*60432Shibler      register Lisp_Object proc, value;
798*60432Shibler {
799*60432Shibler   Lisp_Object tem;
800*60432Shibler   CHECK_PROCESS (proc, 0);
801*60432Shibler   tem = XPROCESS (proc)->kill_without_query;
802*60432Shibler   XPROCESS (proc)->kill_without_query = Fnull (value);
803*60432Shibler   return Fnull (tem);
804*60432Shibler }
805*60432Shibler 
806*60432Shibler Lisp_Object
807*60432Shibler list_processes_1 ()
808*60432Shibler {
809*60432Shibler   register Lisp_Object tail, tem;
810*60432Shibler   Lisp_Object proc, minspace, tem1;
811*60432Shibler   register struct buffer *old = current_buffer;
812*60432Shibler   register struct Lisp_Process *p;
813*60432Shibler   register int state;
814*60432Shibler   char tembuf[80];
815*60432Shibler 
816*60432Shibler   XFASTINT (minspace) = 1;
817*60432Shibler 
818*60432Shibler   set_buffer_internal (XBUFFER (Vstandard_output));
819*60432Shibler   Fbuffer_flush_undo (Vstandard_output);
820*60432Shibler 
821*60432Shibler   current_buffer->truncate_lines = Qt;
822*60432Shibler 
823*60432Shibler   write_string ("\
824*60432Shibler Proc         Status   Buffer         Command\n\
825*60432Shibler ----         ------   ------         -------\n", -1);
826*60432Shibler 
827*60432Shibler   for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
828*60432Shibler     {
829*60432Shibler       Lisp_Object symbol;
830*60432Shibler 
831*60432Shibler       proc = Fcdr (Fcar (tail));
832*60432Shibler       p = XPROCESS (proc);
833*60432Shibler       if (NULL (p->childp))
834*60432Shibler 	continue;
835*60432Shibler 
836*60432Shibler       Finsert (1, &p->name);
837*60432Shibler       Findent_to (make_number (13), minspace);
838*60432Shibler 
839*60432Shibler       if (!NULL (p->raw_status_low))
840*60432Shibler 	update_status (p);
841*60432Shibler       symbol = p->status;
842*60432Shibler       if (XTYPE (p->status) == Lisp_Cons)
843*60432Shibler 	symbol = XCONS (p->status)->car;
844*60432Shibler 
845*60432Shibler       if (EQ (symbol, Qsignal))
846*60432Shibler 	{
847*60432Shibler 	  Lisp_Object tem;
848*60432Shibler 	  tem = Fcar (Fcdr (p->status));
849*60432Shibler 	  if (XINT (tem) < NSIG)
850*60432Shibler 	    write_string (sys_siglist [XINT (tem)], -1);
851*60432Shibler 	  else
852*60432Shibler 	    Fprinc (symbol, Qnil);
853*60432Shibler 	}
854*60432Shibler       else
855*60432Shibler 	Fprinc (symbol, Qnil);
856*60432Shibler 
857*60432Shibler       if (EQ (symbol, Qexit))
858*60432Shibler 	{
859*60432Shibler 	  Lisp_Object tem;
860*60432Shibler 	  tem = Fcar (Fcdr (p->status));
861*60432Shibler 	  if (XFASTINT (tem))
862*60432Shibler 	    {
863*60432Shibler 	      sprintf (tembuf, " %d", XFASTINT (tem));
864*60432Shibler 	      write_string (tembuf, -1);
865*60432Shibler 	    }
866*60432Shibler 	}
867*60432Shibler 
868*60432Shibler       if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
869*60432Shibler 	remove_process (proc);
870*60432Shibler 
871*60432Shibler       Findent_to (make_number (22), minspace);
872*60432Shibler       if (NULL (p->buffer))
873*60432Shibler 	InsStr ("(none)");
874*60432Shibler       else if (NULL (XBUFFER (p->buffer)->name))
875*60432Shibler 	InsStr ("(Killed)");
876*60432Shibler       else
877*60432Shibler 	Finsert (1, &XBUFFER (p->buffer)->name);
878*60432Shibler 
879*60432Shibler       Findent_to (make_number (37), minspace);
880*60432Shibler 
881*60432Shibler       if (NETCONN_P (proc))
882*60432Shibler         {
883*60432Shibler 	  sprintf (tembuf, "(network stream connection to %s)\n",
884*60432Shibler 		   XSTRING (p->childp)->data);
885*60432Shibler 	  InsStr (tembuf);
886*60432Shibler         }
887*60432Shibler       else
888*60432Shibler 	{
889*60432Shibler 	  tem = p->command;
890*60432Shibler 	  while (1)
891*60432Shibler 	    {
892*60432Shibler 	      tem1 = Fcar (tem);
893*60432Shibler 	      Finsert (1, &tem1);
894*60432Shibler 	      tem = Fcdr (tem);
895*60432Shibler 	      if (NULL (tem))
896*60432Shibler 		break;
897*60432Shibler 	      InsStr (" ");
898*60432Shibler 	    }
899*60432Shibler 	  InsStr ("\n");
900*60432Shibler        }
901*60432Shibler     }
902*60432Shibler 
903*60432Shibler   return Qnil;
904*60432Shibler }
905*60432Shibler 
906*60432Shibler DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",
907*60432Shibler   "Display a list of all processes.\n\
908*60432Shibler \(Any processes listed as Exited or Signaled are actually eliminated\n\
909*60432Shibler after the listing is made.)")
910*60432Shibler   ()
911*60432Shibler {
912*60432Shibler   internal_with_output_to_temp_buffer ("*Process List*",
913*60432Shibler 				       list_processes_1, Qnil);
914*60432Shibler   return Qnil;
915*60432Shibler }
916*60432Shibler 
917*60432Shibler DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
918*60432Shibler   "Return a list of all processes.")
919*60432Shibler   ()
920*60432Shibler {
921*60432Shibler   return Fmapcar (Qcdr, Vprocess_alist);
922*60432Shibler }
923*60432Shibler 
924*60432Shibler DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
925*60432Shibler   "Start a program in a subprocess.  Return the process object for it.\n\
926*60432Shibler Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
927*60432Shibler NAME is name for process.  It is modified if necessary to make it unique.\n\
928*60432Shibler BUFFER is the buffer or (buffer-name) to associate with the process.\n\
929*60432Shibler  Process output goes at end of that buffer, unless you specify\n\
930*60432Shibler  an output stream or filter function to handle the output.\n\
931*60432Shibler  BUFFER may be also nil, meaning that this process is not associated\n\
932*60432Shibler  with any buffer\n\
933*60432Shibler Third arg is program file name.  It is searched for as in the shell.\n\
934*60432Shibler Remaining arguments are strings to give program as arguments.")
935*60432Shibler   (nargs, args)
936*60432Shibler      int nargs;
937*60432Shibler      register Lisp_Object *args;
938*60432Shibler {
939*60432Shibler   Lisp_Object buffer, name, program, proc, tem;
940*60432Shibler   register unsigned char **new_argv;
941*60432Shibler   register int i;
942*60432Shibler 
943*60432Shibler   buffer = args[1];
944*60432Shibler   if (!NULL (buffer))
945*60432Shibler     buffer = Fget_buffer_create (buffer);
946*60432Shibler 
947*60432Shibler   name = args[0];
948*60432Shibler   CHECK_STRING (name, 0);
949*60432Shibler 
950*60432Shibler   program = args[2];
951*60432Shibler 
952*60432Shibler   CHECK_STRING (program, 2);
953*60432Shibler 
954*60432Shibler   new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
955*60432Shibler 
956*60432Shibler   for (i = 3; i < nargs; i++)
957*60432Shibler     {
958*60432Shibler       tem = args[i];
959*60432Shibler       CHECK_STRING (tem, i);
960*60432Shibler       new_argv[i - 2] = XSTRING (tem)->data;
961*60432Shibler     }
962*60432Shibler   new_argv[i - 2] = 0;
963*60432Shibler   new_argv[0] = XSTRING (program)->data;
964*60432Shibler 
965*60432Shibler   /* If program file name is not absolute, search our path for it */
966*60432Shibler   if (new_argv[0][0] != '/')
967*60432Shibler     {
968*60432Shibler       tem = Qnil;
969*60432Shibler       openp (Vexec_path, program, "", &tem, 1);
970*60432Shibler       if (NULL (tem))
971*60432Shibler 	report_file_error ("Searching for program", Fcons (program, Qnil));
972*60432Shibler       new_argv[0] = XSTRING (tem)->data;
973*60432Shibler     }
974*60432Shibler 
975*60432Shibler   proc = make_process (name);
976*60432Shibler 
977*60432Shibler   XPROCESS (proc)->childp = Qt;
978*60432Shibler   XPROCESS (proc)->command_channel_p = Qnil;
979*60432Shibler   XPROCESS (proc)->buffer = buffer;
980*60432Shibler   XPROCESS (proc)->sentinel = Qnil;
981*60432Shibler   XPROCESS (proc)->filter = Qnil;
982*60432Shibler   XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
983*60432Shibler 
984*60432Shibler   create_process (proc, new_argv);
985*60432Shibler 
986*60432Shibler   return proc;
987*60432Shibler }
988*60432Shibler 
989*60432Shibler create_process_1 (signo)
990*60432Shibler      int signo;
991*60432Shibler {
992*60432Shibler #ifdef USG
993*60432Shibler   /* USG systems forget handlers when they are used;
994*60432Shibler      must reestablish each time */
995*60432Shibler   signal (signo, create_process_1);
996*60432Shibler #endif /* USG */
997*60432Shibler }
998*60432Shibler 
999*60432Shibler #if 0  /* This doesn't work; see the note before sigchld_handler.  */
1000*60432Shibler #ifdef USG
1001*60432Shibler #ifdef SIGCHLD
1002*60432Shibler /* Mimic blocking of signals on system V, which doesn't really have it.  */
1003*60432Shibler 
1004*60432Shibler /* Nonzero means we got a SIGCHLD when it was supposed to be blocked.  */
1005*60432Shibler int sigchld_deferred;
1006*60432Shibler 
1007*60432Shibler create_process_sigchld ()
1008*60432Shibler {
1009*60432Shibler   signal (SIGCHLD, create_process_sigchld);
1010*60432Shibler 
1011*60432Shibler   sigchld_deferred = 1;
1012*60432Shibler }
1013*60432Shibler #endif
1014*60432Shibler #endif
1015*60432Shibler #endif
1016*60432Shibler 
1017*60432Shibler create_process (process, new_argv)
1018*60432Shibler      Lisp_Object process;
1019*60432Shibler      char **new_argv;
1020*60432Shibler {
1021*60432Shibler   int pid, inchannel, outchannel, forkin, forkout;
1022*60432Shibler   int sv[2];
1023*60432Shibler #ifdef SIGCHLD
1024*60432Shibler   int (*sigchld)();
1025*60432Shibler #endif
1026*60432Shibler   char **env;
1027*60432Shibler   int pty_flag = 0;
1028*60432Shibler   extern char **environ;
1029*60432Shibler 
1030*60432Shibler #ifdef MAINTAIN_ENVIRONMENT
1031*60432Shibler   env = (char **) alloca (size_of_current_environ ());
1032*60432Shibler   get_current_environ (env);
1033*60432Shibler #else
1034*60432Shibler   env = environ;
1035*60432Shibler #endif /* MAINTAIN_ENVIRONMENT */
1036*60432Shibler 
1037*60432Shibler   inchannel = outchannel = -1;
1038*60432Shibler 
1039*60432Shibler #ifdef HAVE_PTYS
1040*60432Shibler   if (EQ (Vprocess_connection_type, Qt))
1041*60432Shibler     outchannel = inchannel = allocate_pty ();
1042*60432Shibler 
1043*60432Shibler   if (inchannel >= 0)
1044*60432Shibler     {
1045*60432Shibler #ifndef USG
1046*60432Shibler       /* On USG systems it does not work to open
1047*60432Shibler 	 the pty's tty here and then close and reopen it in the child.  */
1048*60432Shibler       forkout = forkin = open (pty_name, O_RDWR, 0);
1049*60432Shibler       if (forkin < 0)
1050*60432Shibler 	report_file_error ("Opening pty", Qnil);
1051*60432Shibler #else
1052*60432Shibler       forkin = forkout = -1;
1053*60432Shibler #endif
1054*60432Shibler       pty_flag = 1;
1055*60432Shibler     }
1056*60432Shibler   else
1057*60432Shibler #endif /* HAVE_PTYS */
1058*60432Shibler #ifdef SKTPAIR
1059*60432Shibler     {
1060*60432Shibler       if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0)
1061*60432Shibler 	report_file_error ("Opening socketpair", Qnil);
1062*60432Shibler       outchannel = inchannel = sv[0];
1063*60432Shibler       forkout = forkin = sv[1];
1064*60432Shibler     }
1065*60432Shibler #else /* not SKTPAIR */
1066*60432Shibler     {
1067*60432Shibler       pipe (sv);
1068*60432Shibler       inchannel = sv[0];
1069*60432Shibler       forkout = sv[1];
1070*60432Shibler       pipe (sv);
1071*60432Shibler       outchannel = sv[1];
1072*60432Shibler       forkin = sv[0];
1073*60432Shibler     }
1074*60432Shibler #endif /* not SKTPAIR */
1075*60432Shibler 
1076*60432Shibler #if 0
1077*60432Shibler   /* Replaced by close_process_descs */
1078*60432Shibler   set_exclusive_use (inchannel);
1079*60432Shibler   set_exclusive_use (outchannel);
1080*60432Shibler #endif
1081*60432Shibler 
1082*60432Shibler /* Stride people say it's a mystery why this is needed
1083*60432Shibler    as well as the O_NDELAY, but that it fails without this.  */
1084*60432Shibler #ifdef STRIDE
1085*60432Shibler   {
1086*60432Shibler     int one = 1;
1087*60432Shibler     ioctl (inchannel, FIONBIO, &one);
1088*60432Shibler   }
1089*60432Shibler #endif
1090*60432Shibler 
1091*60432Shibler #ifdef O_NONBLOCK
1092*60432Shibler   fcntl (inchannel, F_SETFL, O_NONBLOCK);
1093*60432Shibler #else
1094*60432Shibler #ifdef O_NDELAY
1095*60432Shibler   fcntl (inchannel, F_SETFL, O_NDELAY);
1096*60432Shibler #endif
1097*60432Shibler #endif
1098*60432Shibler 
1099*60432Shibler   /* Record this as an active process, with its channels.
1100*60432Shibler      As a result, child_setup will close Emacs's side of the pipes.  */
1101*60432Shibler   chan_process[inchannel] = process;
1102*60432Shibler   XFASTINT (XPROCESS (process)->infd) = inchannel;
1103*60432Shibler   XFASTINT (XPROCESS (process)->outfd) = outchannel;
1104*60432Shibler   XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
1105*60432Shibler   XPROCESS (process)->status = Qrun;
1106*60432Shibler 
1107*60432Shibler   /* Delay interrupts until we have a chance to store
1108*60432Shibler      the new fork's pid in its process structure */
1109*60432Shibler #ifdef SIGCHLD
1110*60432Shibler #ifdef BSD4_1
1111*60432Shibler   sighold (SIGCHLD);
1112*60432Shibler #else /* not BSD4_1 */
1113*60432Shibler #ifdef HPUX
1114*60432Shibler   sigsetmask (1 << (SIGCHLD - 1));
1115*60432Shibler #else /* not HPUX */
1116*60432Shibler #if defined (BSD) || defined (UNIPLUS)
1117*60432Shibler   sigsetmask (1 << (SIGCHLD - 1));
1118*60432Shibler #else /* ordinary USG */
1119*60432Shibler #if 0
1120*60432Shibler   sigchld_deferred = 0;
1121*60432Shibler   sigchld = (int (*)()) signal (SIGCHLD, create_process_sigchld);
1122*60432Shibler #endif
1123*60432Shibler #endif /* ordinary USG */
1124*60432Shibler #endif /* not HPUX */
1125*60432Shibler #endif /* not BSD4_1 */
1126*60432Shibler #endif /* SIGCHLD */
1127*60432Shibler 
1128*60432Shibler   /* Until we store the proper pid, enable sigchld_handler
1129*60432Shibler      to recognize an unknown pid as standing for this process.  */
1130*60432Shibler   XSETINT (XPROCESS (process)->pid, -1);
1131*60432Shibler 
1132*60432Shibler   {
1133*60432Shibler     /* child_setup must clobber environ on systems with true vfork.
1134*60432Shibler        Protect it from permanent change.  */
1135*60432Shibler     char **save_environ = environ;
1136*60432Shibler 
1137*60432Shibler     pid = vfork ();
1138*60432Shibler     if (pid == 0)
1139*60432Shibler       {
1140*60432Shibler 	int xforkin = forkin;
1141*60432Shibler 	int xforkout = forkout;
1142*60432Shibler 
1143*60432Shibler #if 0 /* This was probably a mistake--it duplicates code later on,
1144*60432Shibler 	 but fails to handle all the cases.  */
1145*60432Shibler 	/* Make SIGCHLD work again in the child.  */
1146*60432Shibler 	sigsetmask (0);
1147*60432Shibler #endif
1148*60432Shibler 
1149*60432Shibler 	/* Make the pty be the controlling terminal of the process.  */
1150*60432Shibler #ifdef HAVE_PTYS
1151*60432Shibler 	/* First, disconnect its current controlling terminal.  */
1152*60432Shibler #ifdef HAVE_SETSID
1153*60432Shibler 	setsid ();
1154*60432Shibler #else /* not HAVE_SETSID */
1155*60432Shibler #ifdef USG
1156*60432Shibler 	/* It's very important to call setpgrp() here and no time
1157*60432Shibler 	   afterwards.  Otherwise, we lose our controlling tty which
1158*60432Shibler 	   is set when we open the pty. */
1159*60432Shibler 	setpgrp ();
1160*60432Shibler #endif /* USG */
1161*60432Shibler #endif /* not HAVE_SETSID */
1162*60432Shibler #ifdef TIOCNOTTY
1163*60432Shibler 	/* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1164*60432Shibler 	   can do TIOCSPGRP only to the process's controlling tty.  */
1165*60432Shibler 	if (pty_flag)
1166*60432Shibler 	  {
1167*60432Shibler 	    /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1168*60432Shibler 	       I can't test it since I don't have 4.3.  */
1169*60432Shibler 	    int j = open ("/dev/tty", O_RDWR, 0);
1170*60432Shibler 	    ioctl (j, TIOCNOTTY, 0);
1171*60432Shibler 	    close (j);
1172*60432Shibler #ifndef USG
1173*60432Shibler 	    /* In order to get a controlling terminal on some versions
1174*60432Shibler 	       of BSD, it is necessary to put the process in pgrp 0
1175*60432Shibler 	       before it opens the terminal.  */
1176*60432Shibler 	    setpgrp (0, 0);
1177*60432Shibler #endif
1178*60432Shibler 	  }
1179*60432Shibler #endif /* TIOCNOTTY */
1180*60432Shibler 
1181*60432Shibler #if !defined (RTU) && !defined (UNIPLUS)
1182*60432Shibler /*** There is a suggestion that this ought to be a
1183*60432Shibler      conditional on TIOCSPGRP.  */
1184*60432Shibler 	/* Now close the pty (if we had it open) and reopen it.
1185*60432Shibler 	   This makes the pty the controlling terminal of the subprocess.  */
1186*60432Shibler 	if (pty_flag)
1187*60432Shibler 	  {
1188*60432Shibler 	    /* I wonder if close (open (pty_name, ...)) would work?  */
1189*60432Shibler 	    if (xforkin >= 0)
1190*60432Shibler 	      close (xforkin);
1191*60432Shibler 	    xforkout = xforkin = open (pty_name, O_RDWR, 0);
1192*60432Shibler 
1193*60432Shibler 	    if (xforkin < 0)
1194*60432Shibler 	      abort ();
1195*60432Shibler 	  }
1196*60432Shibler #endif /* not UNIPLUS and not RTU */
1197*60432Shibler #ifdef SETUP_SLAVE_PTY
1198*60432Shibler 	SETUP_SLAVE_PTY;
1199*60432Shibler #endif /* SETUP_SLAVE_PTY */
1200*60432Shibler #ifdef AIX
1201*60432Shibler 	/* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1202*60432Shibler 	   Now reenable it in the child, so it will die when we want it to.  */
1203*60432Shibler 	if (pty_flag)
1204*60432Shibler 	  signal (SIGHUP, SIG_DFL);
1205*60432Shibler #endif
1206*60432Shibler #endif /* HAVE_PTYS */
1207*60432Shibler #ifdef SIGCHLD
1208*60432Shibler #ifdef BSD4_1
1209*60432Shibler 	sigrelse (SIGCHLD);
1210*60432Shibler #else /* not BSD4_1 */
1211*60432Shibler #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1212*60432Shibler 	sigsetmask (0);
1213*60432Shibler #else /* ordinary USG */
1214*60432Shibler 	signal (SIGCHLD, sigchld);
1215*60432Shibler #endif /* ordinary USG */
1216*60432Shibler #endif /* not BSD4_1 */
1217*60432Shibler #endif /* SIGCHLD */
1218*60432Shibler 	child_setup_tty (xforkout);
1219*60432Shibler 	child_setup (xforkin, xforkout, xforkout, new_argv, env);
1220*60432Shibler       }
1221*60432Shibler     environ = save_environ;
1222*60432Shibler   }
1223*60432Shibler 
1224*60432Shibler   if (pid < 0)
1225*60432Shibler     {
1226*60432Shibler       remove_process (process);
1227*60432Shibler       report_file_error ("Doing vfork", Qnil);
1228*60432Shibler     }
1229*60432Shibler 
1230*60432Shibler   XFASTINT (XPROCESS (process)->pid) = pid;
1231*60432Shibler 
1232*60432Shibler   FD_SET (inchannel, &input_wait_mask);
1233*60432Shibler 
1234*60432Shibler   /* If the subfork execv fails, and it exits,
1235*60432Shibler      this close hangs.  I don't know why.
1236*60432Shibler      So have an interrupt jar it loose.  */
1237*60432Shibler   stop_polling ();
1238*60432Shibler   signal (SIGALRM, create_process_1);
1239*60432Shibler   alarm (1);
1240*60432Shibler   if (forkin >= 0)
1241*60432Shibler     close (forkin);
1242*60432Shibler   alarm (0);
1243*60432Shibler   start_polling ();
1244*60432Shibler   if (forkin != forkout && forkout >= 0)
1245*60432Shibler     close (forkout);
1246*60432Shibler 
1247*60432Shibler #ifdef SIGCHLD
1248*60432Shibler #ifdef BSD4_1
1249*60432Shibler   sigrelse (SIGCHLD);
1250*60432Shibler #else /* not BSD4_1 */
1251*60432Shibler #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1252*60432Shibler   sigsetmask (0);
1253*60432Shibler #else /* ordinary USG */
1254*60432Shibler #if 0
1255*60432Shibler   signal (SIGCHLD, sigchld);
1256*60432Shibler   /* Now really handle any of these signals
1257*60432Shibler      that came in during this function.  */
1258*60432Shibler   if (sigchld_deferred)
1259*60432Shibler     kill (getpid (), SIGCHLD);
1260*60432Shibler #endif
1261*60432Shibler #endif /* ordinary USG */
1262*60432Shibler #endif /* not BSD4_1 */
1263*60432Shibler #endif /* SIGCHLD */
1264*60432Shibler }
1265*60432Shibler 
1266*60432Shibler #ifdef HAVE_SOCKETS
1267*60432Shibler 
1268*60432Shibler /* open a TCP network connection to a given HOST/SERVICE.  Treated
1269*60432Shibler    exactly like a normal process when reading and writing.  Only
1270*60432Shibler    differences are in status display and process deletion.  A network
1271*60432Shibler    connection has no PID; you cannot signal it.  All you can do is
1272*60432Shibler    deactivate and close it via delete-process */
1273*60432Shibler 
1274*60432Shibler DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,
1275*60432Shibler        4, 4, 0,
1276*60432Shibler   "Open a TCP connection for a service to a host.\n\
1277*60432Shibler Returns a subprocess-object to represent the connection.\n\
1278*60432Shibler Input and output work as for subprocesses; `delete-process' closes it.\n\
1279*60432Shibler Args are NAME BUFFER HOST SERVICE.\n\
1280*60432Shibler NAME is name for process.  It is modified if necessary to make it unique.\n\
1281*60432Shibler BUFFER is the buffer (or buffer-name) to associate with the process.\n\
1282*60432Shibler  Process output goes at end of that buffer, unless you specify\n\
1283*60432Shibler  an output stream or filter function to handle the output.\n\
1284*60432Shibler  BUFFER may be also nil, meaning that this process is not associated\n\
1285*60432Shibler  with any buffer\n\
1286*60432Shibler Third arg is name of the host to connect to.\n\
1287*60432Shibler Fourth arg SERVICE is name of the service desired, or an integer\n\
1288*60432Shibler  specifying a port number to connect to.")
1289*60432Shibler    (name, buffer, host, service)
1290*60432Shibler       Lisp_Object name, buffer, host, service;
1291*60432Shibler {
1292*60432Shibler   Lisp_Object proc;
1293*60432Shibler   register int i;
1294*60432Shibler   struct sockaddr_in address;
1295*60432Shibler   struct servent *svc_info;
1296*60432Shibler   struct hostent *host_info;
1297*60432Shibler   int s, outch, inch;
1298*60432Shibler   char errstring[80];
1299*60432Shibler   int port;
1300*60432Shibler   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1301*60432Shibler 
1302*60432Shibler   GCPRO4 (name, buffer, host, service);
1303*60432Shibler   CHECK_STRING (name, 0);
1304*60432Shibler   CHECK_STRING (host, 0);
1305*60432Shibler   if (XTYPE(service) == Lisp_Int)
1306*60432Shibler     port = htons ((unsigned short) XINT (service));
1307*60432Shibler   else
1308*60432Shibler     {
1309*60432Shibler       CHECK_STRING (service, 0);
1310*60432Shibler       svc_info = getservbyname (XSTRING (service)->data, "tcp");
1311*60432Shibler       if (svc_info == 0)
1312*60432Shibler 	error ("Unknown service \"%s\"", XSTRING (service)->data);
1313*60432Shibler       port = svc_info->s_port;
1314*60432Shibler     }
1315*60432Shibler 
1316*60432Shibler   host_info = gethostbyname (XSTRING (host)->data);
1317*60432Shibler   if (host_info == 0)
1318*60432Shibler     error ("Unknown host \"%s\"", XSTRING(host)->data);
1319*60432Shibler 
1320*60432Shibler   bzero (&address, sizeof address);
1321*60432Shibler   bcopy (host_info->h_addr, (char *) &address.sin_addr, host_info->h_length);
1322*60432Shibler   address.sin_family = host_info->h_addrtype;
1323*60432Shibler   address.sin_port = port;
1324*60432Shibler 
1325*60432Shibler   s = socket (host_info->h_addrtype, SOCK_STREAM, 0);
1326*60432Shibler   if (s < 0)
1327*60432Shibler     report_file_error ("error creating socket", Fcons (name, Qnil));
1328*60432Shibler 
1329*60432Shibler   if (connect (s, &address, sizeof address) == -1)
1330*60432Shibler     {
1331*60432Shibler       close (s);
1332*60432Shibler       error ("Host \"%s\" not responding", XSTRING (host)->data);
1333*60432Shibler     }
1334*60432Shibler 
1335*60432Shibler   inch = s;
1336*60432Shibler   outch = dup (s);
1337*60432Shibler   if (outch < 0)
1338*60432Shibler     report_file_error ("error duplicating socket", Fcons (name, Qnil));
1339*60432Shibler 
1340*60432Shibler   if (!NULL (buffer))
1341*60432Shibler     buffer = Fget_buffer_create (buffer);
1342*60432Shibler   proc = make_process (name);
1343*60432Shibler 
1344*60432Shibler   chan_process[inch] = proc;
1345*60432Shibler 
1346*60432Shibler #ifdef O_NONBLOCK
1347*60432Shibler   fcntl (inch, F_SETFL, O_NONBLOCK);
1348*60432Shibler #else
1349*60432Shibler #ifdef O_NDELAY
1350*60432Shibler   fcntl (inch, F_SETFL, O_NDELAY);
1351*60432Shibler #endif
1352*60432Shibler #endif
1353*60432Shibler 
1354*60432Shibler   XPROCESS (proc)->childp = host;
1355*60432Shibler   XPROCESS (proc)->command_channel_p = Qnil;
1356*60432Shibler   XPROCESS (proc)->buffer = buffer;
1357*60432Shibler   XPROCESS (proc)->sentinel = Qnil;
1358*60432Shibler   XPROCESS (proc)->filter = Qnil;
1359*60432Shibler   XPROCESS (proc)->command = Qnil;
1360*60432Shibler   XPROCESS (proc)->pid = Qnil;
1361*60432Shibler   XPROCESS (proc)->kill_without_query = Qt;
1362*60432Shibler   XFASTINT (XPROCESS (proc)->infd) = s;
1363*60432Shibler   XFASTINT (XPROCESS (proc)->outfd) = outch;
1364*60432Shibler   XPROCESS (proc)->status = Qrun;
1365*60432Shibler   FD_SET (inch, &input_wait_mask);
1366*60432Shibler 
1367*60432Shibler   UNGCPRO;
1368*60432Shibler   return proc;
1369*60432Shibler }
1370*60432Shibler #endif	/* HAVE_SOCKETS */
1371*60432Shibler 
1372*60432Shibler deactivate_process (proc)
1373*60432Shibler      Lisp_Object proc;
1374*60432Shibler {
1375*60432Shibler   register int inchannel, outchannel;
1376*60432Shibler   register struct Lisp_Process *p = XPROCESS (proc);
1377*60432Shibler 
1378*60432Shibler   inchannel = XFASTINT (p->infd);
1379*60432Shibler   outchannel = XFASTINT (p->outfd);
1380*60432Shibler 
1381*60432Shibler   if (inchannel)
1382*60432Shibler     {
1383*60432Shibler       /* Beware SIGCHLD hereabouts. */
1384*60432Shibler       flush_pending_output (inchannel);
1385*60432Shibler       close (inchannel);
1386*60432Shibler       if (outchannel  &&  outchannel != inchannel)
1387*60432Shibler  	close (outchannel);
1388*60432Shibler 
1389*60432Shibler       XFASTINT (p->infd) = 0;
1390*60432Shibler       XFASTINT (p->outfd) = 0;
1391*60432Shibler       chan_process[inchannel] = Qnil;
1392*60432Shibler       FD_CLR (inchannel, &input_wait_mask);
1393*60432Shibler     }
1394*60432Shibler }
1395*60432Shibler 
1396*60432Shibler /* Close all descriptors currently in use for communication
1397*60432Shibler    with subprocess.  This is used in a newly-forked subprocess
1398*60432Shibler    to get rid of irrelevant descriptors.  */
1399*60432Shibler 
1400*60432Shibler close_process_descs ()
1401*60432Shibler {
1402*60432Shibler   int i;
1403*60432Shibler   for (i = 0; i < MAXDESC; i++)
1404*60432Shibler     {
1405*60432Shibler       Lisp_Object process;
1406*60432Shibler       process = chan_process[i];
1407*60432Shibler       if (!NULL (process))
1408*60432Shibler 	{
1409*60432Shibler 	  int in = XFASTINT (XPROCESS (process)->infd);
1410*60432Shibler 	  int out = XFASTINT (XPROCESS (process)->outfd);
1411*60432Shibler 	  close (in);
1412*60432Shibler 	  if (in != out)
1413*60432Shibler 	    close (out);
1414*60432Shibler 	}
1415*60432Shibler     }
1416*60432Shibler }
1417*60432Shibler 
1418*60432Shibler DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
1419*60432Shibler   0, 1, 0,
1420*60432Shibler   "Allow any pending output from subprocesses to be read by Emacs.\n\
1421*60432Shibler It is read into the process' buffers or given to their filter functions.\n\
1422*60432Shibler Non-nil arg PROCESS means do not return until some output has been received\n\
1423*60432Shibler from PROCESS.")
1424*60432Shibler   (proc)
1425*60432Shibler      register Lisp_Object proc;
1426*60432Shibler {
1427*60432Shibler   if (NULL (proc))
1428*60432Shibler     wait_reading_process_input (-1, 0, 0);
1429*60432Shibler   else
1430*60432Shibler     {
1431*60432Shibler       proc = get_process (proc);
1432*60432Shibler       wait_reading_process_input (0, XPROCESS (proc), 0);
1433*60432Shibler     }
1434*60432Shibler   return Qnil;
1435*60432Shibler }
1436*60432Shibler 
1437*60432Shibler /* This variable is different from waiting_for_input in keyboard.c.
1438*60432Shibler    It is used to communicate to a lisp process-filter/sentinel (via the
1439*60432Shibler    function Fwaiting_for_user_input_p below) whether emacs was waiting
1440*60432Shibler    for user-input when that process-filter was called.
1441*60432Shibler    waiting_for_input cannot be used as that is by definition 0 when
1442*60432Shibler    lisp code is being evalled */
1443*60432Shibler static int waiting_for_user_input_p;
1444*60432Shibler 
1445*60432Shibler /* Read and dispose of subprocess output
1446*60432Shibler  while waiting for timeout to elapse and/or keyboard input to be available.
1447*60432Shibler 
1448*60432Shibler  time_limit is the timeout in seconds, or zero for no limit.
1449*60432Shibler  -1 means gobble data available immediately but don't wait for any.
1450*60432Shibler 
1451*60432Shibler  read_kbd is 1 to return when input is available.
1452*60432Shibler  -1 means caller will actually read the input.
1453*60432Shibler  A pointer to a struct Lisp_Process means wait until
1454*60432Shibler  something arrives from that process.
1455*60432Shibler 
1456*60432Shibler  do_display means redisplay should be done to show
1457*60432Shibler  subprocess output that arrives.  */
1458*60432Shibler 
1459*60432Shibler wait_reading_process_input (time_limit, read_kbd, do_display)
1460*60432Shibler      int time_limit, read_kbd, do_display;
1461*60432Shibler {
1462*60432Shibler   register int channel, nfds, m;
1463*60432Shibler   SELECT_TYPE Available;
1464*60432Shibler   SELECT_TYPE Exception;
1465*60432Shibler   int xerrno;
1466*60432Shibler   Lisp_Object proc;
1467*60432Shibler #ifdef HAVE_TIMEVAL
1468*60432Shibler   struct timeval timeout, end_time, garbage;
1469*60432Shibler #else
1470*60432Shibler   long timeout, end_time, temp;
1471*60432Shibler #endif /* not HAVE_TIMEVAL */
1472*60432Shibler   SELECT_TYPE Atemp;
1473*60432Shibler   int wait_channel = 0;
1474*60432Shibler   struct Lisp_Process *wait_proc = 0;
1475*60432Shibler   extern kbd_count;
1476*60432Shibler 
1477*60432Shibler   /* Detect when read_kbd is really the address of a Lisp_Process.  */
1478*60432Shibler   if (read_kbd > 10 || read_kbd < -1)
1479*60432Shibler     {
1480*60432Shibler       wait_proc = (struct Lisp_Process *) read_kbd;
1481*60432Shibler       wait_channel = XFASTINT (wait_proc->infd);
1482*60432Shibler       read_kbd = 0;
1483*60432Shibler     }
1484*60432Shibler   waiting_for_user_input_p = read_kbd;
1485*60432Shibler 
1486*60432Shibler   /* Since we may need to wait several times,
1487*60432Shibler      compute the absolute time to return at.  */
1488*60432Shibler   if (time_limit)
1489*60432Shibler     {
1490*60432Shibler #ifdef HAVE_TIMEVAL
1491*60432Shibler       gettimeofday (&end_time, &garbage);
1492*60432Shibler       end_time.tv_sec += time_limit;
1493*60432Shibler #else /* not HAVE_TIMEVAL */
1494*60432Shibler       time (&end_time);
1495*60432Shibler       end_time += time_limit;
1496*60432Shibler #endif /* not HAVE_TIMEVAL */
1497*60432Shibler     }
1498*60432Shibler 
1499*60432Shibler #if 0  /* Select emulator claims to preserve alarms.
1500*60432Shibler 	  And there are many ways to get out of this function by longjmp.  */
1501*60432Shibler   /* Turn off periodic alarms (in case they are in use)
1502*60432Shibler      because the select emulator uses alarms.  */
1503*60432Shibler   stop_polling ();
1504*60432Shibler #endif
1505*60432Shibler 
1506*60432Shibler   while (1)
1507*60432Shibler     {
1508*60432Shibler       /* If calling from keyboard input, do not quit
1509*60432Shibler 	 since we want to return C-g as an input character.
1510*60432Shibler 	 Otherwise, do pending quit if requested.  */
1511*60432Shibler       if (read_kbd >= 0)
1512*60432Shibler 	{
1513*60432Shibler #if 0
1514*60432Shibler 	  /* This is the same condition tested by QUIT.
1515*60432Shibler 	     We need to resume polling if we are going to quit.  */
1516*60432Shibler 	  if (!NULL (Vquit_flag) && NULL (Vinhibit_quit))
1517*60432Shibler 	    {
1518*60432Shibler 	      start_polling ();
1519*60432Shibler 	      QUIT;
1520*60432Shibler 	    }
1521*60432Shibler #endif
1522*60432Shibler 	  QUIT;
1523*60432Shibler 	}
1524*60432Shibler 
1525*60432Shibler       /* If status of something has changed, and no input is available,
1526*60432Shibler 	 notify the user of the change right away */
1527*60432Shibler       if (update_tick != process_tick && do_display)
1528*60432Shibler 	{
1529*60432Shibler 	  Atemp = input_wait_mask;
1530*60432Shibler #ifdef HAVE_TIMEVAL
1531*60432Shibler 	  timeout.tv_sec=0; timeout.tv_usec=0;
1532*60432Shibler #else /* not HAVE_TIMEVAL */
1533*60432Shibler 	  timeout = 0;
1534*60432Shibler #endif /* not HAVE_TIMEVAL */
1535*60432Shibler 	  if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0)
1536*60432Shibler 	    status_notify ();
1537*60432Shibler 	}
1538*60432Shibler 
1539*60432Shibler       /* Don't wait for output from a non-running process.  */
1540*60432Shibler       if (wait_proc != 0 && !NULL (wait_proc->raw_status_low))
1541*60432Shibler 	update_status (wait_proc);
1542*60432Shibler       if (wait_proc != 0
1543*60432Shibler 	  && ! EQ (wait_proc->status, Qrun))
1544*60432Shibler 	break;
1545*60432Shibler 
1546*60432Shibler       if (fix_screen_hook)
1547*60432Shibler 	(*fix_screen_hook) ();
1548*60432Shibler 
1549*60432Shibler       /* Compute time from now till when time limit is up */
1550*60432Shibler       /* Exit if already run out */
1551*60432Shibler       if (time_limit == -1)
1552*60432Shibler 	{
1553*60432Shibler 	  /* -1 specified for timeout means
1554*60432Shibler 	     gobble output available now
1555*60432Shibler 	     but don't wait at all. */
1556*60432Shibler #ifdef HAVE_TIMEVAL
1557*60432Shibler 	  timeout.tv_sec = 0;
1558*60432Shibler 	  timeout.tv_usec = 0;
1559*60432Shibler #else
1560*60432Shibler 	  timeout = 0;
1561*60432Shibler #endif /* not HAVE_TIMEVAL */
1562*60432Shibler 	}
1563*60432Shibler       else if (time_limit)
1564*60432Shibler 	{
1565*60432Shibler #ifdef HAVE_TIMEVAL
1566*60432Shibler 	  gettimeofday (&timeout, &garbage);
1567*60432Shibler 	  timeout.tv_sec = end_time.tv_sec - timeout.tv_sec;
1568*60432Shibler 	  timeout.tv_usec = end_time.tv_usec - timeout.tv_usec;
1569*60432Shibler 	  if (timeout.tv_usec < 0)
1570*60432Shibler 	    timeout.tv_usec += 1000000,
1571*60432Shibler 	    timeout.tv_sec--;
1572*60432Shibler 	  if (timeout.tv_sec < 0)
1573*60432Shibler 	    break;
1574*60432Shibler #else /* not HAVE_TIMEVAL */
1575*60432Shibler           time (&temp);
1576*60432Shibler 	  timeout = end_time - temp;
1577*60432Shibler 	  if (timeout < 0)
1578*60432Shibler 	    break;
1579*60432Shibler #endif /* not HAVE_TIMEVAL */
1580*60432Shibler 	}
1581*60432Shibler       else
1582*60432Shibler 	{
1583*60432Shibler #ifdef HAVE_TIMEVAL
1584*60432Shibler 	  /* If no real timeout, loop sleeping with a big timeout
1585*60432Shibler 	     so that input interrupt can wake us up by zeroing it  */
1586*60432Shibler 	  timeout.tv_sec = 100;
1587*60432Shibler 	  timeout.tv_usec = 0;
1588*60432Shibler #else /* not HAVE_TIMEVAL */
1589*60432Shibler           timeout = 100000;	/* 100000 recognized by the select emulator */
1590*60432Shibler #endif /* not HAVE_TIMEVAL */
1591*60432Shibler 	}
1592*60432Shibler 
1593*60432Shibler       /* Cause quitting and alarm signals to take immediate action,
1594*60432Shibler 	 and cause input available signals to zero out timeout */
1595*60432Shibler       if (read_kbd < 0)
1596*60432Shibler 	set_waiting_for_input (&timeout);
1597*60432Shibler 
1598*60432Shibler       /* Wait till there is something to do */
1599*60432Shibler 
1600*60432Shibler       Available = Exception = input_wait_mask;
1601*60432Shibler       if (!read_kbd)
1602*60432Shibler 	FD_CLR (0, &Available);
1603*60432Shibler 
1604*60432Shibler       if (read_kbd && kbd_count)
1605*60432Shibler 	nfds = 0;
1606*60432Shibler       else
1607*60432Shibler #ifdef IBMRTAIX
1608*60432Shibler 	nfds = select (MAXDESC, &Available, 0, 0, &timeout);
1609*60432Shibler #else
1610*60432Shibler #ifdef HPUX
1611*60432Shibler 	nfds = select (MAXDESC, &Available, 0, 0, &timeout);
1612*60432Shibler #else
1613*60432Shibler 	nfds = select (MAXDESC, &Available, 0, &Exception, &timeout);
1614*60432Shibler #endif
1615*60432Shibler #endif
1616*60432Shibler       xerrno = errno;
1617*60432Shibler 
1618*60432Shibler       if (fix_screen_hook)
1619*60432Shibler 	(*fix_screen_hook) ();
1620*60432Shibler 
1621*60432Shibler       /* Make C-g and alarm signals set flags again */
1622*60432Shibler       clear_waiting_for_input ();
1623*60432Shibler 
1624*60432Shibler       /* If we woke up due to SIGWINCH, actually change size now.  */
1625*60432Shibler       do_pending_window_change ();
1626*60432Shibler 
1627*60432Shibler       if (time_limit && nfds == 0)	/* timeout elapsed */
1628*60432Shibler 	break;
1629*60432Shibler       if (nfds < 0)
1630*60432Shibler 	{
1631*60432Shibler 	  if (xerrno == EINTR)
1632*60432Shibler 	    FD_ZERO (&Available);
1633*60432Shibler #ifdef ALLIANT
1634*60432Shibler 	  /* This happens for no known reason on ALLIANT.
1635*60432Shibler 	     I am guessing that this is the right response. -- RMS.  */
1636*60432Shibler 	  else if (xerrno == EFAULT)
1637*60432Shibler 	    FD_ZERO (&Available);
1638*60432Shibler #endif
1639*60432Shibler 	  else if (xerrno == EBADF)
1640*60432Shibler #ifdef AIX
1641*60432Shibler 	  /* AIX will return EBADF on a call to select involving a ptc if the
1642*60432Shibler 	     associated pts isn't open.  Since this will only happen just as
1643*60432Shibler 	     a child is dying, just ignore the situation -- SIGCHLD will come
1644*60432Shibler 	     along quite quickly, and after cleanup the ptc will no longer be
1645*60432Shibler 	     checked, so this error will stop recurring.  */
1646*60432Shibler 	    FD_ZERO (&Available);     /* Cannot depend on values returned.  */
1647*60432Shibler #else /* not AIX */
1648*60432Shibler 	    abort ();
1649*60432Shibler #endif /* not AIX */
1650*60432Shibler 	  else
1651*60432Shibler 	    error("select error: %s", sys_errlist[xerrno]);
1652*60432Shibler 	}
1653*60432Shibler #ifdef sun
1654*60432Shibler       else if (nfds > 0 && FD_ISSET (0, &Available) && interrupt_input)
1655*60432Shibler 	/* System sometimes fails to deliver SIGIO.  */
1656*60432Shibler 	kill (getpid (), SIGIO);
1657*60432Shibler #endif
1658*60432Shibler 
1659*60432Shibler       /* Check for keyboard input */
1660*60432Shibler       /* If there is any, return immediately
1661*60432Shibler 	 to give it higher priority than subprocesses */
1662*60432Shibler 
1663*60432Shibler       if (read_kbd && detect_input_pending ())
1664*60432Shibler 	break;
1665*60432Shibler 
1666*60432Shibler #ifdef vipc
1667*60432Shibler       /* Check for connection from other process */
1668*60432Shibler 
1669*60432Shibler       if (FD_ISSET (comm_server, &Available))
1670*60432Shibler 	{
1671*60432Shibler 	  FD_CLR (comm_server, &Available);
1672*60432Shibler 	  create_commchan ();
1673*60432Shibler 	}
1674*60432Shibler #endif vipc
1675*60432Shibler 
1676*60432Shibler       /* Check for data from a process or a command channel */
1677*60432Shibler 
1678*60432Shibler       for (channel = 3; channel < MAXDESC; channel++)
1679*60432Shibler 	{
1680*60432Shibler 	  if (FD_ISSET (channel, &Available))
1681*60432Shibler 	    {
1682*60432Shibler 	      int nread;
1683*60432Shibler 
1684*60432Shibler 	      FD_CLR (channel, &Available);
1685*60432Shibler 	      /* If waiting for this channel,
1686*60432Shibler 		 arrange to return as soon as no more input
1687*60432Shibler 		 to be processed.  No more waiting.  */
1688*60432Shibler 	      if (wait_channel == channel)
1689*60432Shibler 		{
1690*60432Shibler 		  wait_channel = 0;
1691*60432Shibler 		  time_limit = -1;
1692*60432Shibler 		}
1693*60432Shibler 	      proc = chan_process[channel];
1694*60432Shibler 	      if (NULL (proc))
1695*60432Shibler 		continue;
1696*60432Shibler 
1697*60432Shibler #ifdef vipc
1698*60432Shibler 	      /* It's a command channel */
1699*60432Shibler 	      if (!NULL (XPROCESS (proc)->command_channel_p))
1700*60432Shibler 		{
1701*60432Shibler 		  ProcessCommChan (channel, proc);
1702*60432Shibler 		  if (NULL (XPROCESS (proc)->command_channel_p))
1703*60432Shibler 		    {
1704*60432Shibler 		      /* It has ceased to be a command channel! */
1705*60432Shibler 		      int bytes_available;
1706*60432Shibler 		      if (ioctl (channel, FIONREAD, &bytes_available) < 0)
1707*60432Shibler 			bytes_available = 0;
1708*60432Shibler 		      if (bytes_available)
1709*60432Shibler 			FD_SET (channel, &Available);
1710*60432Shibler 		    }
1711*60432Shibler 		  continue;
1712*60432Shibler 		}
1713*60432Shibler #endif vipc
1714*60432Shibler 
1715*60432Shibler 	      /* Read data from the process, starting with our
1716*60432Shibler 		 buffered-ahead character if we have one.  */
1717*60432Shibler 
1718*60432Shibler 	      nread = read_process_output (proc, channel);
1719*60432Shibler 	      if (nread > 0)
1720*60432Shibler 		{
1721*60432Shibler 		  /* Since read_process_output can run a filter,
1722*60432Shibler 		     which can call accept-process-output,
1723*60432Shibler 		     don't try to read from any other processes
1724*60432Shibler 		     before doing the select again.  */
1725*60432Shibler 		  FD_ZERO (&Available);
1726*60432Shibler 
1727*60432Shibler 		  if (do_display)
1728*60432Shibler 		    redisplay_preserve_echo_area ();
1729*60432Shibler 		}
1730*60432Shibler #ifdef EWOULDBLOCK
1731*60432Shibler 	      else if (nread == -1 && errno == EWOULDBLOCK)
1732*60432Shibler 		;
1733*60432Shibler #else
1734*60432Shibler #ifdef O_NONBLOCK
1735*60432Shibler 	      else if (nread == -1 && errno == EAGAIN)
1736*60432Shibler 		;
1737*60432Shibler #else
1738*60432Shibler #ifdef O_NDELAY
1739*60432Shibler 	      else if (nread == -1 && errno == EAGAIN)
1740*60432Shibler 		;
1741*60432Shibler 	      /* Note that we cannot distinguish between no input
1742*60432Shibler 		 available now and a closed pipe.
1743*60432Shibler 		 With luck, a closed pipe will be accompanied by
1744*60432Shibler 		 subprocess termination and SIGCHLD.  */
1745*60432Shibler 	      else if (nread == 0)
1746*60432Shibler 		;
1747*60432Shibler #endif /* O_NDELAY */
1748*60432Shibler #endif /* O_NONBLOCK */
1749*60432Shibler #endif /* EWOULDBLOCK */
1750*60432Shibler #ifdef HAVE_PTYS
1751*60432Shibler 	      /* On some OSs with ptys, when the process on one end of
1752*60432Shibler 		 a pty exits, the other end gets an error reading with
1753*60432Shibler 		 errno = EIO instead of getting an EOF (0 bytes read).
1754*60432Shibler 		 Therefore, if we get an error reading and errno =
1755*60432Shibler 		 EIO, just continue, because the child process has
1756*60432Shibler 		 exited and should clean itself up soon (e.g. when we
1757*60432Shibler 		 get a SIGCHLD). */
1758*60432Shibler 	      else if (nread == -1 && errno == EIO)
1759*60432Shibler 		;
1760*60432Shibler #endif /* HAVE_PTYS */
1761*60432Shibler /* If we can detect process termination, don't consider the process
1762*60432Shibler    gone just because its pipe is closed.  */
1763*60432Shibler #ifdef SIGCHLD
1764*60432Shibler 	      else if (nread == 0)
1765*60432Shibler 		;
1766*60432Shibler #endif
1767*60432Shibler 	      else
1768*60432Shibler 		{
1769*60432Shibler 		  /* Preserve status of processes already terminated.  */
1770*60432Shibler 		  XSETINT (XPROCESS (proc)->tick, ++process_tick);
1771*60432Shibler 		  deactivate_process (proc);
1772*60432Shibler 		  if (!NULL (XPROCESS (proc)->raw_status_low))
1773*60432Shibler 		    update_status (XPROCESS (proc));
1774*60432Shibler 		  if (EQ (XPROCESS (proc)->status, Qrun))
1775*60432Shibler 		    XPROCESS (proc)->status
1776*60432Shibler 		      = Fcons (Qexit, Fcons (make_number (256), Qnil));
1777*60432Shibler 		}
1778*60432Shibler 	    }
1779*60432Shibler 	} /* end for */
1780*60432Shibler     } /* end while */
1781*60432Shibler 
1782*60432Shibler #if 0
1783*60432Shibler   /* Resume periodic signals to poll for input, if necessary.  */
1784*60432Shibler   start_polling ();
1785*60432Shibler #endif
1786*60432Shibler }
1787*60432Shibler 
1788*60432Shibler /* Actually call the filter.  This gets the information via variables
1789*60432Shibler    because internal_condition_case won't pass arguments.  */
1790*60432Shibler 
1791*60432Shibler Lisp_Object
1792*60432Shibler run_filter ()
1793*60432Shibler {
1794*60432Shibler   return call2 (this_filter, filter_process, filter_string);
1795*60432Shibler }
1796*60432Shibler 
1797*60432Shibler /* Read pending output from the process channel,
1798*60432Shibler    starting with our buffered-ahead character if we have one.
1799*60432Shibler    Yield number of characters read.
1800*60432Shibler 
1801*60432Shibler    This function reads at most 1024 characters.
1802*60432Shibler    If you want to read all available subprocess output,
1803*60432Shibler    you must call it repeatedly until it returns zero.  */
1804*60432Shibler 
1805*60432Shibler read_process_output (proc, channel)
1806*60432Shibler      Lisp_Object proc;
1807*60432Shibler      register int channel;
1808*60432Shibler {
1809*60432Shibler   register int nchars;
1810*60432Shibler   char chars[1024];
1811*60432Shibler   register Lisp_Object outstream;
1812*60432Shibler   register struct buffer *old = current_buffer;
1813*60432Shibler   register struct Lisp_Process *p = XPROCESS (proc);
1814*60432Shibler   register int opoint;
1815*60432Shibler 
1816*60432Shibler   if (proc_buffered_char[channel] < 0)
1817*60432Shibler     nchars = read (channel, chars, sizeof chars);
1818*60432Shibler   else
1819*60432Shibler     {
1820*60432Shibler       chars[0] = proc_buffered_char[channel];
1821*60432Shibler       proc_buffered_char[channel] = -1;
1822*60432Shibler       nchars = read (channel, chars + 1, sizeof chars - 1);
1823*60432Shibler       if (nchars < 0)
1824*60432Shibler 	nchars = 1;
1825*60432Shibler       else
1826*60432Shibler 	nchars = nchars + 1;
1827*60432Shibler     }
1828*60432Shibler 
1829*60432Shibler   if (nchars <= 0) return nchars;
1830*60432Shibler 
1831*60432Shibler   outstream = p->filter;
1832*60432Shibler   if (!NULL (outstream))
1833*60432Shibler     {
1834*60432Shibler       int count = specpdl_ptr - specpdl;
1835*60432Shibler       specbind (Qinhibit_quit, Qt);
1836*60432Shibler       this_filter = outstream;
1837*60432Shibler       filter_process = proc;
1838*60432Shibler       filter_string = make_string (chars, nchars);
1839*60432Shibler       call2 (this_filter, filter_process, filter_string);
1840*60432Shibler       /*   internal_condition_case (run_filter, Qerror, Fidentity);  */
1841*60432Shibler       unbind_to (count);
1842*60432Shibler       return nchars;
1843*60432Shibler     }
1844*60432Shibler 
1845*60432Shibler   /* If no filter, write into buffer if it isn't dead.  */
1846*60432Shibler   if (!NULL (p->buffer) && !NULL (XBUFFER (p->buffer)->name))
1847*60432Shibler     {
1848*60432Shibler       Lisp_Object tem;
1849*60432Shibler 
1850*60432Shibler       Fset_buffer (p->buffer);
1851*60432Shibler       opoint = point;
1852*60432Shibler 
1853*60432Shibler       /* Insert new output into buffer
1854*60432Shibler 	 at the current end-of-output marker,
1855*60432Shibler 	 thus preserving logical ordering of input and output.  */
1856*60432Shibler       if (XMARKER (p->mark)->buffer)
1857*60432Shibler 	SET_PT (marker_position (p->mark));
1858*60432Shibler       else
1859*60432Shibler 	SET_PT (ZV);
1860*60432Shibler       if (point <= opoint)
1861*60432Shibler 	opoint += nchars;
1862*60432Shibler 
1863*60432Shibler       tem = current_buffer->read_only;
1864*60432Shibler       current_buffer->read_only = Qnil;
1865*60432Shibler       insert (chars, nchars);
1866*60432Shibler       current_buffer->read_only = tem;
1867*60432Shibler       Fset_marker (p->mark, make_number (point), p->buffer);
1868*60432Shibler       update_mode_lines++;
1869*60432Shibler 
1870*60432Shibler       SET_PT (opoint);
1871*60432Shibler       set_buffer_internal (old);
1872*60432Shibler     }
1873*60432Shibler   return nchars;
1874*60432Shibler }
1875*60432Shibler 
1876*60432Shibler DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
1877*60432Shibler        0, 0, 0,
1878*60432Shibler   "Returns non-NIL if emacs is waiting for input from the user.\n\
1879*60432Shibler This is intended for use by asynchronous process output filters and sentinels.")
1880*60432Shibler        ()
1881*60432Shibler {
1882*60432Shibler   return ((waiting_for_user_input_p) ? Qt : Qnil);
1883*60432Shibler }
1884*60432Shibler 
1885*60432Shibler /* Sending data to subprocess */
1886*60432Shibler 
1887*60432Shibler jmp_buf send_process_frame;
1888*60432Shibler 
1889*60432Shibler send_process_trap ()
1890*60432Shibler {
1891*60432Shibler #ifdef BSD4_1
1892*60432Shibler   sigrelse (SIGPIPE);
1893*60432Shibler   sigrelse (SIGALRM);
1894*60432Shibler #endif /* BSD4_1 */
1895*60432Shibler   longjmp (send_process_frame, 1);
1896*60432Shibler }
1897*60432Shibler 
1898*60432Shibler send_process (proc, buf, len)
1899*60432Shibler      Lisp_Object proc;
1900*60432Shibler      char *buf;
1901*60432Shibler      int len;
1902*60432Shibler {
1903*60432Shibler   /* Don't use register vars; longjmp can lose them.  */
1904*60432Shibler   int rv;
1905*60432Shibler   unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
1906*60432Shibler 
1907*60432Shibler   if (!NULL (XPROCESS (proc)->raw_status_low))
1908*60432Shibler     update_status (XPROCESS (proc));
1909*60432Shibler   if (! EQ (XPROCESS (proc)->status, Qrun))
1910*60432Shibler     error ("Process %s not running", procname);
1911*60432Shibler 
1912*60432Shibler   if (!setjmp (send_process_frame))
1913*60432Shibler     while (len > 0)
1914*60432Shibler       {
1915*60432Shibler 	signal (SIGPIPE, send_process_trap);
1916*60432Shibler 	rv = write (XFASTINT (XPROCESS (proc)->outfd), buf, len);
1917*60432Shibler 	signal (SIGPIPE, SIG_DFL);
1918*60432Shibler 	if (rv < 0)
1919*60432Shibler 	  {
1920*60432Shibler #ifdef EWOULDBLOCK
1921*60432Shibler 	    if (errno == EWOULDBLOCK)
1922*60432Shibler 	      {
1923*60432Shibler 		/* It would be nice to accept process output here,
1924*60432Shibler 		   but that is difficult.  For example, it could
1925*60432Shibler 		   garbage what we are sending if that is from a buffer.  */
1926*60432Shibler 		immediate_quit = 1;
1927*60432Shibler 		QUIT;
1928*60432Shibler 		sleep (1);
1929*60432Shibler 		immediate_quit = 0;
1930*60432Shibler 		continue;
1931*60432Shibler 	      }
1932*60432Shibler #endif
1933*60432Shibler 	    report_file_error ("writing to process", Fcons (proc, Qnil));
1934*60432Shibler 	  }
1935*60432Shibler 	buf += rv;
1936*60432Shibler 	len -= rv;
1937*60432Shibler       }
1938*60432Shibler   else
1939*60432Shibler     {
1940*60432Shibler       XPROCESS (proc)->raw_status_low = Qnil;
1941*60432Shibler       XPROCESS (proc)->raw_status_high = Qnil;
1942*60432Shibler       XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
1943*60432Shibler       XSETINT (XPROCESS (proc)->tick, ++process_tick);
1944*60432Shibler       deactivate_process (proc);
1945*60432Shibler       error ("SIGPIPE raised on process %s; closed it", procname);
1946*60432Shibler     }
1947*60432Shibler }
1948*60432Shibler 
1949*60432Shibler DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
1950*60432Shibler   3, 3, 0,
1951*60432Shibler   "Send current contents of region as input to PROCESS.\n\
1952*60432Shibler PROCESS may be a process name.\n\
1953*60432Shibler Called from program, takes three arguments, PROCESS, START and END.")
1954*60432Shibler   (process, start, end)
1955*60432Shibler      Lisp_Object process, start, end;
1956*60432Shibler {
1957*60432Shibler   Lisp_Object proc;
1958*60432Shibler   int start1;
1959*60432Shibler 
1960*60432Shibler   proc = get_process (process);
1961*60432Shibler   validate_region (&start, &end);
1962*60432Shibler 
1963*60432Shibler   if (XINT (start) < GPT && XINT (end) > GPT)
1964*60432Shibler     move_gap (start);
1965*60432Shibler 
1966*60432Shibler   start1 = XINT (start);
1967*60432Shibler   send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start));
1968*60432Shibler 
1969*60432Shibler   return Qnil;
1970*60432Shibler }
1971*60432Shibler 
1972*60432Shibler DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
1973*60432Shibler   2, 2, 0,
1974*60432Shibler   "Send PROCESS the contents of STRING as input.\n\
1975*60432Shibler PROCESS may be a process name.")
1976*60432Shibler   (process, string)
1977*60432Shibler      Lisp_Object process, string;
1978*60432Shibler {
1979*60432Shibler   Lisp_Object proc;
1980*60432Shibler   CHECK_STRING (string, 1);
1981*60432Shibler   proc = get_process (process);
1982*60432Shibler   send_process (proc, XSTRING (string)->data, XSTRING (string)->size);
1983*60432Shibler   return Qnil;
1984*60432Shibler }
1985*60432Shibler 
1986*60432Shibler /* send a signal number SIGNO to PROCESS.
1987*60432Shibler    CURRENT_GROUP means send to the process group that currently owns
1988*60432Shibler    the terminal being used to communicate with PROCESS.
1989*60432Shibler    This is used for various commands in shell mode.
1990*60432Shibler    If NOMSG is zero, insert signal-announcements into process's buffers
1991*60432Shibler    right away.  */
1992*60432Shibler 
1993*60432Shibler process_send_signal (process, signo, current_group, nomsg)
1994*60432Shibler      Lisp_Object process;
1995*60432Shibler      int signo;
1996*60432Shibler      Lisp_Object current_group;
1997*60432Shibler      int nomsg;
1998*60432Shibler {
1999*60432Shibler   Lisp_Object proc;
2000*60432Shibler   register struct Lisp_Process *p;
2001*60432Shibler   int gid;
2002*60432Shibler 
2003*60432Shibler   proc = get_process (process);
2004*60432Shibler   p = XPROCESS (proc);
2005*60432Shibler 
2006*60432Shibler   if (!EQ (p->childp, Qt))
2007*60432Shibler     error ("Process %s is not a subprocess",
2008*60432Shibler 	   XSTRING (p->name)->data);
2009*60432Shibler   if (!XFASTINT (p->infd))
2010*60432Shibler     error ("Process %s is not active",
2011*60432Shibler 	   XSTRING (p->name)->data);
2012*60432Shibler 
2013*60432Shibler   if (NULL (p->pty_flag))
2014*60432Shibler     current_group = Qnil;
2015*60432Shibler 
2016*60432Shibler #ifdef TIOCGPGRP		/* Not sure about this! (fnf) */
2017*60432Shibler   /* If we are using pgrps, get a pgrp number and make it negative.  */
2018*60432Shibler   if (!NULL (current_group))
2019*60432Shibler     {
2020*60432Shibler       ioctl (XFASTINT (p->infd), TIOCGPGRP, &gid);
2021*60432Shibler       gid = - gid;
2022*60432Shibler     }
2023*60432Shibler   else
2024*60432Shibler     gid = - XFASTINT (p->pid);
2025*60432Shibler #else /* not using pgrps */
2026*60432Shibler   /* Can't select pgrps on this system, so we know that
2027*60432Shibler      the child itself heads the pgrp.  */
2028*60432Shibler   gid = - XFASTINT (p->pid);
2029*60432Shibler #endif /* not using pgrps */
2030*60432Shibler 
2031*60432Shibler   switch (signo)
2032*60432Shibler     {
2033*60432Shibler #ifdef SIGCONT
2034*60432Shibler     case SIGCONT:
2035*60432Shibler       p->raw_status_low = Qnil;
2036*60432Shibler       p->raw_status_high = Qnil;
2037*60432Shibler       p->status = Qrun;
2038*60432Shibler       XSETINT (p->tick, ++process_tick);
2039*60432Shibler       if (!nomsg)
2040*60432Shibler 	status_notify ();
2041*60432Shibler       break;
2042*60432Shibler #endif
2043*60432Shibler     case SIGINT:
2044*60432Shibler     case SIGQUIT:
2045*60432Shibler     case SIGKILL:
2046*60432Shibler       flush_pending_output (XFASTINT (p->infd));
2047*60432Shibler       break;
2048*60432Shibler     }
2049*60432Shibler   /* gid may be a pid, or minus a pgrp's number */
2050*60432Shibler #ifdef TIOCSIGSEND
2051*60432Shibler   if (!NULL (current_group))
2052*60432Shibler     ioctl (XFASTINT (p->infd), TIOCSIGSEND, signo);
2053*60432Shibler   else
2054*60432Shibler     {
2055*60432Shibler       gid = - XFASTINT (p->pid);
2056*60432Shibler       kill (gid, signo);
2057*60432Shibler     }
2058*60432Shibler #else /* no TIOCSIGSEND */
2059*60432Shibler #ifdef BSD
2060*60432Shibler   /* On bsd, [man says] kill does not accept a negative number to kill a pgrp.
2061*60432Shibler      Must do that differently.  */
2062*60432Shibler   killpg (-gid, signo);
2063*60432Shibler #else /* Not BSD.  */
2064*60432Shibler   kill (gid, signo);
2065*60432Shibler #endif /* Not BSD.  */
2066*60432Shibler #endif /* no TIOCSIGSEND */
2067*60432Shibler }
2068*60432Shibler 
2069*60432Shibler DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
2070*60432Shibler   "Interrupt process PROCESS.  May be process or name of one.\n\
2071*60432Shibler Nil or no arg means current buffer's process.\n\
2072*60432Shibler Second arg CURRENT-GROUP non-nil means send signal to\n\
2073*60432Shibler the current process-group of the process's controlling terminal\n\
2074*60432Shibler rather than to the process's own process group.\n\
2075*60432Shibler If the process is a shell, this means interrupt current subjob\n\
2076*60432Shibler rather than the shell.")
2077*60432Shibler   (process, current_group)
2078*60432Shibler      Lisp_Object process, current_group;
2079*60432Shibler {
2080*60432Shibler   process_send_signal (process, SIGINT, current_group, 0);
2081*60432Shibler   return process;
2082*60432Shibler }
2083*60432Shibler 
2084*60432Shibler DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
2085*60432Shibler   "Kill process PROCESS.  May be process or name of one.\n\
2086*60432Shibler See function interrupt-process for more details on usage.")
2087*60432Shibler   (process, current_group)
2088*60432Shibler      Lisp_Object process, current_group;
2089*60432Shibler {
2090*60432Shibler   process_send_signal (process, SIGKILL, current_group, 0);
2091*60432Shibler   return process;
2092*60432Shibler }
2093*60432Shibler 
2094*60432Shibler DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
2095*60432Shibler   "Send QUIT signal to process PROCESS.  May be process or name of one.\n\
2096*60432Shibler See function interrupt-process for more details on usage.")
2097*60432Shibler   (process, current_group)
2098*60432Shibler      Lisp_Object process, current_group;
2099*60432Shibler {
2100*60432Shibler   process_send_signal (process, SIGQUIT, current_group, 0);
2101*60432Shibler   return process;
2102*60432Shibler }
2103*60432Shibler 
2104*60432Shibler DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
2105*60432Shibler   "Stop process PROCESS.  May be process or name of one.\n\
2106*60432Shibler See function interrupt-process for more details on usage.")
2107*60432Shibler   (process, current_group)
2108*60432Shibler      Lisp_Object process, current_group;
2109*60432Shibler {
2110*60432Shibler #ifndef SIGTSTP
2111*60432Shibler   error ("no SIGTSTP support");
2112*60432Shibler #else
2113*60432Shibler   process_send_signal (process, SIGTSTP, current_group, 0);
2114*60432Shibler #endif
2115*60432Shibler   return process;
2116*60432Shibler }
2117*60432Shibler 
2118*60432Shibler DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
2119*60432Shibler   "Continue process PROCESS.  May be process or name of one.\n\
2120*60432Shibler See function interrupt-process for more details on usage.")
2121*60432Shibler   (process, current_group)
2122*60432Shibler      Lisp_Object process, current_group;
2123*60432Shibler {
2124*60432Shibler #ifdef SIGCONT
2125*60432Shibler     process_send_signal (process, SIGCONT, current_group, 0);
2126*60432Shibler #else
2127*60432Shibler     error ("no SIGCONT support");
2128*60432Shibler #endif
2129*60432Shibler   return process;
2130*60432Shibler }
2131*60432Shibler 
2132*60432Shibler DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
2133*60432Shibler   "Make PROCESS see end-of-file in its input.\n\
2134*60432Shibler Eof comes after any text already sent to it.\n\
2135*60432Shibler nil or no arg means current buffer's process.")
2136*60432Shibler   (process)
2137*60432Shibler      Lisp_Object process;
2138*60432Shibler {
2139*60432Shibler   Lisp_Object proc;
2140*60432Shibler 
2141*60432Shibler   proc = get_process (process);
2142*60432Shibler   /* Sending a zero-length record is supposed to mean eof
2143*60432Shibler      when TIOCREMOTE is turned on.  */
2144*60432Shibler #ifdef DID_REMOTE
2145*60432Shibler   {
2146*60432Shibler     char buf[1];
2147*60432Shibler     write (XFASTINT (XPROCESS (proc)->outfd), buf, 0);
2148*60432Shibler   }
2149*60432Shibler #else /* did not do TOICREMOTE */
2150*60432Shibler   send_process (proc, "\004", 1);
2151*60432Shibler #endif /* did not do TOICREMOTE */
2152*60432Shibler   return process;
2153*60432Shibler }
2154*60432Shibler 
2155*60432Shibler /* Kill all processes associated with `buffer'.
2156*60432Shibler  If `buffer' is nil, kill all processes  */
2157*60432Shibler 
2158*60432Shibler kill_buffer_processes (buffer)
2159*60432Shibler      Lisp_Object buffer;
2160*60432Shibler {
2161*60432Shibler   Lisp_Object tail, proc;
2162*60432Shibler 
2163*60432Shibler   for (tail = Vprocess_alist; XGCTYPE (tail) == Lisp_Cons;
2164*60432Shibler        tail = XCONS (tail)->cdr)
2165*60432Shibler     {
2166*60432Shibler       proc = XCONS (XCONS (tail)->car)->cdr;
2167*60432Shibler       if (XGCTYPE (proc) == Lisp_Process
2168*60432Shibler 	  && (NULL (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
2169*60432Shibler 	{
2170*60432Shibler 	  if (NETCONN_P (proc))
2171*60432Shibler 	    deactivate_process (proc);
2172*60432Shibler 	  else if (XFASTINT (XPROCESS (proc)->infd))
2173*60432Shibler 	    process_send_signal (proc, SIGHUP, Qnil, 1);
2174*60432Shibler 	}
2175*60432Shibler     }
2176*60432Shibler }
2177*60432Shibler 
2178*60432Shibler /* On receipt of a signal that a child status has changed,
2179*60432Shibler  loop asking about children with changed statuses until
2180*60432Shibler  the system says there are no more.
2181*60432Shibler    All we do is change the status;
2182*60432Shibler  we do not run sentinels or print notifications.
2183*60432Shibler  That is saved for the next time keyboard input is done,
2184*60432Shibler  in order to avoid timing errors.  */
2185*60432Shibler 
2186*60432Shibler /** WARNING: this can be called during garbage collection.
2187*60432Shibler  Therefore, it must not be fooled by the presence of mark bits in
2188*60432Shibler  Lisp objects.  */
2189*60432Shibler 
2190*60432Shibler /** USG WARNING:  Although it is not obvious from the documentation
2191*60432Shibler  in signal(2), on a USG system the SIGCLD handler MUST NOT call
2192*60432Shibler  signal() before executing at least one wait(), otherwise the handler
2193*60432Shibler  will be called again, resulting in an infinite loop.  The relevant
2194*60432Shibler  portion of the documentation reads "SIGCLD signals will be queued
2195*60432Shibler  and the signal-catching function will be continually reentered until
2196*60432Shibler  the queue is empty".  Invoking signal() causes the kernel to reexamine
2197*60432Shibler  the SIGCLD queue.   Fred Fish, UniSoft Systems Inc. */
2198*60432Shibler 
2199*60432Shibler sigchld_handler (signo)
2200*60432Shibler      int signo;
2201*60432Shibler {
2202*60432Shibler   int old_errno = errno;
2203*60432Shibler   Lisp_Object proc;
2204*60432Shibler   register struct Lisp_Process *p;
2205*60432Shibler 
2206*60432Shibler #ifdef BSD4_1
2207*60432Shibler   extern int synch_process_pid;
2208*60432Shibler   extern int sigheld;
2209*60432Shibler   sigheld |= sigbit (SIGCHLD);
2210*60432Shibler #endif
2211*60432Shibler 
2212*60432Shibler   while (1)
2213*60432Shibler     {
2214*60432Shibler       register int pid;
2215*60432Shibler       WAITTYPE w;
2216*60432Shibler       Lisp_Object tail;
2217*60432Shibler 
2218*60432Shibler #ifdef WNOHANG
2219*60432Shibler #ifndef WUNTRACED
2220*60432Shibler #define WUNTRACED 0
2221*60432Shibler #endif /* no WUNTRACED */
2222*60432Shibler       /* Keep trying to get a status until we get a definitive result.  */
2223*60432Shibler       do
2224*60432Shibler 	{
2225*60432Shibler 	  errno = 0;
2226*60432Shibler 	  pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
2227*60432Shibler 	}
2228*60432Shibler       while (pid <= 0 && errno == EINTR);
2229*60432Shibler 
2230*60432Shibler       if (pid <= 0)
2231*60432Shibler 	{
2232*60432Shibler 	  /* A real failure.  We have done all our job, so return.  */
2233*60432Shibler 
2234*60432Shibler 	  /* USG systems forget handlers when they are used;
2235*60432Shibler 	     must reestablish each time */
2236*60432Shibler #ifdef USG
2237*60432Shibler 	  signal (signo, sigchld_handler);   /* WARNING - must come after wait3() */
2238*60432Shibler #endif
2239*60432Shibler #ifdef  BSD4_1
2240*60432Shibler 	  sigheld &= ~sigbit (SIGCHLD);
2241*60432Shibler 	  sigrelse (SIGCHLD);
2242*60432Shibler #endif
2243*60432Shibler 	  errno = old_errno;
2244*60432Shibler 	  return;
2245*60432Shibler 	}
2246*60432Shibler #else
2247*60432Shibler       pid = wait (&w);
2248*60432Shibler #endif /* no WNOHANG */
2249*60432Shibler 
2250*60432Shibler #ifdef BSD4_1
2251*60432Shibler       if (synch_process_pid == pid)
2252*60432Shibler 	synch_process_pid = 0;         /* Zero it to show process has died. */
2253*60432Shibler #endif
2254*60432Shibler 
2255*60432Shibler       /* Find the process that signaled us, and record its status.  */
2256*60432Shibler 
2257*60432Shibler       p = 0;
2258*60432Shibler       for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
2259*60432Shibler 	{
2260*60432Shibler 	  proc = XCONS (XCONS (tail)->car)->cdr;
2261*60432Shibler 	  p = XPROCESS (proc);
2262*60432Shibler 	  if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
2263*60432Shibler 	    break;
2264*60432Shibler 	  p = 0;
2265*60432Shibler 	}
2266*60432Shibler 
2267*60432Shibler       /* If we don't recognize the pid number,
2268*60432Shibler 	 look for a process being created.  */
2269*60432Shibler 
2270*60432Shibler       if (p == 0)
2271*60432Shibler 	for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
2272*60432Shibler 	  {
2273*60432Shibler 	    proc = XCONS (XCONS (tail)->car)->cdr;
2274*60432Shibler 	    p = XPROCESS (proc);
2275*60432Shibler 	    if (XINT (p->pid) == -1)
2276*60432Shibler 	      break;
2277*60432Shibler 	    p = 0;
2278*60432Shibler 	  }
2279*60432Shibler 
2280*60432Shibler       /* Change the status of the process that was found.  */
2281*60432Shibler 
2282*60432Shibler       if (p != 0)
2283*60432Shibler 	{
2284*60432Shibler 	  union { int i; WAITTYPE wt; } u;
2285*60432Shibler 
2286*60432Shibler 	  XSETINT (p->tick, ++process_tick);
2287*60432Shibler 	  u.wt = w;
2288*60432Shibler 	  XFASTINT (p->raw_status_low) = u.i & 0xffff;
2289*60432Shibler 	  XFASTINT (p->raw_status_high) = u.i >> 16;
2290*60432Shibler 
2291*60432Shibler 	  /* If process has terminated, stop waiting for its output.  */
2292*60432Shibler 	  if (WIFSIGNALED (w) || WIFEXITED (w))
2293*60432Shibler 	    if (p->infd)
2294*60432Shibler 	      FD_CLR (p->infd, &input_wait_mask);
2295*60432Shibler 	}
2296*60432Shibler 
2297*60432Shibler       /* On some systems, we must return right away.
2298*60432Shibler 	 If any more processes want to signal us, we will
2299*60432Shibler 	 get another signal.
2300*60432Shibler 	 Otherwise (on systems that have WNOHANG), loop around
2301*60432Shibler 	 to use up all the processes that have something to tell us.  */
2302*60432Shibler #if defined (USG) && ! (defined (HPUX) && defined (WNOHANG))
2303*60432Shibler #ifdef USG
2304*60432Shibler       signal (signo, sigchld_handler);
2305*60432Shibler #endif
2306*60432Shibler       errno = old_errno;
2307*60432Shibler       return;
2308*60432Shibler #endif /* USG, but not HPUX with WNOHANG */
2309*60432Shibler     }
2310*60432Shibler }
2311*60432Shibler 
2312*60432Shibler /* Report all recent events of a change in process status
2313*60432Shibler    (either run the sentinel or output a message).
2314*60432Shibler    This is done while Emacs is waiting for keyboard input.  */
2315*60432Shibler 
2316*60432Shibler status_notify ()
2317*60432Shibler {
2318*60432Shibler   register Lisp_Object tail, proc, buffer;
2319*60432Shibler 
2320*60432Shibler   for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
2321*60432Shibler     {
2322*60432Shibler       Lisp_Object symbol, msg;
2323*60432Shibler       register struct Lisp_Process *p;
2324*60432Shibler 
2325*60432Shibler       proc = Fcdr (Fcar (tail));
2326*60432Shibler       p = XPROCESS (proc);
2327*60432Shibler 
2328*60432Shibler       if (XINT (p->tick) != XINT (p->update_tick))
2329*60432Shibler 	{
2330*60432Shibler 	  struct gcpro gcpro1;
2331*60432Shibler 
2332*60432Shibler 	  XSETINT (p->update_tick, XINT (p->tick));
2333*60432Shibler 
2334*60432Shibler 	  /* If process is still active, read any output that remains.  */
2335*60432Shibler 	  if (XFASTINT (p->infd))
2336*60432Shibler 	    while (read_process_output (proc, XFASTINT (p->infd)) > 0);
2337*60432Shibler 
2338*60432Shibler 	  buffer = p->buffer;
2339*60432Shibler 
2340*60432Shibler 	  /* Get the text to use for the message.  */
2341*60432Shibler 	  if (!NULL (p->raw_status_low))
2342*60432Shibler 	    update_status (p);
2343*60432Shibler 	  msg = status_message (p->status);
2344*60432Shibler 	  GCPRO1 (msg);
2345*60432Shibler 
2346*60432Shibler 	  /* If process is terminated, deactivate it or delete it.  */
2347*60432Shibler 	  symbol = p->status;
2348*60432Shibler 	  if (XTYPE (p->status) == Lisp_Cons)
2349*60432Shibler 	    symbol = XCONS (p->status)->car;
2350*60432Shibler 
2351*60432Shibler 	  if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
2352*60432Shibler 	      || EQ (symbol, Qclosed))
2353*60432Shibler 	    {
2354*60432Shibler 	      if (delete_exited_processes)
2355*60432Shibler 		remove_process (proc);
2356*60432Shibler 	      else
2357*60432Shibler 		deactivate_process (proc);
2358*60432Shibler 	    }
2359*60432Shibler 	  UNGCPRO;
2360*60432Shibler 
2361*60432Shibler 	  /* Now output the message suitably.  */
2362*60432Shibler 	  if (!NULL (p->sentinel))
2363*60432Shibler 	    exec_sentinel (proc, msg);
2364*60432Shibler 	  /* Don't bother with a message in the buffer
2365*60432Shibler 	     when a process becomes runnable.  */
2366*60432Shibler 	  else if (!EQ (symbol, Qrun) && !NULL (buffer))
2367*60432Shibler 	    {
2368*60432Shibler 	      Lisp_Object ro = XBUFFER (buffer)->read_only;
2369*60432Shibler 	      Lisp_Object tem;
2370*60432Shibler 	      struct buffer *old = current_buffer;
2371*60432Shibler 	      int opoint;
2372*60432Shibler 
2373*60432Shibler 	      /* Avoid error if buffer is deleted
2374*60432Shibler 		 (probably that's why the process is dead, too) */
2375*60432Shibler 	      if (NULL (XBUFFER (buffer)->name))
2376*60432Shibler 		continue;
2377*60432Shibler 	      Fset_buffer (buffer);
2378*60432Shibler 	      opoint = point;
2379*60432Shibler 	      /* Insert new output into buffer
2380*60432Shibler 		 at the current end-of-output marker,
2381*60432Shibler 		 thus preserving logical ordering of input and output.  */
2382*60432Shibler 	      if (XMARKER (p->mark)->buffer)
2383*60432Shibler 		SET_PT (marker_position (p->mark));
2384*60432Shibler 	      else
2385*60432Shibler 		SET_PT (ZV);
2386*60432Shibler 	      if (point <= opoint)
2387*60432Shibler 		opoint += XSTRING (msg)->size + XSTRING (p->name)->size + 10;
2388*60432Shibler 
2389*60432Shibler 	      tem = current_buffer->read_only;
2390*60432Shibler 	      current_buffer->read_only = Qnil;
2391*60432Shibler 	      GCPRO1 (msg);
2392*60432Shibler 	      InsStr ("\nProcess ");
2393*60432Shibler 	      Finsert (1, &p->name);
2394*60432Shibler 	      InsStr (" ");
2395*60432Shibler 	      Finsert (1, &msg);
2396*60432Shibler 	      current_buffer->read_only = tem;
2397*60432Shibler 	      Fset_marker (p->mark, make_number (point), p->buffer);
2398*60432Shibler 	      UNGCPRO;
2399*60432Shibler 
2400*60432Shibler 	      SET_PT (opoint);
2401*60432Shibler 	      set_buffer_internal (old);
2402*60432Shibler 	    }
2403*60432Shibler 	}
2404*60432Shibler     } /* end for */
2405*60432Shibler 
2406*60432Shibler   update_mode_lines++;  /* in case buffers use %s in mode-line-format */
2407*60432Shibler   redisplay_preserve_echo_area ();
2408*60432Shibler 
2409*60432Shibler   update_tick = process_tick;
2410*60432Shibler }
2411*60432Shibler 
2412*60432Shibler exec_sentinel (proc, reason)
2413*60432Shibler      Lisp_Object proc, reason;
2414*60432Shibler {
2415*60432Shibler   Lisp_Object sentinel;
2416*60432Shibler   register struct Lisp_Process *p = XPROCESS (proc);
2417*60432Shibler   int count = specpdl_ptr - specpdl;
2418*60432Shibler 
2419*60432Shibler   sentinel = p->sentinel;
2420*60432Shibler   if (NULL (sentinel))
2421*60432Shibler     return;
2422*60432Shibler 
2423*60432Shibler   p->sentinel = Qnil;
2424*60432Shibler   specbind (Qinhibit_quit, Qt);
2425*60432Shibler   this_filter = sentinel;
2426*60432Shibler   filter_process = proc;
2427*60432Shibler   filter_string = reason;
2428*60432Shibler   call2 (this_filter, filter_process, filter_string);
2429*60432Shibler /*   internal_condition_case (run_filter, Qerror, Fidentity);  */
2430*60432Shibler   unbind_to (count);
2431*60432Shibler   p->sentinel = sentinel;
2432*60432Shibler }
2433*60432Shibler 
2434*60432Shibler init_process ()
2435*60432Shibler {
2436*60432Shibler   register int i;
2437*60432Shibler 
2438*60432Shibler #ifdef SIGCHLD
2439*60432Shibler #ifndef CANNOT_DUMP
2440*60432Shibler   if (! noninteractive || initialized)
2441*60432Shibler #endif
2442*60432Shibler     signal (SIGCHLD, sigchld_handler);
2443*60432Shibler #endif
2444*60432Shibler 
2445*60432Shibler   FD_ZERO (&input_wait_mask);
2446*60432Shibler   FD_SET (0, &input_wait_mask);
2447*60432Shibler   Vprocess_alist = Qnil;
2448*60432Shibler   for (i = 0; i < MAXDESC; i++)
2449*60432Shibler     {
2450*60432Shibler       chan_process[i] = Qnil;
2451*60432Shibler       proc_buffered_char[i] = -1;
2452*60432Shibler     }
2453*60432Shibler }
2454*60432Shibler 
2455*60432Shibler syms_of_process ()
2456*60432Shibler {
2457*60432Shibler   Qprocessp = intern ("processp");
2458*60432Shibler   staticpro (&Qprocessp);
2459*60432Shibler   Qrun = intern ("run");
2460*60432Shibler   staticpro (&Qrun);
2461*60432Shibler   Qstop = intern ("stop");
2462*60432Shibler   staticpro (&Qstop);
2463*60432Shibler   Qsignal = intern ("signal");
2464*60432Shibler   staticpro (&Qsignal);
2465*60432Shibler   Qexit = intern ("exit");
2466*60432Shibler   staticpro (&Qexit);
2467*60432Shibler   Qopen = intern ("open");
2468*60432Shibler   staticpro (&Qopen);
2469*60432Shibler   Qclosed = intern ("closed");
2470*60432Shibler   staticpro (&Qclosed);
2471*60432Shibler 
2472*60432Shibler   staticpro (&Vprocess_alist);
2473*60432Shibler 
2474*60432Shibler   DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
2475*60432Shibler     "*Non-nil means delete processes immediately when they exit.\n\
2476*60432Shibler nil means don't delete them until `list-processes' is run.");
2477*60432Shibler 
2478*60432Shibler   delete_exited_processes = 1;
2479*60432Shibler 
2480*60432Shibler   DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
2481*60432Shibler     "Control type of device used to communicate with subprocesses.\n\
2482*60432Shibler Values are nil to use a pipe, t for a pty (or pipe if ptys not supported).\n\
2483*60432Shibler Value takes effect when `start-process' is called.");
2484*60432Shibler   Vprocess_connection_type = Qt;
2485*60432Shibler 
2486*60432Shibler   defsubr (&Sprocessp);
2487*60432Shibler   defsubr (&Sget_process);
2488*60432Shibler   defsubr (&Sget_buffer_process);
2489*60432Shibler   defsubr (&Sdelete_process);
2490*60432Shibler   defsubr (&Sprocess_status);
2491*60432Shibler   defsubr (&Sprocess_exit_status);
2492*60432Shibler   defsubr (&Sprocess_id);
2493*60432Shibler   defsubr (&Sprocess_name);
2494*60432Shibler   defsubr (&Sprocess_command);
2495*60432Shibler   defsubr (&Sset_process_buffer);
2496*60432Shibler   defsubr (&Sprocess_buffer);
2497*60432Shibler   defsubr (&Sprocess_mark);
2498*60432Shibler   defsubr (&Sset_process_filter);
2499*60432Shibler   defsubr (&Sprocess_filter);
2500*60432Shibler   defsubr (&Sset_process_sentinel);
2501*60432Shibler   defsubr (&Sprocess_sentinel);
2502*60432Shibler   defsubr (&Sprocess_kill_without_query);
2503*60432Shibler   defsubr (&Slist_processes);
2504*60432Shibler   defsubr (&Sprocess_list);
2505*60432Shibler   defsubr (&Sstart_process);
2506*60432Shibler #ifdef HAVE_SOCKETS
2507*60432Shibler   defsubr (&Sopen_network_stream);
2508*60432Shibler #endif /* HAVE_SOCKETS */
2509*60432Shibler   defsubr (&Saccept_process_output);
2510*60432Shibler   defsubr (&Sprocess_send_region);
2511*60432Shibler   defsubr (&Sprocess_send_string);
2512*60432Shibler   defsubr (&Sinterrupt_process);
2513*60432Shibler   defsubr (&Skill_process);
2514*60432Shibler   defsubr (&Squit_process);
2515*60432Shibler   defsubr (&Sstop_process);
2516*60432Shibler   defsubr (&Scontinue_process);
2517*60432Shibler   defsubr (&Sprocess_send_eof);
2518*60432Shibler   defsubr (&Swaiting_for_user_input_p);
2519*60432Shibler }
2520*60432Shibler 
2521*60432Shibler #endif subprocesses
2522