(rmail-output): If file is an Rmail file,
[bpt/emacs.git] / src / process.c
CommitLineData
d0d6b7c5 1/* Asynchronous subprocess control for GNU Emacs.
c6c5df7f 2 Copyright (C) 1985, 1986, 1987, 1988, 1993 Free Software Foundation, Inc.
d0d6b7c5
JB
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
1dc77cc3 8the Free Software Foundation; either version 2, or (at your option)
d0d6b7c5
JB
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
21#include <signal.h>
22
23#include "config.h"
24
6720a7fb
JB
25/* This file is split into two parts by the following preprocessor
26 conditional. The 'then' clause contains all of the support for
27 asynchronous subprocesses. The 'else' clause contains stub
28 versions of some of the asynchronous subprocess routines that are
29 often called elsewhere in Emacs, so we don't have to #ifdef the
30 sections that call them. */
31
32\f
d0d6b7c5 33#ifdef subprocesses
d0d6b7c5
JB
34
35#include <stdio.h>
36#include <errno.h>
37#include <setjmp.h>
38#include <sys/types.h> /* some typedefs are used in sys/file.h */
39#include <sys/file.h>
40#include <sys/stat.h>
41
42#ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
43#include <sys/socket.h>
44#include <netdb.h>
45#include <netinet/in.h>
46#include <arpa/inet.h>
47#endif /* HAVE_SOCKETS */
48
49#if defined(BSD) || defined(STRIDE)
50#include <sys/ioctl.h>
0ad77c54 51#if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
d0d6b7c5
JB
52#include <fcntl.h>
53#endif /* HAVE_PTYS and no O_NDELAY */
54#endif /* BSD or STRIDE */
d0d6b7c5
JB
55
56#ifdef NEED_BSDTTY
57#include <bsdtty.h>
58#endif
59
d0d6b7c5
JB
60#ifdef IRIS
61#include <sys/sysmacros.h> /* for "minor" */
62#endif /* not IRIS */
63
64#include "systime.h"
36ebaafa 65#include "systty.h"
d0d6b7c5
JB
66
67#include "lisp.h"
68#include "window.h"
69#include "buffer.h"
70#include "process.h"
71#include "termhooks.h"
72#include "termopts.h"
73#include "commands.h"
1dc77cc3 74#include "frame.h"
d0d6b7c5
JB
75
76Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed;
77/* Qexit is declared and initialized in eval.c. */
78
79/* a process object is a network connection when its childp field is neither
80 Qt nor Qnil but is instead a string (name of foreign host we
81 are connected to + name of port we are connected to) */
82
83#ifdef HAVE_SOCKETS
84static Lisp_Object stream_process;
85
86#define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String)
87#else
88#define NETCONN_P(p) 0
89#endif /* HAVE_SOCKETS */
90
91/* Define first descriptor number available for subprocesses. */
92#ifdef VMS
93#define FIRST_PROC_DESC 1
94#else /* Not VMS */
95#define FIRST_PROC_DESC 3
96#endif
97
98/* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
99 testing SIGCHLD. */
100
101#if !defined (SIGCHLD) && defined (SIGCLD)
102#define SIGCHLD SIGCLD
103#endif /* SIGCLD */
104
105#include "syssignal.h"
106
107/* Define the structure that the wait system call stores.
108 On many systems, there is a structure defined for this.
109 But on vanilla-ish USG systems there is not. */
110
111#ifndef VMS
112#ifndef WAITTYPE
161aa2f8 113#if (!defined (BSD) && !defined (UNIPLUS) && !defined (STRIDE) && !(defined (HPUX) && !defined (NOMULTIPLEJOBS)) && !defined (HAVE_WAIT_HEADER)) || defined (LINUX)
d0d6b7c5
JB
114#define WAITTYPE int
115#define WIFSTOPPED(w) ((w&0377) == 0177)
116#define WIFSIGNALED(w) ((w&0377) != 0177 && (w&~0377) == 0)
117#define WIFEXITED(w) ((w&0377) == 0)
118#define WRETCODE(w) (w >> 8)
119#define WSTOPSIG(w) (w >> 8)
d0d6b7c5 120#define WTERMSIG(w) (w & 0377)
ce4c9c90
RS
121#ifndef WCOREDUMP
122#define WCOREDUMP(w) ((w&0200) != 0)
123#endif
d0d6b7c5
JB
124#else
125#ifdef BSD4_1
126#include <wait.h>
127#else
128#include <sys/wait.h>
129#endif /* not BSD 4.1 */
130
131#define WAITTYPE union wait
132#define WRETCODE(w) w.w_retcode
133#define WCOREDUMP(w) w.w_coredump
134
135#ifdef HPUX
136/* HPUX version 7 has broken definitions of these. */
137#undef WTERMSIG
138#undef WSTOPSIG
139#undef WIFSTOPPED
140#undef WIFSIGNALED
141#undef WIFEXITED
142#endif
143
144#ifndef WTERMSIG
145#define WTERMSIG(w) w.w_termsig
146#endif
147#ifndef WSTOPSIG
148#define WSTOPSIG(w) w.w_stopsig
149#endif
150#ifndef WIFSTOPPED
151#define WIFSTOPPED(w) (WTERMSIG (w) == 0177)
152#endif
153#ifndef WIFSIGNALED
154#define WIFSIGNALED(w) (WTERMSIG (w) != 0177 && (WSTOPSIG (w)) == 0)
155#endif
156#ifndef WIFEXITED
157#define WIFEXITED(w) (WTERMSIG (w) == 0)
158#endif
159#endif /* BSD or UNIPLUS or STRIDE */
160#endif /* no WAITTYPE */
161#else /* VMS */
b0310da4 162#define WAITTYPE int
c6c6865d
JB
163#define WIFSTOPPED(w) 0
164#define WIFSIGNALED(w) 0
165#define WIFEXITED(w) ((w) != -1)
166#define WRETCODE(w) (w)
167#define WSTOPSIG(w) (w)
168#define WCOREDUMP(w) 0
169#define WTERMSIG(w) (w)
d0d6b7c5
JB
170#include <ssdef.h>
171#include <iodef.h>
172#include <clidef.h>
173#include "vmsproc.h"
174#endif /* VMS */
175
176extern errno;
177extern sys_nerr;
178extern char *sys_errlist[];
179
180#ifndef VMS
181#ifndef BSD4_1
084fd64a 182#ifndef LINUX
d0d6b7c5 183extern char *sys_siglist[];
084fd64a 184#endif
d0d6b7c5
JB
185#else
186char *sys_siglist[] =
187 {
188 "bum signal!!",
189 "hangup",
190 "interrupt",
191 "quit",
192 "illegal instruction",
193 "trace trap",
194 "iot instruction",
195 "emt instruction",
196 "floating point exception",
197 "kill",
198 "bus error",
199 "segmentation violation",
200 "bad argument to system call",
201 "write on a pipe with no one to read it",
202 "alarm clock",
203 "software termination signal from kill",
204 "status signal",
205 "sendable stop signal not from tty",
206 "stop signal from tty",
207 "continue a stopped process",
208 "child status has changed",
209 "background read attempted from control tty",
210 "background write attempted from control tty",
211 "input record available at control tty",
212 "exceeded CPU time limit",
213 "exceeded file size limit"
214 };
215#endif
216#endif /* VMS */
217
d0d6b7c5
JB
218/* t means use pty, nil means use a pipe,
219 maybe other values to come. */
220Lisp_Object Vprocess_connection_type;
221
222#ifdef SKTPAIR
223#ifndef HAVE_SOCKETS
224#include <sys/socket.h>
225#endif
226#endif /* SKTPAIR */
227
228/* Number of events of change of status of a process. */
229int process_tick;
230
231/* Number of events for which the user or sentinel has been notified. */
232int update_tick;
233
234#ifdef FD_SET
235/* We could get this from param.h, but better not to depend on finding that.
236 And better not to risk that it might define other symbols used in this
237 file. */
334c4f2f
RS
238#ifdef FD_SETSIZE
239#define MAXDESC FD_SETSIZE
240#else
d0d6b7c5 241#define MAXDESC 64
334c4f2f 242#endif
d0d6b7c5
JB
243#define SELECT_TYPE fd_set
244#else /* no FD_SET */
245#define MAXDESC 32
246#define SELECT_TYPE int
247
248/* Define the macros to access a single-int bitmap of descriptors. */
249#define FD_SET(n, p) (*(p) |= (1 << (n)))
250#define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
251#define FD_ISSET(n, p) (*(p) & (1 << (n)))
252#define FD_ZERO(p) (*(p) = 0)
253#endif /* no FD_SET */
254
255/* Mask of bits indicating the descriptors that we wait for input on */
256
257SELECT_TYPE input_wait_mask;
258
259int delete_exited_processes;
260
261/* Indexed by descriptor, gives the process (if any) for that descriptor */
262Lisp_Object chan_process[MAXDESC];
263
264/* Alist of elements (NAME . PROCESS) */
265Lisp_Object Vprocess_alist;
266
267Lisp_Object Qprocessp;
268
269Lisp_Object get_process ();
270
271/* Buffered-ahead input char from process, indexed by channel.
272 -1 means empty (no char is buffered).
273 Used on sys V where the only way to tell if there is any
274 output from the process is to read at least one char.
275 Always -1 on systems that support FIONREAD. */
276
277int proc_buffered_char[MAXDESC];
278\f
279/* Compute the Lisp form of the process status, p->status, from
280 the numeric status that was returned by `wait'. */
281
f9738840
JB
282Lisp_Object status_convert ();
283
d0d6b7c5
JB
284update_status (p)
285 struct Lisp_Process *p;
286{
287 union { int i; WAITTYPE wt; } u;
288 u.i = XFASTINT (p->raw_status_low) + (XFASTINT (p->raw_status_high) << 16);
289 p->status = status_convert (u.wt);
290 p->raw_status_low = Qnil;
291 p->raw_status_high = Qnil;
292}
293
91d10fa8 294/* Convert a process status word in Unix format to
d0d6b7c5
JB
295 the list that we use internally. */
296
297Lisp_Object
298status_convert (w)
299 WAITTYPE w;
300{
301 if (WIFSTOPPED (w))
302 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
303 else if (WIFEXITED (w))
304 return Fcons (Qexit, Fcons (make_number (WRETCODE (w)),
305 WCOREDUMP (w) ? Qt : Qnil));
306 else if (WIFSIGNALED (w))
307 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
308 WCOREDUMP (w) ? Qt : Qnil));
309 else
310 return Qrun;
311}
312
313/* Given a status-list, extract the three pieces of information
314 and store them individually through the three pointers. */
315
316void
317decode_status (l, symbol, code, coredump)
318 Lisp_Object l;
319 Lisp_Object *symbol;
320 int *code;
321 int *coredump;
322{
323 Lisp_Object tem;
324
325 if (XTYPE (l) == Lisp_Symbol)
326 {
327 *symbol = l;
328 *code = 0;
329 *coredump = 0;
330 }
331 else
332 {
333 *symbol = XCONS (l)->car;
334 tem = XCONS (l)->cdr;
335 *code = XFASTINT (XCONS (tem)->car);
f9738840 336 tem = XCONS (tem)->cdr;
d0d6b7c5
JB
337 *coredump = !NILP (tem);
338 }
339}
340
341/* Return a string describing a process status list. */
342
343Lisp_Object
344status_message (status)
345 Lisp_Object status;
346{
347 Lisp_Object symbol;
348 int code, coredump;
349 Lisp_Object string, string2;
350
351 decode_status (status, &symbol, &code, &coredump);
352
353 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
354 {
b0310da4 355#ifndef VMS
d0d6b7c5 356 string = build_string (code < NSIG ? sys_siglist[code] : "unknown");
b0310da4
JB
357#else
358 string = build_string (code < NSIG ? sys_errlist[code] : "unknown");
359#endif
d0d6b7c5
JB
360 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
361 XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
362 return concat2 (string, string2);
363 }
364 else if (EQ (symbol, Qexit))
365 {
366 if (code == 0)
367 return build_string ("finished\n");
f2980264 368 string = Fnumber_to_string (make_number (code));
d0d6b7c5
JB
369 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
370 return concat2 (build_string ("exited abnormally with code "),
371 concat2 (string, string2));
372 }
373 else
374 return Fcopy_sequence (Fsymbol_name (symbol));
375}
376\f
377#ifdef HAVE_PTYS
d0d6b7c5
JB
378
379/* Open an available pty, returning a file descriptor.
380 Return -1 on failure.
381 The file name of the terminal corresponding to the pty
382 is left in the variable pty_name. */
383
384char pty_name[24];
385
386int
387allocate_pty ()
388{
389 struct stat stb;
390 register c, i;
391 int fd;
392
32676c08
JB
393 /* Some systems name their pseudoterminals so that there are gaps in
394 the usual sequence - for example, on HP9000/S700 systems, there
395 are no pseudoterminals with names ending in 'f'. So we wait for
396 three failures in a row before deciding that we've reached the
397 end of the ptys. */
398 int failed_count = 0;
399
d0d6b7c5
JB
400#ifdef PTY_ITERATION
401 PTY_ITERATION
402#else
403 for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
404 for (i = 0; i < 16; i++)
405#endif
406 {
407#ifdef PTY_NAME_SPRINTF
408 PTY_NAME_SPRINTF
d0d6b7c5
JB
409#else
410 sprintf (pty_name, "/dev/pty%c%x", c, i);
d0d6b7c5
JB
411#endif /* no PTY_NAME_SPRINTF */
412
4d7c105e
RS
413#ifdef PTY_OPEN
414 PTY_OPEN;
415#else /* no PTY_OPEN */
32676c08
JB
416#ifdef IRIS
417 /* Unusual IRIS code */
418 *ptyv = open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
419 if (fd < 0)
420 return -1;
421 if (fstat (fd, &stb) < 0)
d0d6b7c5 422 return -1;
4d7c105e 423#else /* not IRIS */
32676c08
JB
424 if (stat (pty_name, &stb) < 0)
425 {
426 failed_count++;
427 if (failed_count >= 3)
428 return -1;
429 }
430 else
431 failed_count = 0;
d0d6b7c5
JB
432#ifdef O_NONBLOCK
433 fd = open (pty_name, O_RDWR | O_NONBLOCK, 0);
434#else
435 fd = open (pty_name, O_RDWR | O_NDELAY, 0);
436#endif
4d7c105e
RS
437#endif /* not IRIS */
438#endif /* no PTY_OPEN */
d0d6b7c5
JB
439
440 if (fd >= 0)
441 {
442 /* check to make certain that both sides are available
443 this avoids a nasty yet stupid bug in rlogins */
444#ifdef PTY_TTY_NAME_SPRINTF
445 PTY_TTY_NAME_SPRINTF
d0d6b7c5
JB
446#else
447 sprintf (pty_name, "/dev/tty%c%x", c, i);
d0d6b7c5
JB
448#endif /* no PTY_TTY_NAME_SPRINTF */
449#ifndef UNIPLUS
450 if (access (pty_name, 6) != 0)
451 {
452 close (fd);
fad97cbe 453#if !defined(IRIS) && !defined(__sgi)
d0d6b7c5
JB
454 continue;
455#else
456 return -1;
457#endif /* IRIS */
458 }
459#endif /* not UNIPLUS */
460 setup_pty (fd);
461 return fd;
462 }
463 }
464 return -1;
465}
466#endif /* HAVE_PTYS */
467\f
468Lisp_Object
469make_process (name)
470 Lisp_Object name;
471{
472 register Lisp_Object val, tem, name1;
473 register struct Lisp_Process *p;
474 char suffix[10];
475 register int i;
476
477 /* size of process structure includes the vector header,
478 so deduct for that. But struct Lisp_Vector includes the first
479 element, thus deducts too much, so add it back. */
480 val = Fmake_vector (make_number ((sizeof (struct Lisp_Process)
481 - sizeof (struct Lisp_Vector)
482 + sizeof (Lisp_Object))
483 / sizeof (Lisp_Object)),
484 Qnil);
485 XSETTYPE (val, Lisp_Process);
486
487 p = XPROCESS (val);
488 XFASTINT (p->infd) = 0;
489 XFASTINT (p->outfd) = 0;
490 XFASTINT (p->pid) = 0;
491 XFASTINT (p->tick) = 0;
492 XFASTINT (p->update_tick) = 0;
493 p->raw_status_low = Qnil;
494 p->raw_status_high = Qnil;
495 p->status = Qrun;
496 p->mark = Fmake_marker ();
497
498 /* If name is already in use, modify it until it is unused. */
499
500 name1 = name;
501 for (i = 1; ; i++)
502 {
503 tem = Fget_process (name1);
504 if (NILP (tem)) break;
505 sprintf (suffix, "<%d>", i);
506 name1 = concat2 (name, build_string (suffix));
507 }
508 name = name1;
509 p->name = name;
510 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
511 return val;
512}
513
514remove_process (proc)
515 register Lisp_Object proc;
516{
517 register Lisp_Object pair;
518
519 pair = Frassq (proc, Vprocess_alist);
520 Vprocess_alist = Fdelq (pair, Vprocess_alist);
521 Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil);
522
523 deactivate_process (proc);
524}
525\f
526DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
527 "Return t if OBJECT is a process.")
528 (obj)
529 Lisp_Object obj;
530{
531 return XTYPE (obj) == Lisp_Process ? Qt : Qnil;
532}
533
534DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
535 "Return the process named NAME, or nil if there is none.")
536 (name)
537 register Lisp_Object name;
538{
539 if (XTYPE (name) == Lisp_Process)
540 return name;
541 CHECK_STRING (name, 0);
542 return Fcdr (Fassoc (name, Vprocess_alist));
543}
544
545DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
546 "Return the (or, a) process associated with BUFFER.\n\
547BUFFER may be a buffer or the name of one.")
548 (name)
549 register Lisp_Object name;
550{
551 register Lisp_Object buf, tail, proc;
552
553 if (NILP (name)) return Qnil;
554 buf = Fget_buffer (name);
555 if (NILP (buf)) return Qnil;
556
557 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
558 {
559 proc = Fcdr (Fcar (tail));
560 if (XTYPE (proc) == Lisp_Process && EQ (XPROCESS (proc)->buffer, buf))
561 return proc;
562 }
563 return Qnil;
564}
565
ebb9e16f
JB
566/* This is how commands for the user decode process arguments. It
567 accepts a process, a process name, a buffer, a buffer name, or nil.
568 Buffers denote the first process in the buffer, and nil denotes the
569 current buffer. */
d0d6b7c5
JB
570
571Lisp_Object
572get_process (name)
573 register Lisp_Object name;
574{
575 register Lisp_Object proc;
576 if (NILP (name))
577 proc = Fget_buffer_process (Fcurrent_buffer ());
578 else
579 {
580 proc = Fget_process (name);
581 if (NILP (proc))
582 proc = Fget_buffer_process (Fget_buffer (name));
583 }
584
585 if (!NILP (proc))
586 return proc;
587
588 if (NILP (name))
589 error ("Current buffer has no process");
590 else
591 error ("Process %s does not exist", XSTRING (name)->data);
592 /* NOTREACHED */
593}
594
595DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
596 "Delete PROCESS: kill it and forget about it immediately.\n\
ebb9e16f
JB
597PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
598nil, indicating the current buffer's process.")
d0d6b7c5
JB
599 (proc)
600 register Lisp_Object proc;
601{
602 proc = get_process (proc);
603 XPROCESS (proc)->raw_status_low = Qnil;
604 XPROCESS (proc)->raw_status_high = Qnil;
605 if (NETCONN_P (proc))
606 {
607 XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
608 XSETINT (XPROCESS (proc)->tick, ++process_tick);
609 }
610 else if (XFASTINT (XPROCESS (proc)->infd))
611 {
612 Fkill_process (proc, Qnil);
613 /* Do this now, since remove_process will make sigchld_handler do nothing. */
614 XPROCESS (proc)->status
615 = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
616 XSETINT (XPROCESS (proc)->tick, ++process_tick);
617 status_notify ();
618 }
619 remove_process (proc);
620 return Qnil;
621}
622\f
623DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
624 "Return the status of PROCESS: a symbol, one of these:\n\
625run -- for a process that is running.\n\
626stop -- for a process stopped but continuable.\n\
627exit -- for a process that has exited.\n\
628signal -- for a process that has got a fatal signal.\n\
629open -- for a network stream connection that is open.\n\
630closed -- for a network stream connection that is closed.\n\
ebb9e16f
JB
631nil -- if arg is a process name and no such process exists.\n\
632PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
633nil, indicating the current buffer's process.")
d0d6b7c5
JB
634/* command -- for a command channel opened to Emacs by another process.\n\
635 external -- for an i/o channel opened to Emacs by another process.\n\ */
636 (proc)
637 register Lisp_Object proc;
638{
639 register struct Lisp_Process *p;
640 register Lisp_Object status;
ebb9e16f 641 proc = get_process (proc);
d0d6b7c5
JB
642 if (NILP (proc))
643 return proc;
644 p = XPROCESS (proc);
645 if (!NILP (p->raw_status_low))
646 update_status (p);
647 status = p->status;
648 if (XTYPE (status) == Lisp_Cons)
649 status = XCONS (status)->car;
650 if (NETCONN_P (proc))
651 {
652 if (EQ (status, Qrun))
653 status = Qopen;
654 else if (EQ (status, Qexit))
655 status = Qclosed;
656 }
657 return status;
658}
659
660DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
661 1, 1, 0,
662 "Return the exit status of PROCESS or the signal number that killed it.\n\
663If PROCESS has not yet exited or died, return 0.")
664 (proc)
665 register Lisp_Object proc;
666{
667 CHECK_PROCESS (proc, 0);
668 if (!NILP (XPROCESS (proc)->raw_status_low))
669 update_status (XPROCESS (proc));
670 if (XTYPE (XPROCESS (proc)->status) == Lisp_Cons)
671 return XCONS (XCONS (XPROCESS (proc)->status)->cdr)->car;
672 return make_number (0);
673}
674
675DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
676 "Return the process id of PROCESS.\n\
677This is the pid of the Unix process which PROCESS uses or talks to.\n\
678For a network connection, this value is nil.")
679 (proc)
680 register Lisp_Object proc;
681{
682 CHECK_PROCESS (proc, 0);
683 return XPROCESS (proc)->pid;
684}
685
686DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
687 "Return the name of PROCESS, as a string.\n\
688This is the name of the program invoked in PROCESS,\n\
689possibly modified to make it unique among process names.")
690 (proc)
691 register Lisp_Object proc;
692{
693 CHECK_PROCESS (proc, 0);
694 return XPROCESS (proc)->name;
695}
696
697DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
698 "Return the command that was executed to start PROCESS.\n\
699This is a list of strings, the first string being the program executed\n\
700and the rest of the strings being the arguments given to it.\n\
701For a non-child channel, this is nil.")
702 (proc)
703 register Lisp_Object proc;
704{
705 CHECK_PROCESS (proc, 0);
706 return XPROCESS (proc)->command;
707}
708
709DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
710 2, 2, 0,
711 "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
712 (proc, buffer)
713 register Lisp_Object proc, buffer;
714{
715 CHECK_PROCESS (proc, 0);
716 if (!NILP (buffer))
717 CHECK_BUFFER (buffer, 1);
718 XPROCESS (proc)->buffer = buffer;
719 return buffer;
720}
721
722DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
723 1, 1, 0,
724 "Return the buffer PROCESS is associated with.\n\
725Output from PROCESS is inserted in this buffer\n\
726unless PROCESS has a filter.")
727 (proc)
728 register Lisp_Object proc;
729{
730 CHECK_PROCESS (proc, 0);
731 return XPROCESS (proc)->buffer;
732}
733
734DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
735 1, 1, 0,
736 "Return the marker for the end of the last output from PROCESS.")
737 (proc)
738 register Lisp_Object proc;
739{
740 CHECK_PROCESS (proc, 0);
741 return XPROCESS (proc)->mark;
742}
743
744DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
745 2, 2, 0,
746 "Give PROCESS the filter function FILTER; nil means no filter.\n\
747When a process has a filter, each time it does output\n\
748the entire string of output is passed to the filter.\n\
749The filter gets two arguments: the process and the string of output.\n\
750If the process has a filter, its buffer is not used for output.")
751 (proc, filter)
752 register Lisp_Object proc, filter;
753{
754 CHECK_PROCESS (proc, 0);
755 XPROCESS (proc)->filter = filter;
756 return filter;
757}
758
759DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
760 1, 1, 0,
761 "Returns the filter function of PROCESS; nil if none.\n\
762See `set-process-filter' for more info on filter functions.")
763 (proc)
764 register Lisp_Object proc;
765{
766 CHECK_PROCESS (proc, 0);
767 return XPROCESS (proc)->filter;
768}
769
770DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
771 2, 2, 0,
772 "Give PROCESS the sentinel SENTINEL; nil for none.\n\
773The sentinel is called as a function when the process changes state.\n\
774It gets two arguments: the process, and a string describing the change.")
775 (proc, sentinel)
776 register Lisp_Object proc, sentinel;
777{
778 CHECK_PROCESS (proc, 0);
779 XPROCESS (proc)->sentinel = sentinel;
780 return sentinel;
781}
782
783DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
784 1, 1, 0,
785 "Return the sentinel of PROCESS; nil if none.\n\
786See `set-process-sentinel' for more info on sentinels.")
787 (proc)
788 register Lisp_Object proc;
789{
790 CHECK_PROCESS (proc, 0);
791 return XPROCESS (proc)->sentinel;
792}
793
794DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
795 Sprocess_kill_without_query, 1, 2, 0,
796 "Say no query needed if PROCESS is running when Emacs is exited.\n\
797Optional second argument if non-nill says to require a query.\n\
798Value is t if a query was formerly required.")
799 (proc, value)
800 register Lisp_Object proc, value;
801{
802 Lisp_Object tem;
803
804 CHECK_PROCESS (proc, 0);
805 tem = XPROCESS (proc)->kill_without_query;
806 XPROCESS (proc)->kill_without_query = Fnull (value);
807
808 return Fnull (tem);
809}
810\f
811Lisp_Object
812list_processes_1 ()
813{
814 register Lisp_Object tail, tem;
815 Lisp_Object proc, minspace, tem1;
816 register struct buffer *old = current_buffer;
817 register struct Lisp_Process *p;
818 register int state;
819 char tembuf[80];
820
821 XFASTINT (minspace) = 1;
822
823 set_buffer_internal (XBUFFER (Vstandard_output));
824 Fbuffer_disable_undo (Vstandard_output);
825
826 current_buffer->truncate_lines = Qt;
827
828 write_string ("\
829Proc Status Buffer Command\n\
830---- ------ ------ -------\n", -1);
831
832 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
833 {
834 Lisp_Object symbol;
835
836 proc = Fcdr (Fcar (tail));
837 p = XPROCESS (proc);
838 if (NILP (p->childp))
839 continue;
840
841 Finsert (1, &p->name);
842 Findent_to (make_number (13), minspace);
843
844 if (!NILP (p->raw_status_low))
845 update_status (p);
846 symbol = p->status;
847 if (XTYPE (p->status) == Lisp_Cons)
848 symbol = XCONS (p->status)->car;
849
850
851 if (EQ (symbol, Qsignal))
852 {
853 Lisp_Object tem;
854 tem = Fcar (Fcdr (p->status));
855#ifdef VMS
856 if (XINT (tem) < NSIG)
b0310da4 857 write_string (sys_errlist [XINT (tem)], -1);
d0d6b7c5
JB
858 else
859#endif
860 Fprinc (symbol, Qnil);
861 }
862 else if (NETCONN_P (proc))
863 {
864 if (EQ (symbol, Qrun))
865 write_string ("open", -1);
866 else if (EQ (symbol, Qexit))
867 write_string ("closed", -1);
868 else
869 Fprinc (symbol, Qnil);
870 }
871 else
872 Fprinc (symbol, Qnil);
873
874 if (EQ (symbol, Qexit))
875 {
876 Lisp_Object tem;
877 tem = Fcar (Fcdr (p->status));
878 if (XFASTINT (tem))
879 {
880 sprintf (tembuf, " %d", XFASTINT (tem));
881 write_string (tembuf, -1);
882 }
883 }
884
885 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
886 remove_process (proc);
887
888 Findent_to (make_number (22), minspace);
889 if (NILP (p->buffer))
890 insert_string ("(none)");
891 else if (NILP (XBUFFER (p->buffer)->name))
892 insert_string ("(Killed)");
893 else
894 Finsert (1, &XBUFFER (p->buffer)->name);
895
896 Findent_to (make_number (37), minspace);
897
898 if (NETCONN_P (proc))
899 {
900 sprintf (tembuf, "(network stream connection to %s)\n",
901 XSTRING (p->childp)->data);
902 insert_string (tembuf);
903 }
904 else
905 {
906 tem = p->command;
907 while (1)
908 {
909 tem1 = Fcar (tem);
910 Finsert (1, &tem1);
911 tem = Fcdr (tem);
912 if (NILP (tem))
913 break;
914 insert_string (" ");
915 }
916 insert_string ("\n");
917 }
918 }
919 return Qnil;
920}
921
922DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",
923 "Display a list of all processes.\n\
924\(Any processes listed as Exited or Signaled are actually eliminated\n\
925after the listing is made.)")
926 ()
927{
928 internal_with_output_to_temp_buffer ("*Process List*",
929 list_processes_1, Qnil);
930 return Qnil;
931}
932
933DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
934 "Return a list of all processes.")
935 ()
936{
937 return Fmapcar (Qcdr, Vprocess_alist);
938}
939\f
b0310da4
JB
940/* Starting asynchronous inferior processes. */
941
942static Lisp_Object start_process_unwind ();
943
d0d6b7c5
JB
944DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
945 "Start a program in a subprocess. Return the process object for it.\n\
946Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
947NAME is name for process. It is modified if necessary to make it unique.\n\
948BUFFER is the buffer or (buffer-name) to associate with the process.\n\
949 Process output goes at end of that buffer, unless you specify\n\
950 an output stream or filter function to handle the output.\n\
951 BUFFER may be also nil, meaning that this process is not associated\n\
952 with any buffer\n\
953Third arg is program file name. It is searched for as in the shell.\n\
954Remaining arguments are strings to give program as arguments.")
955 (nargs, args)
956 int nargs;
957 register Lisp_Object *args;
958{
1e30af70 959 Lisp_Object buffer, name, program, proc, current_dir, tem;
d0d6b7c5
JB
960#ifdef VMS
961 register unsigned char *new_argv;
962 int len;
963#else
964 register unsigned char **new_argv;
965#endif
966 register int i;
b0310da4 967 int count = specpdl_ptr - specpdl;
d0d6b7c5
JB
968
969 buffer = args[1];
970 if (!NILP (buffer))
971 buffer = Fget_buffer_create (buffer);
972
1e30af70
JB
973 /* Make sure that the child will be able to chdir to the current
974 buffer's current directory, or its unhandled equivalent. We
975 can't just have the child check for an error when it does the
976 chdir, since it's in a vfork.
977
978 We have to GCPRO around this because Fexpand_file_name and
979 Funhandled_file_name_directory might call a file name handling
980 function. The argument list is protected by the caller, so all
981 we really have to worry about is buffer. */
982 {
983 struct gcpro gcpro1, gcpro2;
984
985 current_dir = current_buffer->directory;
986
987 GCPRO2 (buffer, current_dir);
988
989 current_dir =
990 expand_and_dir_to_file
82df4891 991 (Funhandled_file_name_directory (current_dir), Qnil);
1e30af70
JB
992 if (NILP (Ffile_accessible_directory_p (current_dir)))
993 report_file_error ("Setting current directory",
994 Fcons (current_buffer->directory, Qnil));
995
996 UNGCPRO;
997 }
998
d0d6b7c5
JB
999 name = args[0];
1000 CHECK_STRING (name, 0);
1001
1002 program = args[2];
1003
1004 CHECK_STRING (program, 2);
1005
1006#ifdef VMS
1007 /* Make a one member argv with all args concatenated
1008 together separated by a blank. */
1009 len = XSTRING (program)->size + 2;
1010 for (i = 3; i < nargs; i++)
1011 {
1012 tem = args[i];
1013 CHECK_STRING (tem, i);
1014 len += XSTRING (tem)->size + 1; /* count the blank */
1015 }
1016 new_argv = (unsigned char *) alloca (len);
1017 strcpy (new_argv, XSTRING (program)->data);
1018 for (i = 3; i < nargs; i++)
1019 {
1020 tem = args[i];
1021 CHECK_STRING (tem, i);
1022 strcat (new_argv, " ");
1023 strcat (new_argv, XSTRING (tem)->data);
1024 }
b0310da4
JB
1025 /* Need to add code here to check for program existence on VMS */
1026
d0d6b7c5
JB
1027#else /* not VMS */
1028 new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
1029
1030 for (i = 3; i < nargs; i++)
1031 {
1032 tem = args[i];
1033 CHECK_STRING (tem, i);
1034 new_argv[i - 2] = XSTRING (tem)->data;
1035 }
1036 new_argv[i - 2] = 0;
1037 new_argv[0] = XSTRING (program)->data;
1038
1039 /* If program file name is not absolute, search our path for it */
1040 if (new_argv[0][0] != '/')
1041 {
1042 tem = Qnil;
5437e9f9 1043 openp (Vexec_path, program, EXEC_SUFFIXES, &tem, 1);
d0d6b7c5
JB
1044 if (NILP (tem))
1045 report_file_error ("Searching for program", Fcons (program, Qnil));
1046 new_argv[0] = XSTRING (tem)->data;
1047 }
1048#endif /* not VMS */
1049
1050 proc = make_process (name);
b0310da4
JB
1051 /* If an error occurs and we can't start the process, we want to
1052 remove it from the process list. This means that each error
1053 check in create_process doesn't need to call remove_process
1054 itself; it's all taken care of here. */
1055 record_unwind_protect (start_process_unwind, proc);
d0d6b7c5
JB
1056
1057 XPROCESS (proc)->childp = Qt;
1058 XPROCESS (proc)->command_channel_p = Qnil;
1059 XPROCESS (proc)->buffer = buffer;
1060 XPROCESS (proc)->sentinel = Qnil;
1061 XPROCESS (proc)->filter = Qnil;
1062 XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
1063
1e30af70 1064 create_process (proc, new_argv, current_dir);
d0d6b7c5 1065
b0310da4 1066 return unbind_to (count, proc);
d0d6b7c5
JB
1067}
1068
b0310da4
JB
1069/* This function is the unwind_protect form for Fstart_process. If
1070 PROC doesn't have its pid set, then we know someone has signalled
1071 an error and the process wasn't started successfully, so we should
1072 remove it from the process list. */
1073static Lisp_Object
1074start_process_unwind (proc)
1075 Lisp_Object proc;
1076{
1077 if (XTYPE (proc) != Lisp_Process)
1078 abort ();
1079
1080 /* Was PROC started successfully? */
188d6c4e 1081 if (XINT (XPROCESS (proc)->pid) <= 0)
b0310da4
JB
1082 remove_process (proc);
1083
1084 return Qnil;
1085}
1086
1087
d0d6b7c5
JB
1088SIGTYPE
1089create_process_1 (signo)
1090 int signo;
1091{
1092#ifdef USG
1093 /* USG systems forget handlers when they are used;
1094 must reestablish each time */
1095 signal (signo, create_process_1);
1096#endif /* USG */
1097}
1098
1099#if 0 /* This doesn't work; see the note before sigchld_handler. */
1100#ifdef USG
1101#ifdef SIGCHLD
1102/* Mimic blocking of signals on system V, which doesn't really have it. */
1103
1104/* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1105int sigchld_deferred;
1106
1107SIGTYPE
1108create_process_sigchld ()
1109{
1110 signal (SIGCHLD, create_process_sigchld);
1111
1112 sigchld_deferred = 1;
1113}
1114#endif
1115#endif
1116#endif
1117
1118#ifndef VMS /* VMS version of this function is in vmsproc.c. */
1e30af70 1119create_process (process, new_argv, current_dir)
d0d6b7c5
JB
1120 Lisp_Object process;
1121 char **new_argv;
1e30af70 1122 Lisp_Object current_dir;
d0d6b7c5
JB
1123{
1124 int pid, inchannel, outchannel, forkin, forkout;
1125 int sv[2];
1126#ifdef SIGCHLD
1127 SIGTYPE (*sigchld)();
1128#endif
1129 int pty_flag = 0;
d0d6b7c5
JB
1130 extern char **environ;
1131
d0d6b7c5
JB
1132 inchannel = outchannel = -1;
1133
1134#ifdef HAVE_PTYS
1135 if (EQ (Vprocess_connection_type, Qt))
1136 outchannel = inchannel = allocate_pty ();
1137
d0d6b7c5
JB
1138 if (inchannel >= 0)
1139 {
1140#ifndef USG
1141 /* On USG systems it does not work to open the pty's tty here
1142 and then close and reopen it in the child. */
1143#ifdef O_NOCTTY
1144 /* Don't let this terminal become our controlling terminal
1145 (in case we don't have one). */
1146 forkout = forkin = open (pty_name, O_RDWR | O_NOCTTY, 0);
1147#else
1148 forkout = forkin = open (pty_name, O_RDWR, 0);
1149#endif
1150 if (forkin < 0)
1151 report_file_error ("Opening pty", Qnil);
1152#else
1153 forkin = forkout = -1;
1154#endif /* not USG */
1155 pty_flag = 1;
1156 }
1157 else
1158#endif /* HAVE_PTYS */
1159#ifdef SKTPAIR
1160 {
1161 if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0)
1162 report_file_error ("Opening socketpair", Qnil);
1163 outchannel = inchannel = sv[0];
1164 forkout = forkin = sv[1];
1165 }
1166#else /* not SKTPAIR */
1167 {
1168 pipe (sv);
1169 inchannel = sv[0];
1170 forkout = sv[1];
1171 pipe (sv);
1172 outchannel = sv[1];
1173 forkin = sv[0];
1174 }
1175#endif /* not SKTPAIR */
1176
1177#if 0
1178 /* Replaced by close_process_descs */
1179 set_exclusive_use (inchannel);
1180 set_exclusive_use (outchannel);
1181#endif
1182
1183/* Stride people say it's a mystery why this is needed
1184 as well as the O_NDELAY, but that it fails without this. */
1185#if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1186 {
1187 int one = 1;
1188 ioctl (inchannel, FIONBIO, &one);
1189 }
1190#endif
1191
1192#ifdef O_NONBLOCK
1193 fcntl (inchannel, F_SETFL, O_NONBLOCK);
1194#else
1195#ifdef O_NDELAY
1196 fcntl (inchannel, F_SETFL, O_NDELAY);
1197#endif
1198#endif
1199
1200 /* Record this as an active process, with its channels.
1201 As a result, child_setup will close Emacs's side of the pipes. */
1202 chan_process[inchannel] = process;
1203 XFASTINT (XPROCESS (process)->infd) = inchannel;
1204 XFASTINT (XPROCESS (process)->outfd) = outchannel;
1205 /* Record the tty descriptor used in the subprocess. */
1206 if (forkin < 0)
1207 XPROCESS (process)->subtty = Qnil;
1208 else
1209 XFASTINT (XPROCESS (process)->subtty) = forkin;
1210 XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
1211 XPROCESS (process)->status = Qrun;
1212
1213 /* Delay interrupts until we have a chance to store
1214 the new fork's pid in its process structure */
1215#ifdef SIGCHLD
1216#ifdef BSD4_1
1217 sighold (SIGCHLD);
1218#else /* not BSD4_1 */
1219#if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1220 sigsetmask (sigmask (SIGCHLD));
1221#else /* ordinary USG */
1222#if 0
1223 sigchld_deferred = 0;
1224 sigchld = signal (SIGCHLD, create_process_sigchld);
1225#endif
1226#endif /* ordinary USG */
1227#endif /* not BSD4_1 */
1228#endif /* SIGCHLD */
1229
1230 /* Until we store the proper pid, enable sigchld_handler
1231 to recognize an unknown pid as standing for this process.
1232 It is very important not to let this `marker' value stay
1233 in the table after this function has returned; if it does
1234 it might cause call-process to hang and subsequent asynchronous
1235 processes to get their return values scrambled. */
1236 XSETINT (XPROCESS (process)->pid, -1);
1237
1238 {
1239 /* child_setup must clobber environ on systems with true vfork.
1240 Protect it from permanent change. */
1241 char **save_environ = environ;
1242
1243 pid = vfork ();
1244 if (pid == 0)
1245 {
1246 int xforkin = forkin;
1247 int xforkout = forkout;
1248
1249#if 0 /* This was probably a mistake--it duplicates code later on,
1250 but fails to handle all the cases. */
1251 /* Make sure SIGCHLD is not blocked in the child. */
1252 sigsetmask (SIGEMPTYMASK);
1253#endif
1254
1255 /* Make the pty be the controlling terminal of the process. */
1256#ifdef HAVE_PTYS
1257 /* First, disconnect its current controlling terminal. */
1258#ifdef HAVE_SETSID
1259 setsid ();
ce4c9c90
RS
1260#ifdef TIOCSCTTY
1261 /* Make the pty's terminal the controlling terminal. */
084fd64a
RS
1262 if (pty_flag)
1263 /* We ignore the return value
1264 because faith@cs.unc.edu says that is necessary on Linux. */
1265 ioctl (xforkin, TIOCSCTTY, 0);
ce4c9c90 1266#endif
d0d6b7c5 1267#else /* not HAVE_SETSID */
b5aaed99 1268#if defined (USG) && !defined (IRIX)
d0d6b7c5
JB
1269 /* It's very important to call setpgrp() here and no time
1270 afterwards. Otherwise, we lose our controlling tty which
1271 is set when we open the pty. */
1272 setpgrp ();
1273#endif /* USG */
1274#endif /* not HAVE_SETSID */
1275#ifdef TIOCNOTTY
1276 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1277 can do TIOCSPGRP only to the process's controlling tty. */
1278 if (pty_flag)
1279 {
1280 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1281 I can't test it since I don't have 4.3. */
1282 int j = open ("/dev/tty", O_RDWR, 0);
1283 ioctl (j, TIOCNOTTY, 0);
1284 close (j);
5a570e37 1285#ifndef USG
d0d6b7c5
JB
1286 /* In order to get a controlling terminal on some versions
1287 of BSD, it is necessary to put the process in pgrp 0
1288 before it opens the terminal. */
1289 setpgrp (0, 0);
1290#endif
1291 }
1292#endif /* TIOCNOTTY */
1293
1294#if !defined (RTU) && !defined (UNIPLUS)
1295/*** There is a suggestion that this ought to be a
1296 conditional on TIOCSPGRP. */
1297 /* Now close the pty (if we had it open) and reopen it.
1298 This makes the pty the controlling terminal of the subprocess. */
1299 if (pty_flag)
1300 {
1301 /* I wonder if close (open (pty_name, ...)) would work? */
1302 if (xforkin >= 0)
1303 close (xforkin);
1304 xforkout = xforkin = open (pty_name, O_RDWR, 0);
1305
1306 if (xforkin < 0)
1307 abort ();
1308 }
1309#endif /* not UNIPLUS and not RTU */
1310#ifdef SETUP_SLAVE_PTY
1311 SETUP_SLAVE_PTY;
1312#endif /* SETUP_SLAVE_PTY */
1313#ifdef AIX
1314 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1315 Now reenable it in the child, so it will die when we want it to. */
1316 if (pty_flag)
1317 signal (SIGHUP, SIG_DFL);
1318#endif
1319#endif /* HAVE_PTYS */
1320
1321#ifdef SIGCHLD
1322#ifdef BSD4_1
1323 sigrelse (SIGCHLD);
1324#else /* not BSD4_1 */
1325#if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1326 sigsetmask (SIGEMPTYMASK);
1327#else /* ordinary USG */
63528b78 1328#if 0
d0d6b7c5 1329 signal (SIGCHLD, sigchld);
63528b78 1330#endif
d0d6b7c5
JB
1331#endif /* ordinary USG */
1332#endif /* not BSD4_1 */
1333#endif /* SIGCHLD */
1334
1335 child_setup_tty (xforkout);
1336 child_setup (xforkin, xforkout, xforkout,
e065a56e 1337 new_argv, 1, current_dir);
d0d6b7c5
JB
1338 }
1339 environ = save_environ;
1340 }
1341
1342 if (pid < 0)
b0310da4
JB
1343 report_file_error ("Doing vfork", Qnil);
1344
d0d6b7c5
JB
1345 XFASTINT (XPROCESS (process)->pid) = pid;
1346
1347 FD_SET (inchannel, &input_wait_mask);
1348
1349 /* If the subfork execv fails, and it exits,
1350 this close hangs. I don't know why.
1351 So have an interrupt jar it loose. */
1352 stop_polling ();
1353 signal (SIGALRM, create_process_1);
1354 alarm (1);
1355#ifdef SYSV4_PTYS
1356 /* OK to close only if it's not a pty. Otherwise we need to leave
1357 it open for ioctl to get pgrp when signals are sent, or to send
1358 the interrupt characters through if that's how we're signalling
1359 subprocesses. Alternately if you are concerned about running out
1360 of file descriptors, you could just save the tty name and open
1361 just to do the ioctl. */
1362 if (NILP (XFASTINT (XPROCESS (process)->pty_flag)))
1363#endif
1364 {
1365 XPROCESS (process)->subtty = Qnil;
1366 if (forkin >= 0)
1367 close (forkin);
1368 }
1369 alarm (0);
1370 start_polling ();
1371 if (forkin != forkout && forkout >= 0)
1372 close (forkout);
1373
1374#ifdef SIGCHLD
1375#ifdef BSD4_1
1376 sigrelse (SIGCHLD);
1377#else /* not BSD4_1 */
1378#if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1379 sigsetmask (SIGEMPTYMASK);
1380#else /* ordinary USG */
1381#if 0
1382 signal (SIGCHLD, sigchld);
1383 /* Now really handle any of these signals
1384 that came in during this function. */
1385 if (sigchld_deferred)
1386 kill (getpid (), SIGCHLD);
1387#endif
1388#endif /* ordinary USG */
1389#endif /* not BSD4_1 */
1390#endif /* SIGCHLD */
1391}
1392#endif /* not VMS */
1393
1394#ifdef HAVE_SOCKETS
1395
1396/* open a TCP network connection to a given HOST/SERVICE. Treated
1397 exactly like a normal process when reading and writing. Only
1398 differences are in status display and process deletion. A network
1399 connection has no PID; you cannot signal it. All you can do is
1400 deactivate and close it via delete-process */
1401
1402DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,
1403 4, 4, 0,
1404 "Open a TCP connection for a service to a host.\n\
1405Returns a subprocess-object to represent the connection.\n\
1406Input and output work as for subprocesses; `delete-process' closes it.\n\
1407Args are NAME BUFFER HOST SERVICE.\n\
1408NAME is name for process. It is modified if necessary to make it unique.\n\
1409BUFFER is the buffer (or buffer-name) to associate with the process.\n\
1410 Process output goes at end of that buffer, unless you specify\n\
1411 an output stream or filter function to handle the output.\n\
1412 BUFFER may be also nil, meaning that this process is not associated\n\
1413 with any buffer\n\
1414Third arg is name of the host to connect to, or its IP address.\n\
1415Fourth arg SERVICE is name of the service desired, or an integer\n\
1416 specifying a port number to connect to.")
1417 (name, buffer, host, service)
1418 Lisp_Object name, buffer, host, service;
1419{
1420 Lisp_Object proc;
1421 register int i;
1422 struct sockaddr_in address;
1423 struct servent *svc_info;
1424 struct hostent *host_info_ptr, host_info;
1425 char *(addr_list[2]);
1426 unsigned long numeric_addr;
1427 int s, outch, inch;
1428 char errstring[80];
1429 int port;
1430 struct hostent host_info_fixed;
1431 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1432
1433 GCPRO4 (name, buffer, host, service);
1434 CHECK_STRING (name, 0);
1435 CHECK_STRING (host, 0);
1436 if (XTYPE(service) == Lisp_Int)
1437 port = htons ((unsigned short) XINT (service));
1438 else
1439 {
1440 CHECK_STRING (service, 0);
1441 svc_info = getservbyname (XSTRING (service)->data, "tcp");
1442 if (svc_info == 0)
1443 error ("Unknown service \"%s\"", XSTRING (service)->data);
1444 port = svc_info->s_port;
1445 }
1446
1447 host_info_ptr = gethostbyname (XSTRING (host)->data);
1448 if (host_info_ptr == 0)
1449 /* Attempt to interpret host as numeric inet address */
1450 {
1451 numeric_addr = inet_addr (XSTRING (host)->data);
1452 if (numeric_addr == -1)
1453 error ("Unknown host \"%s\"", XSTRING (host)->data);
1454
1455 host_info_ptr = &host_info;
1456 host_info.h_name = 0;
1457 host_info.h_aliases = 0;
1458 host_info.h_addrtype = AF_INET;
39a21be6
JB
1459#ifdef h_addr
1460 /* Older machines have only one address slot called h_addr.
1461 Newer machines have h_addr_list, but #define h_addr to
1462 be its first element. */
1463 host_info.h_addr_list = &(addr_list[0]);
1464#endif
1465 host_info.h_addr = (char*)(&numeric_addr);
d0d6b7c5
JB
1466 addr_list[1] = 0;
1467 host_info.h_length = strlen (addr_list[0]);
1468 }
1469
1470 bzero (&address, sizeof address);
1471 bcopy (host_info_ptr->h_addr, (char *) &address.sin_addr,
1472 host_info_ptr->h_length);
1473 address.sin_family = host_info_ptr->h_addrtype;
1474 address.sin_port = port;
1475
1476 s = socket (host_info_ptr->h_addrtype, SOCK_STREAM, 0);
1477 if (s < 0)
1478 report_file_error ("error creating socket", Fcons (name, Qnil));
1479
1480 loop:
63826237 1481 if (connect (s, (struct sockaddr *) &address, sizeof address) == -1)
d0d6b7c5
JB
1482 {
1483 int xerrno = errno;
1484 if (errno == EINTR)
1485 goto loop;
1486 close (s);
1487 errno = xerrno;
1488 report_file_error ("connection failed",
1489 Fcons (host, Fcons (name, Qnil)));
1490 }
1491
1492 inch = s;
1493 outch = dup (s);
1494 if (outch < 0)
1495 report_file_error ("error duplicating socket", Fcons (name, Qnil));
1496
1497 if (!NILP (buffer))
1498 buffer = Fget_buffer_create (buffer);
1499 proc = make_process (name);
1500
1501 chan_process[inch] = proc;
1502
1503#ifdef O_NONBLOCK
1504 fcntl (inch, F_SETFL, O_NONBLOCK);
1505#else
1506#ifdef O_NDELAY
1507 fcntl (inch, F_SETFL, O_NDELAY);
1508#endif
1509#endif
1510
1511 XPROCESS (proc)->childp = host;
1512 XPROCESS (proc)->command_channel_p = Qnil;
1513 XPROCESS (proc)->buffer = buffer;
1514 XPROCESS (proc)->sentinel = Qnil;
1515 XPROCESS (proc)->filter = Qnil;
1516 XPROCESS (proc)->command = Qnil;
1517 XPROCESS (proc)->pid = Qnil;
1518 XFASTINT (XPROCESS (proc)->infd) = s;
1519 XFASTINT (XPROCESS (proc)->outfd) = outch;
1520 XPROCESS (proc)->status = Qrun;
1521 FD_SET (inch, &input_wait_mask);
1522
1523 UNGCPRO;
1524 return proc;
1525}
1526#endif /* HAVE_SOCKETS */
1527
1528deactivate_process (proc)
1529 Lisp_Object proc;
1530{
1531 register int inchannel, outchannel;
1532 register struct Lisp_Process *p = XPROCESS (proc);
1533
1534 inchannel = XFASTINT (p->infd);
1535 outchannel = XFASTINT (p->outfd);
1536
1537 if (inchannel)
1538 {
1539 /* Beware SIGCHLD hereabouts. */
1540 flush_pending_output (inchannel);
1541#ifdef VMS
1542 {
1543 VMS_PROC_STUFF *get_vms_process_pointer (), *vs;
1544 sys$dassgn (outchannel);
c6c6865d 1545 vs = get_vms_process_pointer (p->pid);
d0d6b7c5
JB
1546 if (vs)
1547 give_back_vms_process_stuff (vs);
1548 }
1549#else
1550 close (inchannel);
1551 if (outchannel && outchannel != inchannel)
1552 close (outchannel);
1553#endif
1554
1555 XFASTINT (p->infd) = 0;
1556 XFASTINT (p->outfd) = 0;
1557 chan_process[inchannel] = Qnil;
1558 FD_CLR (inchannel, &input_wait_mask);
1559 }
1560}
1561
1562/* Close all descriptors currently in use for communication
1563 with subprocess. This is used in a newly-forked subprocess
1564 to get rid of irrelevant descriptors. */
1565
1566close_process_descs ()
1567{
1568 int i;
1569 for (i = 0; i < MAXDESC; i++)
1570 {
1571 Lisp_Object process;
1572 process = chan_process[i];
1573 if (!NILP (process))
1574 {
1575 int in = XFASTINT (XPROCESS (process)->infd);
1576 int out = XFASTINT (XPROCESS (process)->outfd);
1577 if (in)
1578 close (in);
1579 if (out && in != out)
1580 close (out);
1581 }
1582 }
1583}
1584\f
1585DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
1586 0, 3, 0,
1587 "Allow any pending output from subprocesses to be read by Emacs.\n\
1588It is read into the process' buffers or given to their filter functions.\n\
1589Non-nil arg PROCESS means do not return until some output has been received\n\
1590from PROCESS.\n\
1591Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\
1592seconds and microseconds to wait; return after that much time whether\n\
1593or not there is input.\n\
1594Return non-nil iff we received any output before the timeout expired.")
1595 (proc, timeout, timeout_msecs)
1596 register Lisp_Object proc, timeout, timeout_msecs;
1597{
1598 int seconds;
1599 int useconds;
1600
1601 if (! NILP (timeout_msecs))
1602 {
1603 CHECK_NUMBER (timeout_msecs, 2);
1604 useconds = XINT (timeout_msecs);
1605 if (XTYPE (timeout) != Lisp_Int)
1606 XSET (timeout, Lisp_Int, 0);
1607
1608 {
1609 int carry = useconds / 1000000;
1610
1611 XSETINT (timeout, XINT (timeout) + carry);
1612 useconds -= carry * 1000000;
1613
1614 /* I think this clause is necessary because C doesn't
1615 guarantee a particular rounding direction for negative
1616 integers. */
1617 if (useconds < 0)
1618 {
1619 XSETINT (timeout, XINT (timeout) - 1);
1620 useconds += 1000000;
1621 }
1622 }
1623 }
de946e5a
RS
1624 else
1625 useconds = 0;
d0d6b7c5
JB
1626
1627 if (! NILP (timeout))
1628 {
1629 CHECK_NUMBER (timeout, 1);
1630 seconds = XINT (timeout);
1631 if (seconds <= 0)
1632 seconds = -1;
1633 }
1634 else
1635 {
1636 if (NILP (proc))
1637 seconds = -1;
1638 else
1639 seconds = 0;
1640 }
1641
f76475ad
JB
1642 if (NILP (proc))
1643 XFASTINT (proc) = 0;
1644
d0d6b7c5 1645 return
f76475ad 1646 (wait_reading_process_input (seconds, useconds, proc, 0)
d0d6b7c5
JB
1647 ? Qt : Qnil);
1648}
1649
1650/* This variable is different from waiting_for_input in keyboard.c.
1651 It is used to communicate to a lisp process-filter/sentinel (via the
1652 function Fwaiting_for_user_input_p below) whether emacs was waiting
1653 for user-input when that process-filter was called.
1654 waiting_for_input cannot be used as that is by definition 0 when
1655 lisp code is being evalled */
1656static int waiting_for_user_input_p;
1657
1658/* Read and dispose of subprocess output while waiting for timeout to
1659 elapse and/or keyboard input to be available.
1660
de6fd4b9 1661 TIME_LIMIT is:
d0d6b7c5
JB
1662 timeout in seconds, or
1663 zero for no limit, or
1664 -1 means gobble data immediately available but don't wait for any.
1665
de6fd4b9
RS
1666 MICROSECS is:
1667 an additional duration to wait, measured in microseconds.
1668 If this is nonzero and time_limit is 0, then the timeout
1669 consists of MICROSECS only.
6e4f3667 1670
de6fd4b9 1671 READ_KBD is a lisp value:
d0d6b7c5
JB
1672 0 to ignore keyboard input, or
1673 1 to return when input is available, or
84aa3ace 1674 -1 meaning caller will actually read the input, so don't throw to
d0d6b7c5 1675 the quit handler, or
de6fd4b9
RS
1676 a cons cell, meaning wait wait until its car is non-nil
1677 (and gobble terminal input into the buffer if any arrives), or
f76475ad
JB
1678 a process object, meaning wait until something arrives from that
1679 process. The return value is true iff we read some input from
1680 that process.
d0d6b7c5 1681
de6fd4b9 1682 DO_DISPLAY != 0 means redisplay should be done to show subprocess
d0d6b7c5
JB
1683 output that arrives.
1684
de6fd4b9 1685 If READ_KBD is a pointer to a struct Lisp_Process, then the
d0d6b7c5
JB
1686 function returns true iff we received input from that process
1687 before the timeout elapsed.
eb8c3be9 1688 Otherwise, return true iff we received input from any process. */
d0d6b7c5
JB
1689
1690wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
f76475ad
JB
1691 int time_limit, microsecs;
1692 Lisp_Object read_kbd;
1693 int do_display;
d0d6b7c5
JB
1694{
1695 register int channel, nfds, m;
1696 static SELECT_TYPE Available;
1697 int xerrno;
1698 Lisp_Object proc;
1699 EMACS_TIME timeout, end_time, garbage;
1700 SELECT_TYPE Atemp;
1701 int wait_channel = 0;
1702 struct Lisp_Process *wait_proc = 0;
1703 int got_some_input = 0;
84aa3ace 1704 Lisp_Object *wait_for_cell = 0;
d0d6b7c5
JB
1705
1706 FD_ZERO (&Available);
1707
f76475ad
JB
1708 /* If read_kbd is a process to watch, set wait_proc and wait_channel
1709 accordingly. */
1710 if (XTYPE (read_kbd) == Lisp_Process)
d0d6b7c5 1711 {
f76475ad 1712 wait_proc = XPROCESS (read_kbd);
d0d6b7c5 1713 wait_channel = XFASTINT (wait_proc->infd);
f76475ad 1714 XFASTINT (read_kbd) = 0;
d0d6b7c5
JB
1715 }
1716
84aa3ace
RS
1717 /* If waiting for non-nil in a cell, record where. */
1718 if (XTYPE (read_kbd) == Lisp_Cons)
1719 {
1720 wait_for_cell = &XCONS (read_kbd)->car;
1721 XFASTINT (read_kbd) = 0;
1722 }
1723
f76475ad 1724 waiting_for_user_input_p = XINT (read_kbd);
d0d6b7c5
JB
1725
1726 /* Since we may need to wait several times,
1727 compute the absolute time to return at. */
1728 if (time_limit || microsecs)
1729 {
1730 EMACS_GET_TIME (end_time);
1731 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
1732 EMACS_ADD_TIME (end_time, end_time, timeout);
1733 }
1734
d0d6b7c5
JB
1735 while (1)
1736 {
1737 /* If calling from keyboard input, do not quit
1738 since we want to return C-g as an input character.
1739 Otherwise, do pending quit if requested. */
f76475ad 1740 if (XINT (read_kbd) >= 0)
d0d6b7c5
JB
1741 QUIT;
1742
d0d6b7c5
JB
1743 /* Compute time from now till when time limit is up */
1744 /* Exit if already run out */
1745 if (time_limit == -1)
1746 {
1747 /* -1 specified for timeout means
1748 gobble output available now
1749 but don't wait at all. */
1750
1751 EMACS_SET_SECS_USECS (timeout, 0, 0);
1752 }
1753 else if (time_limit || microsecs)
1754 {
1755 EMACS_GET_TIME (timeout);
1756 EMACS_SUB_TIME (timeout, end_time, timeout);
1757 if (EMACS_TIME_NEG_P (timeout))
1758 break;
1759 }
1760 else
1761 {
1762 EMACS_SET_SECS_USECS (timeout, 100000, 0);
1763 }
1764
90ab1a81
JB
1765 /* Cause C-g and alarm signals to take immediate action,
1766 and cause input available signals to zero out timeout.
1767
1768 It is important that we do this before checking for process
1769 activity. If we get a SIGCHLD after the explicit checks for
1770 process activity, timeout is the only way we will know. */
1771 if (XINT (read_kbd) < 0)
1772 set_waiting_for_input (&timeout);
1773
6be429b1
JB
1774 /* If status of something has changed, and no input is
1775 available, notify the user of the change right away. After
1776 this explicit check, we'll let the SIGCHLD handler zap
1777 timeout to get our attention. */
1778 if (update_tick != process_tick && do_display)
1779 {
1780 Atemp = input_wait_mask;
1781 EMACS_SET_SECS_USECS (timeout, 0, 0);
1782 if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0)
90ab1a81
JB
1783 {
1784 /* It's okay for us to do this and then continue with
1785 the loop, since timeout has already been zeroed out. */
1786 clear_waiting_for_input ();
1787 status_notify ();
1788 }
6be429b1
JB
1789 }
1790
1791 /* Don't wait for output from a non-running process. */
1792 if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
1793 update_status (wait_proc);
1794 if (wait_proc != 0
1795 && ! EQ (wait_proc->status, Qrun))
9aa2a7f4
JB
1796 {
1797 clear_waiting_for_input ();
1798 break;
1799 }
6be429b1 1800
d0d6b7c5
JB
1801 /* Wait till there is something to do */
1802
1803 Available = input_wait_mask;
de6fd4b9 1804 if (! XINT (read_kbd) && wait_for_cell == 0)
d0d6b7c5
JB
1805 FD_CLR (0, &Available);
1806
ff11dfa1 1807 /* If frame size has changed or the window is newly mapped,
ffd56f97
JB
1808 redisplay now, before we start to wait. There is a race
1809 condition here; if a SIGIO arrives between now and the select
016899c0
JB
1810 and indicates that a frame is trashed, the select may block
1811 displaying a trashed screen. */
ff11dfa1 1812 if (frame_garbaged)
ffd56f97
JB
1813 redisplay_preserve_echo_area ();
1814
f76475ad 1815 if (XINT (read_kbd) && detect_input_pending ())
d0d6b7c5
JB
1816 nfds = 0;
1817 else
d0d6b7c5 1818 nfds = select (MAXDESC, &Available, 0, 0, &timeout);
6720a7fb 1819
d0d6b7c5
JB
1820 xerrno = errno;
1821
1822 /* Make C-g and alarm signals set flags again */
1823 clear_waiting_for_input ();
1824
1825 /* If we woke up due to SIGWINCH, actually change size now. */
1826 do_pending_window_change ();
1827
ffd56f97 1828 if (time_limit && nfds == 0) /* timeout elapsed */
d0d6b7c5
JB
1829 break;
1830 if (nfds < 0)
1831 {
1832 if (xerrno == EINTR)
1833 FD_ZERO (&Available);
b0310da4
JB
1834#ifdef ultrix
1835 /* Ultrix select seems to return ENOMEM when it is
1836 interrupted. Treat it just like EINTR. Bleah. Note
1837 that we want to test for the "ultrix" CPP symbol, not
1838 "__ultrix__"; the latter is only defined under GCC, but
1839 not by DEC's bundled CC. -JimB */
8058415c
JB
1840 else if (xerrno == ENOMEM)
1841 FD_ZERO (&Available);
1842#endif
d0d6b7c5
JB
1843#ifdef ALLIANT
1844 /* This happens for no known reason on ALLIANT.
1845 I am guessing that this is the right response. -- RMS. */
1846 else if (xerrno == EFAULT)
1847 FD_ZERO (&Available);
1848#endif
1849 else if (xerrno == EBADF)
1850 {
1851#ifdef AIX
1852 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
1853 the child's closure of the pts gives the parent a SIGHUP, and
1854 the ptc file descriptor is automatically closed,
1855 yielding EBADF here or at select() call above.
1856 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
1857 in m-ibmrt-aix.h), and here we just ignore the select error.
1858 Cleanup occurs c/o status_notify after SIGCLD. */
ffd56f97 1859 FD_ZERO (&Available); /* Cannot depend on values returned */
d0d6b7c5
JB
1860#else
1861 abort ();
1862#endif
1863 }
1864 else
1865 error("select error: %s", sys_errlist[xerrno]);
1866 }
26ec91de 1867#if defined(sun) && !defined(USG5_4)
d0d6b7c5 1868 else if (nfds > 0 && FD_ISSET (0, &Available) && interrupt_input)
e0109153
JB
1869 /* System sometimes fails to deliver SIGIO.
1870
1871 David J. Mackenzie says that Emacs doesn't compile under
1872 Solaris if this code is enabled, thus the USG5_4 in the CPP
1873 conditional. "I haven't noticed any ill effects so far.
1874 If you find a Solaris expert somewhere, they might know
1875 better." */
d0d6b7c5
JB
1876 kill (getpid (), SIGIO);
1877#endif
1878
1879 /* Check for keyboard input */
1880 /* If there is any, return immediately
1881 to give it higher priority than subprocesses */
1882
f76475ad 1883 if (XINT (read_kbd) && detect_input_pending ())
6e103bac
RS
1884 {
1885 swallow_events ();
1886 if (detect_input_pending ())
1887 break;
1888 }
d0d6b7c5 1889
84aa3ace
RS
1890 /* Exit now if the cell we're waiting for became non-nil. */
1891 if (wait_for_cell && ! NILP (*wait_for_cell))
1892 break;
1893
4746118a 1894#ifdef SIGIO
d0d6b7c5
JB
1895 /* If we think we have keyboard input waiting, but didn't get SIGIO
1896 go read it. This can happen with X on BSD after logging out.
1897 In that case, there really is no input and no SIGIO,
1898 but select says there is input. */
1899
f76475ad 1900 if (XINT (read_kbd) && interrupt_input && (FD_ISSET (fileno (stdin), &Available)))
d0d6b7c5 1901 kill (0, SIGIO);
4746118a 1902#endif
d0d6b7c5 1903
d0d6b7c5
JB
1904 if (! wait_proc)
1905 got_some_input |= nfds > 0;
1906
32676c08
JB
1907 /* If checking input just got us a size-change event from X,
1908 obey it now if we should. */
f76475ad 1909 if (XINT (read_kbd))
32676c08
JB
1910 do_pending_window_change ();
1911
d0d6b7c5
JB
1912 /* Check for data from a process or a command channel */
1913 for (channel = FIRST_PROC_DESC; channel < MAXDESC; channel++)
1914 {
1915 if (FD_ISSET (channel, &Available))
1916 {
1917 int nread;
1918
1919 /* If waiting for this channel, arrange to return as
1920 soon as no more input to be processed. No more
1921 waiting. */
1922 if (wait_channel == channel)
1923 {
1924 wait_channel = 0;
1925 time_limit = -1;
1926 got_some_input = 1;
1927 }
1928 proc = chan_process[channel];
1929 if (NILP (proc))
1930 continue;
1931
d0d6b7c5
JB
1932 /* Read data from the process, starting with our
1933 buffered-ahead character if we have one. */
1934
1935 nread = read_process_output (proc, channel);
1936 if (nread > 0)
1937 {
1938 /* Since read_process_output can run a filter,
1939 which can call accept-process-output,
1940 don't try to read from any other processes
1941 before doing the select again. */
1942 FD_ZERO (&Available);
1943
1944 if (do_display)
1945 redisplay_preserve_echo_area ();
1946 }
1947#ifdef EWOULDBLOCK
1948 else if (nread == -1 && errno == EWOULDBLOCK)
1949 ;
1950#else
1951#ifdef O_NONBLOCK
1952 else if (nread == -1 && errno == EAGAIN)
1953 ;
1954#else
1955#ifdef O_NDELAY
1956 else if (nread == -1 && errno == EAGAIN)
1957 ;
1958 /* Note that we cannot distinguish between no input
1959 available now and a closed pipe.
1960 With luck, a closed pipe will be accompanied by
1961 subprocess termination and SIGCHLD. */
1962 else if (nread == 0 && !NETCONN_P (proc))
1963 ;
ffd56f97
JB
1964#endif /* O_NDELAY */
1965#endif /* O_NONBLOCK */
1966#endif /* EWOULDBLOCK */
d0d6b7c5
JB
1967#ifdef HAVE_PTYS
1968 /* On some OSs with ptys, when the process on one end of
1969 a pty exits, the other end gets an error reading with
1970 errno = EIO instead of getting an EOF (0 bytes read).
1971 Therefore, if we get an error reading and errno =
1972 EIO, just continue, because the child process has
1973 exited and should clean itself up soon (e.g. when we
1974 get a SIGCHLD). */
1975 else if (nread == -1 && errno == EIO)
1976 ;
ffd56f97
JB
1977#endif /* HAVE_PTYS */
1978 /* If we can detect process termination, don't consider the process
1979 gone just because its pipe is closed. */
d0d6b7c5
JB
1980#ifdef SIGCHLD
1981 else if (nread == 0 && !NETCONN_P (proc))
1982 ;
1983#endif
1984 else
1985 {
1986 /* Preserve status of processes already terminated. */
1987 XSETINT (XPROCESS (proc)->tick, ++process_tick);
1988 deactivate_process (proc);
1989 if (!NILP (XPROCESS (proc)->raw_status_low))
1990 update_status (XPROCESS (proc));
1991 if (EQ (XPROCESS (proc)->status, Qrun))
1992 XPROCESS (proc)->status
1993 = Fcons (Qexit, Fcons (make_number (256), Qnil));
1994 }
1995 }
ffd56f97
JB
1996 } /* end for each file descriptor */
1997 } /* end while exit conditions not met */
d0d6b7c5 1998
ffd56f97
JB
1999 /* If calling from keyboard input, do not quit
2000 since we want to return C-g as an input character.
2001 Otherwise, do pending quit if requested. */
f76475ad 2002 if (XINT (read_kbd) >= 0)
ffd56f97
JB
2003 {
2004 /* Prevent input_pending from remaining set if we quit. */
2005 clear_input_pending ();
2006 QUIT;
2007 }
d0d6b7c5
JB
2008
2009 return got_some_input;
2010}
2011\f
2012/* Read pending output from the process channel,
2013 starting with our buffered-ahead character if we have one.
2014 Yield number of characters read.
2015
2016 This function reads at most 1024 characters.
2017 If you want to read all available subprocess output,
2018 you must call it repeatedly until it returns zero. */
2019
2020read_process_output (proc, channel)
2021 Lisp_Object proc;
2022 register int channel;
2023{
2024 register int nchars;
2025#ifdef VMS
2026 char *chars;
2027#else
2028 char chars[1024];
2029#endif
2030 register Lisp_Object outstream;
2031 register struct buffer *old = current_buffer;
2032 register struct Lisp_Process *p = XPROCESS (proc);
2033 register int opoint;
2034
2035#ifdef VMS
2036 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
2037
2038 vs = get_vms_process_pointer (p->pid);
2039 if (vs)
2040 {
2041 if (!vs->iosb[0])
2042 return(0); /* Really weird if it does this */
2043 if (!(vs->iosb[0] & 1))
2044 return -1; /* I/O error */
2045 }
2046 else
2047 error ("Could not get VMS process pointer");
2048 chars = vs->inputBuffer;
2049 nchars = clean_vms_buffer (chars, vs->iosb[1]);
2050 if (nchars <= 0)
2051 {
2052 start_vms_process_read (vs); /* Crank up the next read on the process */
2053 return 1; /* Nothing worth printing, say we got 1 */
2054 }
2055#else /* not VMS */
2056
2057 if (proc_buffered_char[channel] < 0)
2058 nchars = read (channel, chars, sizeof chars);
2059 else
2060 {
2061 chars[0] = proc_buffered_char[channel];
2062 proc_buffered_char[channel] = -1;
2063 nchars = read (channel, chars + 1, sizeof chars - 1);
2064 if (nchars < 0)
2065 nchars = 1;
2066 else
2067 nchars = nchars + 1;
2068 }
2069#endif /* not VMS */
2070
2071 if (nchars <= 0) return nchars;
2072
2073 outstream = p->filter;
2074 if (!NILP (outstream))
2075 {
2076 /* We inhibit quit here instead of just catching it so that
2077 hitting ^G when a filter happens to be running won't screw
2078 it up. */
2079 int count = specpdl_ptr - specpdl;
30c78175
RS
2080 Lisp_Object odeactivate;
2081
2082 odeactivate = Vdeactivate_mark;
2083
d0d6b7c5
JB
2084 specbind (Qinhibit_quit, Qt);
2085 call2 (outstream, proc, make_string (chars, nchars));
2086
592ce97f 2087 /* Handling the process output should not deactivate the mark. */
30c78175
RS
2088 Vdeactivate_mark = odeactivate;
2089
d0d6b7c5
JB
2090#ifdef VMS
2091 start_vms_process_read (vs);
2092#endif
2093 unbind_to (count);
2094 return nchars;
2095 }
2096
2097 /* If no filter, write into buffer if it isn't dead. */
2098 if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
2099 {
b0310da4
JB
2100 Lisp_Object old_read_only;
2101 Lisp_Object old_begv, old_zv;
30c78175
RS
2102 Lisp_Object odeactivate;
2103
2104 odeactivate = Vdeactivate_mark;
d0d6b7c5
JB
2105
2106 Fset_buffer (p->buffer);
2107 opoint = point;
b0310da4
JB
2108 old_read_only = current_buffer->read_only;
2109 XFASTINT (old_begv) = BEGV;
2110 XFASTINT (old_zv) = ZV;
2111
2112 current_buffer->read_only = Qnil;
d0d6b7c5
JB
2113
2114 /* Insert new output into buffer
2115 at the current end-of-output marker,
2116 thus preserving logical ordering of input and output. */
2117 if (XMARKER (p->mark)->buffer)
2118 SET_PT (marker_position (p->mark));
2119 else
2120 SET_PT (ZV);
b0310da4
JB
2121
2122 /* If the output marker is outside of the visible region, save
2123 the restriction and widen. */
2124 if (! (BEGV <= point && point <= ZV))
2125 Fwiden ();
2126
2127 /* Make sure opoint floats ahead of any new text, just as point
2128 would. */
d0d6b7c5
JB
2129 if (point <= opoint)
2130 opoint += nchars;
2131
b0310da4
JB
2132 /* Insert after old_begv, but before old_zv. */
2133 if (point < XFASTINT (old_begv))
2134 XFASTINT (old_begv) += nchars;
2135 if (point <= XFASTINT (old_zv))
2136 XFASTINT (old_zv) += nchars;
2137
d0d6b7c5
JB
2138 /* Insert before markers in case we are inserting where
2139 the buffer's mark is, and the user's next command is Meta-y. */
2140 insert_before_markers (chars, nchars);
d0d6b7c5 2141 Fset_marker (p->mark, make_number (point), p->buffer);
b0310da4 2142
d0d6b7c5
JB
2143 update_mode_lines++;
2144
b0310da4
JB
2145 /* If the restriction isn't what it should be, set it. */
2146 if (XFASTINT (old_begv) != BEGV || XFASTINT (old_zv) != ZV)
2147 Fnarrow_to_region (old_begv, old_zv);
2148
592ce97f 2149 /* Handling the process output should not deactivate the mark. */
30c78175
RS
2150 Vdeactivate_mark = odeactivate;
2151
b0310da4 2152 current_buffer->read_only = old_read_only;
d0d6b7c5
JB
2153 SET_PT (opoint);
2154 set_buffer_internal (old);
2155 }
2156#ifdef VMS
2157 start_vms_process_read (vs);
2158#endif
2159 return nchars;
2160}
2161
2162DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
2163 0, 0, 0,
2164 "Returns non-NIL if emacs is waiting for input from the user.\n\
2165This is intended for use by asynchronous process output filters and sentinels.")
2166 ()
2167{
2168 return ((waiting_for_user_input_p) ? Qt : Qnil);
2169}
2170\f
2171/* Sending data to subprocess */
2172
2173jmp_buf send_process_frame;
2174
2175SIGTYPE
2176send_process_trap ()
2177{
2178#ifdef BSD4_1
2179 sigrelse (SIGPIPE);
2180 sigrelse (SIGALRM);
2181#endif /* BSD4_1 */
2182 longjmp (send_process_frame, 1);
2183}
2184
2185send_process (proc, buf, len)
2186 Lisp_Object proc;
2187 char *buf;
2188 int len;
2189{
2190 /* Don't use register vars; longjmp can lose them. */
2191 int rv;
2192 unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
2193
2194
2195#ifdef VMS
2196 struct Lisp_Process *p = XPROCESS (proc);
2197 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
2198#endif /* VMS */
2199
2200 if (! NILP (XPROCESS (proc)->raw_status_low))
2201 update_status (XPROCESS (proc));
2202 if (! EQ (XPROCESS (proc)->status, Qrun))
2203 error ("Process %s not running", procname);
2204
2205#ifdef VMS
2206 vs = get_vms_process_pointer (p->pid);
2207 if (vs == 0)
2208 error ("Could not find this process: %x", p->pid);
2209 else if (write_to_vms_process (vs, buf, len))
2210 ;
2211#else
2212 if (!setjmp (send_process_frame))
2213 while (len > 0)
2214 {
2215 int this = len;
4746118a
JB
2216 SIGTYPE (*old_sigpipe)();
2217
d0d6b7c5
JB
2218 /* Don't send more than 500 bytes at a time. */
2219 if (this > 500)
2220 this = 500;
508b171c 2221 old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
d0d6b7c5 2222 rv = write (XFASTINT (XPROCESS (proc)->outfd), buf, this);
4746118a 2223 signal (SIGPIPE, old_sigpipe);
d0d6b7c5
JB
2224 if (rv < 0)
2225 {
2226 if (0
2227#ifdef EWOULDBLOCK
2228 || errno == EWOULDBLOCK
2229#endif
2230#ifdef EAGAIN
2231 || errno == EAGAIN
2232#endif
2233 )
2234 {
2235 /* It would be nice to accept process output here,
2236 but that is difficult. For example, it could
2237 garbage what we are sending if that is from a buffer. */
2238 immediate_quit = 1;
2239 QUIT;
2240 sleep (1);
2241 immediate_quit = 0;
2242 continue;
2243 }
2244 report_file_error ("writing to process", Fcons (proc, Qnil));
2245 }
2246 buf += rv;
2247 len -= rv;
2248 /* Allow input from processes between bursts of sending.
2249 Otherwise things may get stopped up. */
2250 if (len > 0)
f76475ad
JB
2251 {
2252 Lisp_Object zero;
2253
2254 XFASTINT (zero) = 0;
2255 wait_reading_process_input (-1, 0, zero, 0);
2256 }
d0d6b7c5
JB
2257 }
2258#endif
2259 else
2260 {
2261 XPROCESS (proc)->raw_status_low = Qnil;
2262 XPROCESS (proc)->raw_status_high = Qnil;
2263 XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
2264 XSETINT (XPROCESS (proc)->tick, ++process_tick);
2265 deactivate_process (proc);
2266#ifdef VMS
2267 error ("Error writing to process %s; closed it", procname);
2268#else
2269 error ("SIGPIPE raised on process %s; closed it", procname);
2270#endif
2271 }
2272}
2273
2274DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
2275 3, 3, 0,
2276 "Send current contents of region as input to PROCESS.\n\
ebb9e16f
JB
2277PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2278nil, indicating the current buffer's process.\n\
d0d6b7c5
JB
2279Called from program, takes three arguments, PROCESS, START and END.\n\
2280If the region is more than 500 characters long,\n\
2281it is sent in several bunches. This may happen even for shorter regions.\n\
2282Output from processes can arrive in between bunches.")
2283 (process, start, end)
2284 Lisp_Object process, start, end;
2285{
2286 Lisp_Object proc;
2287 int start1;
2288
2289 proc = get_process (process);
2290 validate_region (&start, &end);
2291
2292 if (XINT (start) < GPT && XINT (end) > GPT)
2293 move_gap (start);
2294
2295 start1 = XINT (start);
2296 send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start));
2297
2298 return Qnil;
2299}
2300
2301DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
2302 2, 2, 0,
2303 "Send PROCESS the contents of STRING as input.\n\
ebb9e16f
JB
2304PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2305nil, indicating the current buffer's process.\n\
d0d6b7c5
JB
2306If STRING is more than 500 characters long,\n\
2307it is sent in several bunches. This may happen even for shorter strings.\n\
2308Output from processes can arrive in between bunches.")
2309 (process, string)
2310 Lisp_Object process, string;
2311{
2312 Lisp_Object proc;
2313 CHECK_STRING (string, 1);
2314 proc = get_process (process);
2315 send_process (proc, XSTRING (string)->data, XSTRING (string)->size);
2316 return Qnil;
2317}
2318\f
2319/* send a signal number SIGNO to PROCESS.
2320 CURRENT_GROUP means send to the process group that currently owns
2321 the terminal being used to communicate with PROCESS.
2322 This is used for various commands in shell mode.
2323 If NOMSG is zero, insert signal-announcements into process's buffers
b0310da4
JB
2324 right away.
2325
2326 If we can, we try to signal PROCESS by sending control characters
2327 down the pipe. This allows us to signal inferiors who have changed
2328 their uid, for which killpg would return an EPERM error. */
d0d6b7c5 2329
f9738840 2330static void
d0d6b7c5
JB
2331process_send_signal (process, signo, current_group, nomsg)
2332 Lisp_Object process;
2333 int signo;
2334 Lisp_Object current_group;
2335 int nomsg;
2336{
2337 Lisp_Object proc;
2338 register struct Lisp_Process *p;
2339 int gid;
2340 int no_pgrp = 0;
2341
2342 proc = get_process (process);
2343 p = XPROCESS (proc);
2344
2345 if (!EQ (p->childp, Qt))
2346 error ("Process %s is not a subprocess",
2347 XSTRING (p->name)->data);
2348 if (!XFASTINT (p->infd))
2349 error ("Process %s is not active",
2350 XSTRING (p->name)->data);
2351
2352 if (NILP (p->pty_flag))
2353 current_group = Qnil;
2354
d0d6b7c5
JB
2355 /* If we are using pgrps, get a pgrp number and make it negative. */
2356 if (!NILP (current_group))
2357 {
b0310da4 2358#ifdef SIGNALS_VIA_CHARACTERS
d0d6b7c5
JB
2359 /* If possible, send signals to the entire pgrp
2360 by sending an input character to it. */
b0310da4 2361
6be429b1
JB
2362 /* TERMIOS is the latest and bestest, and seems most likely to
2363 work. If the system has it, use it. */
2364#ifdef HAVE_TERMIOS
2365 struct termios t;
2366
2367 switch (signo)
2368 {
2369 case SIGINT:
2370 tcgetattr (XFASTINT (p->infd), &t);
2371 send_process (proc, &t.c_cc[VINTR], 1);
a87b802f 2372 return;
6be429b1
JB
2373
2374 case SIGQUIT:
2375 tcgetattr (XFASTINT (p->infd), &t);
2376 send_process (proc, &t.c_cc[VQUIT], 1);
a87b802f 2377 return;
6be429b1
JB
2378
2379 case SIGTSTP:
2380 tcgetattr (XFASTINT (p->infd), &t);
2381#ifdef VSWTCH
2382 send_process (proc, &t.c_cc[VSWTCH], 1);
2383#else
2384 send_process (proc, &t.c_cc[VSUSP], 1);
2385#endif
a87b802f 2386 return;
6be429b1
JB
2387 }
2388
2389#else /* ! HAVE_TERMIOS */
2390
b0310da4
JB
2391 /* On Berkeley descendants, the following IOCTL's retrieve the
2392 current control characters. */
d0d6b7c5 2393#if defined (TIOCGLTC) && defined (TIOCGETC)
b0310da4 2394
d0d6b7c5
JB
2395 struct tchars c;
2396 struct ltchars lc;
2397
2398 switch (signo)
2399 {
2400 case SIGINT:
2401 ioctl (XFASTINT (p->infd), TIOCGETC, &c);
2402 send_process (proc, &c.t_intrc, 1);
f9738840 2403 return;
d0d6b7c5
JB
2404 case SIGQUIT:
2405 ioctl (XFASTINT (p->infd), TIOCGETC, &c);
2406 send_process (proc, &c.t_quitc, 1);
f9738840 2407 return;
0ad77c54 2408#ifdef SIGTSTP
d0d6b7c5
JB
2409 case SIGTSTP:
2410 ioctl (XFASTINT (p->infd), TIOCGLTC, &lc);
2411 send_process (proc, &lc.t_suspc, 1);
f9738840 2412 return;
b0310da4 2413#endif /* ! defined (SIGTSTP) */
d0d6b7c5 2414 }
b0310da4
JB
2415
2416#else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
2417
2418 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
2419 characters. */
2420#ifdef TCGETA
d0d6b7c5
JB
2421 struct termio t;
2422 switch (signo)
2423 {
2424 case SIGINT:
2425 ioctl (XFASTINT (p->infd), TCGETA, &t);
2426 send_process (proc, &t.c_cc[VINTR], 1);
f9738840 2427 return;
d0d6b7c5
JB
2428 case SIGQUIT:
2429 ioctl (XFASTINT (p->infd), TCGETA, &t);
2430 send_process (proc, &t.c_cc[VQUIT], 1);
f9738840 2431 return;
7d79e3b4 2432#ifdef SIGTSTP
d0d6b7c5
JB
2433 case SIGTSTP:
2434 ioctl (XFASTINT (p->infd), TCGETA, &t);
2435 send_process (proc, &t.c_cc[VSWTCH], 1);
f9738840 2436 return;
b0310da4 2437#endif /* ! defined (SIGTSTP) */
d0d6b7c5 2438 }
b0310da4
JB
2439#else /* ! defined (TCGETA) */
2440 Your configuration files are messed up.
2441 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
2442 you'd better be using one of the alternatives above! */
2443#endif /* ! defined (TCGETA) */
2444#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
6be429b1 2445#endif /* ! defined HAVE_TERMIOS */
b0310da4 2446#endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
d0d6b7c5 2447
301c3fe4 2448#ifdef TIOCGPGRP
d0d6b7c5
JB
2449 /* Get the pgrp using the tty itself, if we have that.
2450 Otherwise, use the pty to get the pgrp.
2451 On pfa systems, saka@pfu.fujitsu.co.JP writes:
b0310da4
JB
2452 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
2453 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
d0d6b7c5
JB
2454 His patch indicates that if TIOCGPGRP returns an error, then
2455 we should just assume that p->pid is also the process group id. */
2456 {
2457 int err;
2458
2459 if (!NILP (p->subtty))
2460 err = ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
2461 else
2462 err = ioctl (XFASTINT (p->infd), TIOCGPGRP, &gid);
2463
2464#ifdef pfa
2465 if (err == -1)
2466 gid = - XFASTINT (p->pid);
301c3fe4 2467#endif /* ! defined (pfa) */
d0d6b7c5
JB
2468 }
2469 if (gid == -1)
2470 no_pgrp = 1;
2471 else
2472 gid = - gid;
b0310da4 2473#else /* ! defined (TIOCGPGRP ) */
301c3fe4
JB
2474 /* Can't select pgrps on this system, so we know that
2475 the child itself heads the pgrp. */
2476 gid = - XFASTINT (p->pid);
2477#endif /* ! defined (TIOCGPGRP ) */
d0d6b7c5
JB
2478 }
2479 else
2480 gid = - XFASTINT (p->pid);
d0d6b7c5
JB
2481
2482 switch (signo)
2483 {
2484#ifdef SIGCONT
2485 case SIGCONT:
2486 p->raw_status_low = Qnil;
2487 p->raw_status_high = Qnil;
2488 p->status = Qrun;
2489 XSETINT (p->tick, ++process_tick);
2490 if (!nomsg)
2491 status_notify ();
2492 break;
301c3fe4 2493#endif /* ! defined (SIGCONT) */
d0d6b7c5
JB
2494 case SIGINT:
2495#ifdef VMS
2496 send_process (proc, "\003", 1); /* ^C */
2497 goto whoosh;
2498#endif
2499 case SIGQUIT:
2500#ifdef VMS
2501 send_process (proc, "\031", 1); /* ^Y */
2502 goto whoosh;
2503#endif
2504 case SIGKILL:
2505#ifdef VMS
2506 sys$forcex (&(XFASTINT (p->pid)), 0, 1);
2507 whoosh:
2508#endif
2509 flush_pending_output (XFASTINT (p->infd));
2510 break;
2511 }
2512
2513 /* If we don't have process groups, send the signal to the immediate
2514 subprocess. That isn't really right, but it's better than any
2515 obvious alternative. */
2516 if (no_pgrp)
2517 {
2518 kill (XFASTINT (p->pid), signo);
2519 return;
2520 }
2521
2522 /* gid may be a pid, or minus a pgrp's number */
2523#ifdef TIOCSIGSEND
2524 if (!NILP (current_group))
2525 ioctl (XFASTINT (p->infd), TIOCSIGSEND, signo);
2526 else
2527 {
2528 gid = - XFASTINT (p->pid);
2529 kill (gid, signo);
2530 }
301c3fe4 2531#else /* ! defined (TIOCSIGSEND) */
d0d6b7c5 2532 EMACS_KILLPG (-gid, signo);
301c3fe4 2533#endif /* ! defined (TIOCSIGSEND) */
d0d6b7c5
JB
2534}
2535
2536DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
2537 "Interrupt process PROCESS. May be process or name of one.\n\
ebb9e16f 2538PROCESS may be a process, a buffer, or the name of a process or buffer.\n\
d0d6b7c5
JB
2539Nil or no arg means current buffer's process.\n\
2540Second arg CURRENT-GROUP non-nil means send signal to\n\
2541the current process-group of the process's controlling terminal\n\
2542rather than to the process's own process group.\n\
2543If the process is a shell, this means interrupt current subjob\n\
2544rather than the shell.")
2545 (process, current_group)
2546 Lisp_Object process, current_group;
2547{
2548 process_send_signal (process, SIGINT, current_group, 0);
2549 return process;
2550}
2551
2552DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
2553 "Kill process PROCESS. May be process or name of one.\n\
2554See function `interrupt-process' for more details on usage.")
2555 (process, current_group)
2556 Lisp_Object process, current_group;
2557{
2558 process_send_signal (process, SIGKILL, current_group, 0);
2559 return process;
2560}
2561
2562DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
2563 "Send QUIT signal to process PROCESS. May be process or name of one.\n\
2564See function `interrupt-process' for more details on usage.")
2565 (process, current_group)
2566 Lisp_Object process, current_group;
2567{
2568 process_send_signal (process, SIGQUIT, current_group, 0);
2569 return process;
2570}
2571
2572DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
2573 "Stop process PROCESS. May be process or name of one.\n\
2574See function `interrupt-process' for more details on usage.")
2575 (process, current_group)
2576 Lisp_Object process, current_group;
2577{
2578#ifndef SIGTSTP
2579 error ("no SIGTSTP support");
2580#else
2581 process_send_signal (process, SIGTSTP, current_group, 0);
2582#endif
2583 return process;
2584}
2585
2586DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
2587 "Continue process PROCESS. May be process or name of one.\n\
2588See function `interrupt-process' for more details on usage.")
2589 (process, current_group)
2590 Lisp_Object process, current_group;
2591{
2592#ifdef SIGCONT
2593 process_send_signal (process, SIGCONT, current_group, 0);
2594#else
2595 error ("no SIGCONT support");
2596#endif
2597 return process;
2598}
2599
2600DEFUN ("signal-process", Fsignal_process, Ssignal_process,
2601 2, 2, "nProcess number: \nnSignal code: ",
2602 "Send the process with number PID the signal with code CODE.\n\
2603Both PID and CODE are integers.")
2604 (pid, sig)
2605 Lisp_Object pid, sig;
2606{
2607 CHECK_NUMBER (pid, 0);
2608 CHECK_NUMBER (sig, 1);
2609 return make_number (kill (XINT (pid), XINT (sig)));
2610}
2611
2612DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
2613 "Make PROCESS see end-of-file in its input.\n\
2614Eof comes after any text already sent to it.\n\
ebb9e16f
JB
2615PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2616nil, indicating the current buffer's process.")
d0d6b7c5
JB
2617 (process)
2618 Lisp_Object process;
2619{
2620 Lisp_Object proc;
2621
2622 proc = get_process (process);
577d03d5
RS
2623
2624 /* Make sure the process is really alive. */
2625 if (! NILP (XPROCESS (proc)->raw_status_low))
2626 update_status (XPROCESS (proc));
2627 if (! EQ (XPROCESS (proc)->status, Qrun))
dcf970e6 2628 error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data);
577d03d5 2629
d0d6b7c5
JB
2630 /* Sending a zero-length record is supposed to mean eof
2631 when TIOCREMOTE is turned on. */
2632#ifdef DID_REMOTE
2633 {
2634 char buf[1];
2635 write (XFASTINT (XPROCESS (proc)->outfd), buf, 0);
2636 }
2637#else /* did not do TOICREMOTE */
2638#ifdef VMS
2639 send_process (proc, "\032", 1); /* ^z */
2640#else
2641 if (!NILP (XPROCESS (proc)->pty_flag))
2642 send_process (proc, "\004", 1);
2643 else
2644 {
2645 close (XPROCESS (proc)->outfd);
5437e9f9 2646 XFASTINT (XPROCESS (proc)->outfd) = open (NULL_DEVICE, O_WRONLY);
d0d6b7c5
JB
2647 }
2648#endif /* VMS */
2649#endif /* did not do TOICREMOTE */
2650 return process;
2651}
2652
2653/* Kill all processes associated with `buffer'.
2654 If `buffer' is nil, kill all processes */
2655
2656kill_buffer_processes (buffer)
2657 Lisp_Object buffer;
2658{
2659 Lisp_Object tail, proc;
2660
2661 for (tail = Vprocess_alist; XGCTYPE (tail) == Lisp_Cons;
2662 tail = XCONS (tail)->cdr)
2663 {
2664 proc = XCONS (XCONS (tail)->car)->cdr;
2665 if (XGCTYPE (proc) == Lisp_Process
2666 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
2667 {
2668 if (NETCONN_P (proc))
2669 deactivate_process (proc);
2670 else if (XFASTINT (XPROCESS (proc)->infd))
2671 process_send_signal (proc, SIGHUP, Qnil, 1);
2672 }
2673 }
2674}
2675\f
2676/* On receipt of a signal that a child status has changed,
2677 loop asking about children with changed statuses until
2678 the system says there are no more.
2679 All we do is change the status;
2680 we do not run sentinels or print notifications.
2681 That is saved for the next time keyboard input is done,
2682 in order to avoid timing errors. */
2683
2684/** WARNING: this can be called during garbage collection.
2685 Therefore, it must not be fooled by the presence of mark bits in
2686 Lisp objects. */
2687
2688/** USG WARNING: Although it is not obvious from the documentation
2689 in signal(2), on a USG system the SIGCLD handler MUST NOT call
2690 signal() before executing at least one wait(), otherwise the handler
2691 will be called again, resulting in an infinite loop. The relevant
2692 portion of the documentation reads "SIGCLD signals will be queued
2693 and the signal-catching function will be continually reentered until
2694 the queue is empty". Invoking signal() causes the kernel to reexamine
2695 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
2696
2697SIGTYPE
2698sigchld_handler (signo)
2699 int signo;
2700{
2701 int old_errno = errno;
2702 Lisp_Object proc;
2703 register struct Lisp_Process *p;
6be429b1 2704 extern EMACS_TIME *input_available_clear_time;
d0d6b7c5
JB
2705
2706#ifdef BSD4_1
2707 extern int sigheld;
2708 sigheld |= sigbit (SIGCHLD);
2709#endif
2710
2711 while (1)
2712 {
2713 register int pid;
2714 WAITTYPE w;
2715 Lisp_Object tail;
2716
2717#ifdef WNOHANG
2718#ifndef WUNTRACED
2719#define WUNTRACED 0
2720#endif /* no WUNTRACED */
2721 /* Keep trying to get a status until we get a definitive result. */
2722 do
2723 {
2724 errno = 0;
2725 pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
2726 }
2727 while (pid <= 0 && errno == EINTR);
2728
2729 if (pid <= 0)
2730 {
2731 /* A real failure. We have done all our job, so return. */
2732
2733 /* USG systems forget handlers when they are used;
2734 must reestablish each time */
2735#ifdef USG
2736 signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
2737#endif
2738#ifdef BSD4_1
2739 sigheld &= ~sigbit (SIGCHLD);
2740 sigrelse (SIGCHLD);
2741#endif
2742 errno = old_errno;
2743 return;
2744 }
2745#else
2746 pid = wait (&w);
2747#endif /* no WNOHANG */
2748
2749 /* Find the process that signaled us, and record its status. */
2750
2751 p = 0;
2752 for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
2753 {
2754 proc = XCONS (XCONS (tail)->car)->cdr;
2755 p = XPROCESS (proc);
2756 if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
2757 break;
2758 p = 0;
2759 }
2760
2761 /* Look for an asynchronous process whose pid hasn't been filled
2762 in yet. */
2763 if (p == 0)
2764 for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
2765 {
2766 proc = XCONS (XCONS (tail)->car)->cdr;
2767 p = XPROCESS (proc);
2768 if (XTYPE (p->pid) == Lisp_Int && XINT (p->pid) == -1)
2769 break;
2770 p = 0;
2771 }
2772
2773 /* Change the status of the process that was found. */
2774 if (p != 0)
2775 {
2776 union { int i; WAITTYPE wt; } u;
2777
2778 XSETINT (p->tick, ++process_tick);
2779 u.wt = w;
2780 XFASTINT (p->raw_status_low) = u.i & 0xffff;
2781 XFASTINT (p->raw_status_high) = u.i >> 16;
2782
2783 /* If process has terminated, stop waiting for its output. */
2784 if (WIFSIGNALED (w) || WIFEXITED (w))
f9738840
JB
2785 if (XFASTINT (p->infd))
2786 FD_CLR (XFASTINT (p->infd), &input_wait_mask);
6be429b1
JB
2787
2788 /* Tell wait_reading_process_input that it needs to wake up and
2789 look around. */
2790 if (input_available_clear_time)
2791 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
d0d6b7c5
JB
2792 }
2793
2794 /* There was no asynchronous process found for that id. Check
2795 if we have a synchronous process. */
2796 else
2797 {
2798 synch_process_alive = 0;
2799
2800 /* Report the status of the synchronous process. */
2801 if (WIFEXITED (w))
2802 synch_process_retcode = WRETCODE (w);
2803 else if (WIFSIGNALED (w))
b0310da4 2804#ifndef VMS
95e8068d 2805 synch_process_death = (char *) sys_siglist[WTERMSIG (w)];
b0310da4
JB
2806#else
2807 synch_process_death = sys_errlist[WTERMSIG (w)];
2808#endif
6be429b1
JB
2809
2810 /* Tell wait_reading_process_input that it needs to wake up and
2811 look around. */
2812 if (input_available_clear_time)
2813 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
d0d6b7c5
JB
2814 }
2815
2816 /* On some systems, we must return right away.
2817 If any more processes want to signal us, we will
2818 get another signal.
2819 Otherwise (on systems that have WNOHANG), loop around
2820 to use up all the processes that have something to tell us. */
2821#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG))
2822#ifdef USG
2823 signal (signo, sigchld_handler);
2824#endif
2825 errno = old_errno;
2826 return;
2827#endif /* USG, but not HPUX with WNOHANG */
2828 }
2829}
2830\f
2831
2832static Lisp_Object
2833exec_sentinel_unwind (data)
2834 Lisp_Object data;
2835{
2836 XPROCESS (XCONS (data)->car)->sentinel = XCONS (data)->cdr;
2837 return Qnil;
2838}
2839
2840static void
2841exec_sentinel (proc, reason)
2842 Lisp_Object proc, reason;
2843{
2844 Lisp_Object sentinel;
2845 register struct Lisp_Process *p = XPROCESS (proc);
2846 int count = specpdl_ptr - specpdl;
2847
2848 sentinel = p->sentinel;
2849 if (NILP (sentinel))
2850 return;
2851
2852 /* Zilch the sentinel while it's running, to avoid recursive invocations;
2853 assure that it gets restored no matter how the sentinel exits. */
2854 p->sentinel = Qnil;
2855 record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
2856 /* Inhibit quit so that random quits don't screw up a running filter. */
2857 specbind (Qinhibit_quit, Qt);
2858 call2 (sentinel, proc, reason);
2859 unbind_to (count);
2860}
2861
2862/* Report all recent events of a change in process status
2863 (either run the sentinel or output a message).
2864 This is done while Emacs is waiting for keyboard input. */
2865
2866status_notify ()
2867{
2868 register Lisp_Object proc, buffer;
2869 Lisp_Object tail = Qnil;
2870 Lisp_Object msg = Qnil;
2871 struct gcpro gcpro1, gcpro2;
2872
2873 /* We need to gcpro tail; if read_process_output calls a filter
2874 which deletes a process and removes the cons to which tail points
2875 from Vprocess_alist, and then causes a GC, tail is an unprotected
2876 reference. */
2877 GCPRO2 (tail, msg);
2878
2879 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
2880 {
2881 Lisp_Object symbol;
2882 register struct Lisp_Process *p;
2883
2884 proc = Fcdr (Fcar (tail));
2885 p = XPROCESS (proc);
2886
2887 if (XINT (p->tick) != XINT (p->update_tick))
2888 {
2889 XSETINT (p->update_tick, XINT (p->tick));
2890
2891 /* If process is still active, read any output that remains. */
2892 if (XFASTINT (p->infd))
2893 while (read_process_output (proc, XFASTINT (p->infd)) > 0);
2894
2895 buffer = p->buffer;
2896
2897 /* Get the text to use for the message. */
2898 if (!NILP (p->raw_status_low))
2899 update_status (p);
2900 msg = status_message (p->status);
2901
2902 /* If process is terminated, deactivate it or delete it. */
2903 symbol = p->status;
2904 if (XTYPE (p->status) == Lisp_Cons)
2905 symbol = XCONS (p->status)->car;
2906
2907 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
2908 || EQ (symbol, Qclosed))
2909 {
2910 if (delete_exited_processes)
2911 remove_process (proc);
2912 else
2913 deactivate_process (proc);
2914 }
2915
2916 /* Now output the message suitably. */
2917 if (!NILP (p->sentinel))
2918 exec_sentinel (proc, msg);
2919 /* Don't bother with a message in the buffer
2920 when a process becomes runnable. */
2921 else if (!EQ (symbol, Qrun) && !NILP (buffer))
2922 {
2923 Lisp_Object ro = XBUFFER (buffer)->read_only;
2924 Lisp_Object tem;
2925 struct buffer *old = current_buffer;
2926 int opoint;
2927
2928 /* Avoid error if buffer is deleted
2929 (probably that's why the process is dead, too) */
2930 if (NILP (XBUFFER (buffer)->name))
2931 continue;
2932 Fset_buffer (buffer);
2933 opoint = point;
2934 /* Insert new output into buffer
2935 at the current end-of-output marker,
2936 thus preserving logical ordering of input and output. */
2937 if (XMARKER (p->mark)->buffer)
2938 SET_PT (marker_position (p->mark));
2939 else
2940 SET_PT (ZV);
2941 if (point <= opoint)
2942 opoint += XSTRING (msg)->size + XSTRING (p->name)->size + 10;
2943
2944 tem = current_buffer->read_only;
2945 current_buffer->read_only = Qnil;
2946 insert_string ("\nProcess ");
2947 Finsert (1, &p->name);
2948 insert_string (" ");
2949 Finsert (1, &msg);
2950 current_buffer->read_only = tem;
2951 Fset_marker (p->mark, make_number (point), p->buffer);
2952
2953 SET_PT (opoint);
2954 set_buffer_internal (old);
2955 }
2956 }
2957 } /* end for */
2958
2959 update_mode_lines++; /* in case buffers use %s in mode-line-format */
2960 redisplay_preserve_echo_area ();
2961
2962 update_tick = process_tick;
2963
2964 UNGCPRO;
2965}
2966\f
2967init_process ()
2968{
2969 register int i;
2970
2971#ifdef SIGCHLD
2972#ifndef CANNOT_DUMP
2973 if (! noninteractive || initialized)
2974#endif
2975 signal (SIGCHLD, sigchld_handler);
2976#endif
2977
2978 FD_ZERO (&input_wait_mask);
2979 FD_SET (0, &input_wait_mask);
2980 Vprocess_alist = Qnil;
2981 for (i = 0; i < MAXDESC; i++)
2982 {
2983 chan_process[i] = Qnil;
2984 proc_buffered_char[i] = -1;
2985 }
2986}
08564963 2987#if 0
d0d6b7c5
JB
2988DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 0, 1, 0,
2989 "Return the connection type of `PROCESS'. This can be nil (pipe),\n\
2990t or pty (pty) or stream (socket connection).")
2991 (process)
2992 Lisp_Object process;
2993{
2994 return XPROCESS (process)->type;
2995}
2996#endif
2997syms_of_process ()
2998{
d0d6b7c5
JB
2999#ifdef HAVE_SOCKETS
3000 stream_process = intern ("stream");
3001#endif
3002 Qprocessp = intern ("processp");
3003 staticpro (&Qprocessp);
3004 Qrun = intern ("run");
3005 staticpro (&Qrun);
3006 Qstop = intern ("stop");
3007 staticpro (&Qstop);
3008 Qsignal = intern ("signal");
3009 staticpro (&Qsignal);
3010
3011 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
3012 here again.
3013
3014 Qexit = intern ("exit");
3015 staticpro (&Qexit); */
3016
3017 Qopen = intern ("open");
3018 staticpro (&Qopen);
3019 Qclosed = intern ("closed");
3020 staticpro (&Qclosed);
3021
3022 staticpro (&Vprocess_alist);
3023
3024 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
3025 "*Non-nil means delete processes immediately when they exit.\n\
3026nil means don't delete them until `list-processes' is run.");
3027
3028 delete_exited_processes = 1;
3029
3030 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
3031 "Control type of device used to communicate with subprocesses.\n\
3032Values are nil to use a pipe, and t or 'pty for a pty. Note that if\n\
3033pty's are not available, this variable will be ignored. The value takes\n\
3034effect when `start-process' is called.");
3035 Vprocess_connection_type = Qt;
3036
3037 defsubr (&Sprocessp);
3038 defsubr (&Sget_process);
3039 defsubr (&Sget_buffer_process);
3040 defsubr (&Sdelete_process);
3041 defsubr (&Sprocess_status);
3042 defsubr (&Sprocess_exit_status);
3043 defsubr (&Sprocess_id);
3044 defsubr (&Sprocess_name);
3045 defsubr (&Sprocess_command);
3046 defsubr (&Sset_process_buffer);
3047 defsubr (&Sprocess_buffer);
3048 defsubr (&Sprocess_mark);
3049 defsubr (&Sset_process_filter);
3050 defsubr (&Sprocess_filter);
3051 defsubr (&Sset_process_sentinel);
3052 defsubr (&Sprocess_sentinel);
3053 defsubr (&Sprocess_kill_without_query);
3054 defsubr (&Slist_processes);
3055 defsubr (&Sprocess_list);
3056 defsubr (&Sstart_process);
3057#ifdef HAVE_SOCKETS
3058 defsubr (&Sopen_network_stream);
3059#endif /* HAVE_SOCKETS */
3060 defsubr (&Saccept_process_output);
3061 defsubr (&Sprocess_send_region);
3062 defsubr (&Sprocess_send_string);
3063 defsubr (&Sinterrupt_process);
3064 defsubr (&Skill_process);
3065 defsubr (&Squit_process);
3066 defsubr (&Sstop_process);
3067 defsubr (&Scontinue_process);
3068 defsubr (&Sprocess_send_eof);
3069 defsubr (&Ssignal_process);
3070 defsubr (&Swaiting_for_user_input_p);
3071/* defsubr (&Sprocess_connection); */
3072}
3073
6720a7fb
JB
3074\f
3075#else /* not subprocesses */
3076
3077#include <sys/types.h>
3078#include <errno.h>
3079
3080#include "lisp.h"
3081#include "systime.h"
3082#include "termopts.h"
3083
ff11dfa1 3084extern int frame_garbaged;
6720a7fb
JB
3085
3086
3087/* As described above, except assuming that there are no subprocesses:
3088
3089 Wait for timeout to elapse and/or keyboard input to be available.
3090
3091 time_limit is:
3092 timeout in seconds, or
3093 zero for no limit, or
3094 -1 means gobble data immediately available but don't wait for any.
3095
f76475ad 3096 read_kbd is a Lisp_Object:
6720a7fb
JB
3097 0 to ignore keyboard input, or
3098 1 to return when input is available, or
3099 -1 means caller will actually read the input, so don't throw to
3100 the quit handler.
3101 We know that read_kbd will never be a Lisp_Process, since
3102 `subprocesses' isn't defined.
3103
3104 do_display != 0 means redisplay should be done to show subprocess
3105 output that arrives. This version of the function ignores it.
3106
eb8c3be9 3107 Return true iff we received input from any process. */
6720a7fb
JB
3108
3109int
3110wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
f76475ad
JB
3111 int time_limit, microsecs;
3112 Lisp_Object read_kbd;
3113 int do_display;
6720a7fb
JB
3114{
3115 EMACS_TIME end_time, timeout, *timeout_p;
3116 int waitchannels;
3117
3118 /* What does time_limit really mean? */
3119 if (time_limit || microsecs)
3120 {
3121 /* It's not infinite. */
3122 timeout_p = &timeout;
3123
3124 if (time_limit == -1)
3125 /* In fact, it's zero. */
3126 EMACS_SET_SECS_USECS (timeout, 0, 0);
3127 else
3128 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
3129
3130 /* How far in the future is that? */
3131 EMACS_GET_TIME (end_time);
3132 EMACS_ADD_TIME (end_time, end_time, timeout);
3133 }
3134 else
3135 /* It's infinite. */
3136 timeout_p = 0;
3137
3138 /* Turn off periodic alarms (in case they are in use)
3139 because the select emulator uses alarms. */
3140 stop_polling ();
3141
3142 for (;;)
3143 {
3144 int nfds;
3145
f76475ad 3146 waitchannels = XINT (read_kbd) ? 1 : 0;
6720a7fb
JB
3147
3148 /* If calling from keyboard input, do not quit
3149 since we want to return C-g as an input character.
3150 Otherwise, do pending quit if requested. */
f76475ad 3151 if (XINT (read_kbd) >= 0)
6720a7fb
JB
3152 QUIT;
3153
3154 if (timeout_p)
3155 {
3156 EMACS_GET_TIME (*timeout_p);
3157 EMACS_SUB_TIME (*timeout_p, end_time, *timeout_p);
3158 if (EMACS_TIME_NEG_P (*timeout_p))
3159 break;
3160 }
3161
3162 /* Cause C-g and alarm signals to take immediate action,
3163 and cause input available signals to zero out timeout. */
f76475ad 3164 if (XINT (read_kbd) < 0)
6720a7fb
JB
3165 set_waiting_for_input (&timeout);
3166
ff11dfa1 3167 /* If a frame has been newly mapped and needs updating,
6720a7fb 3168 reprocess its display stuff. */
ff11dfa1 3169 if (frame_garbaged)
6720a7fb
JB
3170 redisplay_preserve_echo_area ();
3171
f76475ad 3172 if (XINT (read_kbd) && detect_input_pending ())
6720a7fb
JB
3173 nfds = 0;
3174 else
3175 nfds = select (1, &waitchannels, 0, 0, timeout_p);
3176
3177 /* Make C-g and alarm signals set flags again */
3178 clear_waiting_for_input ();
3179
3180 /* If we woke up due to SIGWINCH, actually change size now. */
3181 do_pending_window_change ();
3182
3183 if (nfds == -1)
3184 {
3185 /* If the system call was interrupted, then go around the
3186 loop again. */
3187 if (errno == EINTR)
3188 waitchannels = 0;
3189 }
3190#ifdef sun
3191 else if (nfds > 0 && (waitchannels & 1) && interrupt_input)
3192 /* System sometimes fails to deliver SIGIO. */
3193 kill (getpid (), SIGIO);
3194#endif
7324d660 3195#ifdef SIGIO
f76475ad 3196 if (XINT (read_kbd) && interrupt_input && (waitchannels & 1))
6720a7fb 3197 kill (0, SIGIO);
7324d660 3198#endif
6720a7fb
JB
3199
3200 /* If we have timed out (nfds == 0) or found some input (nfds > 0),
3201 we should exit. */
3202 if (nfds >= 0)
3203 break;
3204 }
3205
a87b802f
JB
3206 start_polling ();
3207
6720a7fb
JB
3208 return 0;
3209}
3210
3211
3212DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
3213 "Return the (or, a) process associated with BUFFER.\n\
3214This copy of Emacs has not been built to support subprocesses, so this\n\
3215function always returns nil.")
3216 (name)
3217 register Lisp_Object name;
3218{
3219 return Qnil;
3220}
3221
3222/* Kill all processes associated with `buffer'.
3223 If `buffer' is nil, kill all processes.
3224 Since we have no subprocesses, this does nothing. */
3225
3226kill_buffer_processes (buffer)
3227 Lisp_Object buffer;
3228{
3229}
3230
3231init_process ()
3232{
3233}
3234
3235syms_of_process ()
3236{
3237 defsubr (&Sget_buffer_process);
3238}
3239
3240\f
3241#endif /* not subprocesses */