(Fgenerate_new_buffer_name): GENTEMP is the value compare against IGNORE.
[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? */
1081 if (XPROCESS (proc)->pid <= 0)
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
JB
1267#else /* not HAVE_SETSID */
1268#ifdef USG
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);
1285#ifndef USG
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
1661 time_limit is:
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
6e4f3667
JB
1666 microsecs is:
1667 an additional duration to wait (if time_limit is greater than
1668 zero), specified in millisec.
1669
f76475ad 1670 read_kbd is a lisp value:
d0d6b7c5
JB
1671 0 to ignore keyboard input, or
1672 1 to return when input is available, or
84aa3ace 1673 -1 meaning caller will actually read the input, so don't throw to
d0d6b7c5 1674 the quit handler, or
84aa3ace 1675 a cons cell, meaning wait wait until its car is non-nil, or
f76475ad
JB
1676 a process object, meaning wait until something arrives from that
1677 process. The return value is true iff we read some input from
1678 that process.
d0d6b7c5
JB
1679
1680 do_display != 0 means redisplay should be done to show subprocess
1681 output that arrives.
1682
1683 If read_kbd is a pointer to a struct Lisp_Process, then the
1684 function returns true iff we received input from that process
1685 before the timeout elapsed.
eb8c3be9 1686 Otherwise, return true iff we received input from any process. */
d0d6b7c5
JB
1687
1688wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
f76475ad
JB
1689 int time_limit, microsecs;
1690 Lisp_Object read_kbd;
1691 int do_display;
d0d6b7c5
JB
1692{
1693 register int channel, nfds, m;
1694 static SELECT_TYPE Available;
1695 int xerrno;
1696 Lisp_Object proc;
1697 EMACS_TIME timeout, end_time, garbage;
1698 SELECT_TYPE Atemp;
1699 int wait_channel = 0;
1700 struct Lisp_Process *wait_proc = 0;
1701 int got_some_input = 0;
84aa3ace 1702 Lisp_Object *wait_for_cell = 0;
d0d6b7c5
JB
1703
1704 FD_ZERO (&Available);
1705
f76475ad
JB
1706 /* If read_kbd is a process to watch, set wait_proc and wait_channel
1707 accordingly. */
1708 if (XTYPE (read_kbd) == Lisp_Process)
d0d6b7c5 1709 {
f76475ad 1710 wait_proc = XPROCESS (read_kbd);
d0d6b7c5 1711 wait_channel = XFASTINT (wait_proc->infd);
f76475ad 1712 XFASTINT (read_kbd) = 0;
d0d6b7c5
JB
1713 }
1714
84aa3ace
RS
1715 /* If waiting for non-nil in a cell, record where. */
1716 if (XTYPE (read_kbd) == Lisp_Cons)
1717 {
1718 wait_for_cell = &XCONS (read_kbd)->car;
1719 XFASTINT (read_kbd) = 0;
1720 }
1721
f76475ad 1722 waiting_for_user_input_p = XINT (read_kbd);
d0d6b7c5
JB
1723
1724 /* Since we may need to wait several times,
1725 compute the absolute time to return at. */
1726 if (time_limit || microsecs)
1727 {
1728 EMACS_GET_TIME (end_time);
1729 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
1730 EMACS_ADD_TIME (end_time, end_time, timeout);
1731 }
1732
d0d6b7c5
JB
1733 while (1)
1734 {
1735 /* If calling from keyboard input, do not quit
1736 since we want to return C-g as an input character.
1737 Otherwise, do pending quit if requested. */
f76475ad 1738 if (XINT (read_kbd) >= 0)
d0d6b7c5
JB
1739 QUIT;
1740
d0d6b7c5
JB
1741 /* Compute time from now till when time limit is up */
1742 /* Exit if already run out */
1743 if (time_limit == -1)
1744 {
1745 /* -1 specified for timeout means
1746 gobble output available now
1747 but don't wait at all. */
1748
1749 EMACS_SET_SECS_USECS (timeout, 0, 0);
1750 }
1751 else if (time_limit || microsecs)
1752 {
1753 EMACS_GET_TIME (timeout);
1754 EMACS_SUB_TIME (timeout, end_time, timeout);
1755 if (EMACS_TIME_NEG_P (timeout))
1756 break;
1757 }
1758 else
1759 {
1760 EMACS_SET_SECS_USECS (timeout, 100000, 0);
1761 }
1762
90ab1a81
JB
1763 /* Cause C-g and alarm signals to take immediate action,
1764 and cause input available signals to zero out timeout.
1765
1766 It is important that we do this before checking for process
1767 activity. If we get a SIGCHLD after the explicit checks for
1768 process activity, timeout is the only way we will know. */
1769 if (XINT (read_kbd) < 0)
1770 set_waiting_for_input (&timeout);
1771
6be429b1
JB
1772 /* If status of something has changed, and no input is
1773 available, notify the user of the change right away. After
1774 this explicit check, we'll let the SIGCHLD handler zap
1775 timeout to get our attention. */
1776 if (update_tick != process_tick && do_display)
1777 {
1778 Atemp = input_wait_mask;
1779 EMACS_SET_SECS_USECS (timeout, 0, 0);
1780 if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0)
90ab1a81
JB
1781 {
1782 /* It's okay for us to do this and then continue with
1783 the loop, since timeout has already been zeroed out. */
1784 clear_waiting_for_input ();
1785 status_notify ();
1786 }
6be429b1
JB
1787 }
1788
1789 /* Don't wait for output from a non-running process. */
1790 if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
1791 update_status (wait_proc);
1792 if (wait_proc != 0
1793 && ! EQ (wait_proc->status, Qrun))
9aa2a7f4
JB
1794 {
1795 clear_waiting_for_input ();
1796 break;
1797 }
6be429b1 1798
d0d6b7c5
JB
1799 /* Wait till there is something to do */
1800
1801 Available = input_wait_mask;
f76475ad 1802 if (! XINT (read_kbd))
d0d6b7c5
JB
1803 FD_CLR (0, &Available);
1804
ff11dfa1 1805 /* If frame size has changed or the window is newly mapped,
ffd56f97
JB
1806 redisplay now, before we start to wait. There is a race
1807 condition here; if a SIGIO arrives between now and the select
016899c0
JB
1808 and indicates that a frame is trashed, the select may block
1809 displaying a trashed screen. */
ff11dfa1 1810 if (frame_garbaged)
ffd56f97
JB
1811 redisplay_preserve_echo_area ();
1812
f76475ad 1813 if (XINT (read_kbd) && detect_input_pending ())
d0d6b7c5
JB
1814 nfds = 0;
1815 else
d0d6b7c5 1816 nfds = select (MAXDESC, &Available, 0, 0, &timeout);
6720a7fb 1817
d0d6b7c5
JB
1818 xerrno = errno;
1819
1820 /* Make C-g and alarm signals set flags again */
1821 clear_waiting_for_input ();
1822
1823 /* If we woke up due to SIGWINCH, actually change size now. */
1824 do_pending_window_change ();
1825
ffd56f97 1826 if (time_limit && nfds == 0) /* timeout elapsed */
d0d6b7c5
JB
1827 break;
1828 if (nfds < 0)
1829 {
1830 if (xerrno == EINTR)
1831 FD_ZERO (&Available);
b0310da4
JB
1832#ifdef ultrix
1833 /* Ultrix select seems to return ENOMEM when it is
1834 interrupted. Treat it just like EINTR. Bleah. Note
1835 that we want to test for the "ultrix" CPP symbol, not
1836 "__ultrix__"; the latter is only defined under GCC, but
1837 not by DEC's bundled CC. -JimB */
8058415c
JB
1838 else if (xerrno == ENOMEM)
1839 FD_ZERO (&Available);
1840#endif
d0d6b7c5
JB
1841#ifdef ALLIANT
1842 /* This happens for no known reason on ALLIANT.
1843 I am guessing that this is the right response. -- RMS. */
1844 else if (xerrno == EFAULT)
1845 FD_ZERO (&Available);
1846#endif
1847 else if (xerrno == EBADF)
1848 {
1849#ifdef AIX
1850 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
1851 the child's closure of the pts gives the parent a SIGHUP, and
1852 the ptc file descriptor is automatically closed,
1853 yielding EBADF here or at select() call above.
1854 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
1855 in m-ibmrt-aix.h), and here we just ignore the select error.
1856 Cleanup occurs c/o status_notify after SIGCLD. */
ffd56f97 1857 FD_ZERO (&Available); /* Cannot depend on values returned */
d0d6b7c5
JB
1858#else
1859 abort ();
1860#endif
1861 }
1862 else
1863 error("select error: %s", sys_errlist[xerrno]);
1864 }
26ec91de 1865#if defined(sun) && !defined(USG5_4)
d0d6b7c5 1866 else if (nfds > 0 && FD_ISSET (0, &Available) && interrupt_input)
e0109153
JB
1867 /* System sometimes fails to deliver SIGIO.
1868
1869 David J. Mackenzie says that Emacs doesn't compile under
1870 Solaris if this code is enabled, thus the USG5_4 in the CPP
1871 conditional. "I haven't noticed any ill effects so far.
1872 If you find a Solaris expert somewhere, they might know
1873 better." */
d0d6b7c5
JB
1874 kill (getpid (), SIGIO);
1875#endif
1876
1877 /* Check for keyboard input */
1878 /* If there is any, return immediately
1879 to give it higher priority than subprocesses */
1880
f76475ad 1881 if (XINT (read_kbd) && detect_input_pending ())
6e103bac
RS
1882 {
1883 swallow_events ();
1884 if (detect_input_pending ())
1885 break;
1886 }
d0d6b7c5 1887
84aa3ace
RS
1888 /* Exit now if the cell we're waiting for became non-nil. */
1889 if (wait_for_cell && ! NILP (*wait_for_cell))
1890 break;
1891
4746118a 1892#ifdef SIGIO
d0d6b7c5
JB
1893 /* If we think we have keyboard input waiting, but didn't get SIGIO
1894 go read it. This can happen with X on BSD after logging out.
1895 In that case, there really is no input and no SIGIO,
1896 but select says there is input. */
1897
f76475ad 1898 if (XINT (read_kbd) && interrupt_input && (FD_ISSET (fileno (stdin), &Available)))
d0d6b7c5 1899 kill (0, SIGIO);
4746118a 1900#endif
d0d6b7c5 1901
d0d6b7c5
JB
1902 if (! wait_proc)
1903 got_some_input |= nfds > 0;
1904
32676c08
JB
1905 /* If checking input just got us a size-change event from X,
1906 obey it now if we should. */
f76475ad 1907 if (XINT (read_kbd))
32676c08
JB
1908 do_pending_window_change ();
1909
d0d6b7c5
JB
1910 /* Check for data from a process or a command channel */
1911 for (channel = FIRST_PROC_DESC; channel < MAXDESC; channel++)
1912 {
1913 if (FD_ISSET (channel, &Available))
1914 {
1915 int nread;
1916
1917 /* If waiting for this channel, arrange to return as
1918 soon as no more input to be processed. No more
1919 waiting. */
1920 if (wait_channel == channel)
1921 {
1922 wait_channel = 0;
1923 time_limit = -1;
1924 got_some_input = 1;
1925 }
1926 proc = chan_process[channel];
1927 if (NILP (proc))
1928 continue;
1929
d0d6b7c5
JB
1930 /* Read data from the process, starting with our
1931 buffered-ahead character if we have one. */
1932
1933 nread = read_process_output (proc, channel);
1934 if (nread > 0)
1935 {
1936 /* Since read_process_output can run a filter,
1937 which can call accept-process-output,
1938 don't try to read from any other processes
1939 before doing the select again. */
1940 FD_ZERO (&Available);
1941
1942 if (do_display)
1943 redisplay_preserve_echo_area ();
1944 }
1945#ifdef EWOULDBLOCK
1946 else if (nread == -1 && errno == EWOULDBLOCK)
1947 ;
1948#else
1949#ifdef O_NONBLOCK
1950 else if (nread == -1 && errno == EAGAIN)
1951 ;
1952#else
1953#ifdef O_NDELAY
1954 else if (nread == -1 && errno == EAGAIN)
1955 ;
1956 /* Note that we cannot distinguish between no input
1957 available now and a closed pipe.
1958 With luck, a closed pipe will be accompanied by
1959 subprocess termination and SIGCHLD. */
1960 else if (nread == 0 && !NETCONN_P (proc))
1961 ;
ffd56f97
JB
1962#endif /* O_NDELAY */
1963#endif /* O_NONBLOCK */
1964#endif /* EWOULDBLOCK */
d0d6b7c5
JB
1965#ifdef HAVE_PTYS
1966 /* On some OSs with ptys, when the process on one end of
1967 a pty exits, the other end gets an error reading with
1968 errno = EIO instead of getting an EOF (0 bytes read).
1969 Therefore, if we get an error reading and errno =
1970 EIO, just continue, because the child process has
1971 exited and should clean itself up soon (e.g. when we
1972 get a SIGCHLD). */
1973 else if (nread == -1 && errno == EIO)
1974 ;
ffd56f97
JB
1975#endif /* HAVE_PTYS */
1976 /* If we can detect process termination, don't consider the process
1977 gone just because its pipe is closed. */
d0d6b7c5
JB
1978#ifdef SIGCHLD
1979 else if (nread == 0 && !NETCONN_P (proc))
1980 ;
1981#endif
1982 else
1983 {
1984 /* Preserve status of processes already terminated. */
1985 XSETINT (XPROCESS (proc)->tick, ++process_tick);
1986 deactivate_process (proc);
1987 if (!NILP (XPROCESS (proc)->raw_status_low))
1988 update_status (XPROCESS (proc));
1989 if (EQ (XPROCESS (proc)->status, Qrun))
1990 XPROCESS (proc)->status
1991 = Fcons (Qexit, Fcons (make_number (256), Qnil));
1992 }
1993 }
ffd56f97
JB
1994 } /* end for each file descriptor */
1995 } /* end while exit conditions not met */
d0d6b7c5 1996
ffd56f97
JB
1997 /* If calling from keyboard input, do not quit
1998 since we want to return C-g as an input character.
1999 Otherwise, do pending quit if requested. */
f76475ad 2000 if (XINT (read_kbd) >= 0)
ffd56f97
JB
2001 {
2002 /* Prevent input_pending from remaining set if we quit. */
2003 clear_input_pending ();
2004 QUIT;
2005 }
d0d6b7c5
JB
2006
2007 return got_some_input;
2008}
2009\f
2010/* Read pending output from the process channel,
2011 starting with our buffered-ahead character if we have one.
2012 Yield number of characters read.
2013
2014 This function reads at most 1024 characters.
2015 If you want to read all available subprocess output,
2016 you must call it repeatedly until it returns zero. */
2017
2018read_process_output (proc, channel)
2019 Lisp_Object proc;
2020 register int channel;
2021{
2022 register int nchars;
2023#ifdef VMS
2024 char *chars;
2025#else
2026 char chars[1024];
2027#endif
2028 register Lisp_Object outstream;
2029 register struct buffer *old = current_buffer;
2030 register struct Lisp_Process *p = XPROCESS (proc);
2031 register int opoint;
2032
2033#ifdef VMS
2034 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
2035
2036 vs = get_vms_process_pointer (p->pid);
2037 if (vs)
2038 {
2039 if (!vs->iosb[0])
2040 return(0); /* Really weird if it does this */
2041 if (!(vs->iosb[0] & 1))
2042 return -1; /* I/O error */
2043 }
2044 else
2045 error ("Could not get VMS process pointer");
2046 chars = vs->inputBuffer;
2047 nchars = clean_vms_buffer (chars, vs->iosb[1]);
2048 if (nchars <= 0)
2049 {
2050 start_vms_process_read (vs); /* Crank up the next read on the process */
2051 return 1; /* Nothing worth printing, say we got 1 */
2052 }
2053#else /* not VMS */
2054
2055 if (proc_buffered_char[channel] < 0)
2056 nchars = read (channel, chars, sizeof chars);
2057 else
2058 {
2059 chars[0] = proc_buffered_char[channel];
2060 proc_buffered_char[channel] = -1;
2061 nchars = read (channel, chars + 1, sizeof chars - 1);
2062 if (nchars < 0)
2063 nchars = 1;
2064 else
2065 nchars = nchars + 1;
2066 }
2067#endif /* not VMS */
2068
2069 if (nchars <= 0) return nchars;
2070
2071 outstream = p->filter;
2072 if (!NILP (outstream))
2073 {
2074 /* We inhibit quit here instead of just catching it so that
2075 hitting ^G when a filter happens to be running won't screw
2076 it up. */
2077 int count = specpdl_ptr - specpdl;
30c78175
RS
2078 Lisp_Object odeactivate;
2079
2080 odeactivate = Vdeactivate_mark;
2081
d0d6b7c5
JB
2082 specbind (Qinhibit_quit, Qt);
2083 call2 (outstream, proc, make_string (chars, nchars));
2084
30c78175
RS
2085 /* Deactivate the mark now, so it doesn't happen
2086 *after* the following command. */
2087 if (!NILP (current_buffer->mark_active))
2088 {
2089 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
2090 {
2091 current_buffer->mark_active = Qnil;
2092 call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
2093 }
2094 }
2095 Vdeactivate_mark = odeactivate;
2096
d0d6b7c5
JB
2097#ifdef VMS
2098 start_vms_process_read (vs);
2099#endif
2100 unbind_to (count);
2101 return nchars;
2102 }
2103
2104 /* If no filter, write into buffer if it isn't dead. */
2105 if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
2106 {
b0310da4
JB
2107 Lisp_Object old_read_only;
2108 Lisp_Object old_begv, old_zv;
30c78175
RS
2109 Lisp_Object odeactivate;
2110
2111 odeactivate = Vdeactivate_mark;
d0d6b7c5
JB
2112
2113 Fset_buffer (p->buffer);
2114 opoint = point;
b0310da4
JB
2115 old_read_only = current_buffer->read_only;
2116 XFASTINT (old_begv) = BEGV;
2117 XFASTINT (old_zv) = ZV;
2118
2119 current_buffer->read_only = Qnil;
d0d6b7c5
JB
2120
2121 /* Insert new output into buffer
2122 at the current end-of-output marker,
2123 thus preserving logical ordering of input and output. */
2124 if (XMARKER (p->mark)->buffer)
2125 SET_PT (marker_position (p->mark));
2126 else
2127 SET_PT (ZV);
b0310da4
JB
2128
2129 /* If the output marker is outside of the visible region, save
2130 the restriction and widen. */
2131 if (! (BEGV <= point && point <= ZV))
2132 Fwiden ();
2133
2134 /* Make sure opoint floats ahead of any new text, just as point
2135 would. */
d0d6b7c5
JB
2136 if (point <= opoint)
2137 opoint += nchars;
2138
b0310da4
JB
2139 /* Insert after old_begv, but before old_zv. */
2140 if (point < XFASTINT (old_begv))
2141 XFASTINT (old_begv) += nchars;
2142 if (point <= XFASTINT (old_zv))
2143 XFASTINT (old_zv) += nchars;
2144
d0d6b7c5
JB
2145 /* Insert before markers in case we are inserting where
2146 the buffer's mark is, and the user's next command is Meta-y. */
2147 insert_before_markers (chars, nchars);
d0d6b7c5 2148 Fset_marker (p->mark, make_number (point), p->buffer);
b0310da4 2149
d0d6b7c5
JB
2150 update_mode_lines++;
2151
b0310da4
JB
2152 /* If the restriction isn't what it should be, set it. */
2153 if (XFASTINT (old_begv) != BEGV || XFASTINT (old_zv) != ZV)
2154 Fnarrow_to_region (old_begv, old_zv);
2155
30c78175
RS
2156 /* Deactivate the mark now, so it doesn't happen
2157 *after* the following command. */
2158 if (!NILP (current_buffer->mark_active))
2159 {
2160 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
2161 {
2162 current_buffer->mark_active = Qnil;
2163 call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
2164 }
2165 }
2166
2167 Vdeactivate_mark = odeactivate;
2168
b0310da4 2169 current_buffer->read_only = old_read_only;
d0d6b7c5
JB
2170 SET_PT (opoint);
2171 set_buffer_internal (old);
2172 }
2173#ifdef VMS
2174 start_vms_process_read (vs);
2175#endif
2176 return nchars;
2177}
2178
2179DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
2180 0, 0, 0,
2181 "Returns non-NIL if emacs is waiting for input from the user.\n\
2182This is intended for use by asynchronous process output filters and sentinels.")
2183 ()
2184{
2185 return ((waiting_for_user_input_p) ? Qt : Qnil);
2186}
2187\f
2188/* Sending data to subprocess */
2189
2190jmp_buf send_process_frame;
2191
2192SIGTYPE
2193send_process_trap ()
2194{
2195#ifdef BSD4_1
2196 sigrelse (SIGPIPE);
2197 sigrelse (SIGALRM);
2198#endif /* BSD4_1 */
2199 longjmp (send_process_frame, 1);
2200}
2201
2202send_process (proc, buf, len)
2203 Lisp_Object proc;
2204 char *buf;
2205 int len;
2206{
2207 /* Don't use register vars; longjmp can lose them. */
2208 int rv;
2209 unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
2210
2211
2212#ifdef VMS
2213 struct Lisp_Process *p = XPROCESS (proc);
2214 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
2215#endif /* VMS */
2216
2217 if (! NILP (XPROCESS (proc)->raw_status_low))
2218 update_status (XPROCESS (proc));
2219 if (! EQ (XPROCESS (proc)->status, Qrun))
2220 error ("Process %s not running", procname);
2221
2222#ifdef VMS
2223 vs = get_vms_process_pointer (p->pid);
2224 if (vs == 0)
2225 error ("Could not find this process: %x", p->pid);
2226 else if (write_to_vms_process (vs, buf, len))
2227 ;
2228#else
2229 if (!setjmp (send_process_frame))
2230 while (len > 0)
2231 {
2232 int this = len;
4746118a
JB
2233 SIGTYPE (*old_sigpipe)();
2234
d0d6b7c5
JB
2235 /* Don't send more than 500 bytes at a time. */
2236 if (this > 500)
2237 this = 500;
508b171c 2238 old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
d0d6b7c5 2239 rv = write (XFASTINT (XPROCESS (proc)->outfd), buf, this);
4746118a 2240 signal (SIGPIPE, old_sigpipe);
d0d6b7c5
JB
2241 if (rv < 0)
2242 {
2243 if (0
2244#ifdef EWOULDBLOCK
2245 || errno == EWOULDBLOCK
2246#endif
2247#ifdef EAGAIN
2248 || errno == EAGAIN
2249#endif
2250 )
2251 {
2252 /* It would be nice to accept process output here,
2253 but that is difficult. For example, it could
2254 garbage what we are sending if that is from a buffer. */
2255 immediate_quit = 1;
2256 QUIT;
2257 sleep (1);
2258 immediate_quit = 0;
2259 continue;
2260 }
2261 report_file_error ("writing to process", Fcons (proc, Qnil));
2262 }
2263 buf += rv;
2264 len -= rv;
2265 /* Allow input from processes between bursts of sending.
2266 Otherwise things may get stopped up. */
2267 if (len > 0)
f76475ad
JB
2268 {
2269 Lisp_Object zero;
2270
2271 XFASTINT (zero) = 0;
2272 wait_reading_process_input (-1, 0, zero, 0);
2273 }
d0d6b7c5
JB
2274 }
2275#endif
2276 else
2277 {
2278 XPROCESS (proc)->raw_status_low = Qnil;
2279 XPROCESS (proc)->raw_status_high = Qnil;
2280 XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
2281 XSETINT (XPROCESS (proc)->tick, ++process_tick);
2282 deactivate_process (proc);
2283#ifdef VMS
2284 error ("Error writing to process %s; closed it", procname);
2285#else
2286 error ("SIGPIPE raised on process %s; closed it", procname);
2287#endif
2288 }
2289}
2290
2291DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
2292 3, 3, 0,
2293 "Send current contents of region as input to PROCESS.\n\
ebb9e16f
JB
2294PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2295nil, indicating the current buffer's process.\n\
d0d6b7c5
JB
2296Called from program, takes three arguments, PROCESS, START and END.\n\
2297If the region is more than 500 characters long,\n\
2298it is sent in several bunches. This may happen even for shorter regions.\n\
2299Output from processes can arrive in between bunches.")
2300 (process, start, end)
2301 Lisp_Object process, start, end;
2302{
2303 Lisp_Object proc;
2304 int start1;
2305
2306 proc = get_process (process);
2307 validate_region (&start, &end);
2308
2309 if (XINT (start) < GPT && XINT (end) > GPT)
2310 move_gap (start);
2311
2312 start1 = XINT (start);
2313 send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start));
2314
2315 return Qnil;
2316}
2317
2318DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
2319 2, 2, 0,
2320 "Send PROCESS the contents of STRING as input.\n\
ebb9e16f
JB
2321PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2322nil, indicating the current buffer's process.\n\
d0d6b7c5
JB
2323If STRING is more than 500 characters long,\n\
2324it is sent in several bunches. This may happen even for shorter strings.\n\
2325Output from processes can arrive in between bunches.")
2326 (process, string)
2327 Lisp_Object process, string;
2328{
2329 Lisp_Object proc;
2330 CHECK_STRING (string, 1);
2331 proc = get_process (process);
2332 send_process (proc, XSTRING (string)->data, XSTRING (string)->size);
2333 return Qnil;
2334}
2335\f
2336/* send a signal number SIGNO to PROCESS.
2337 CURRENT_GROUP means send to the process group that currently owns
2338 the terminal being used to communicate with PROCESS.
2339 This is used for various commands in shell mode.
2340 If NOMSG is zero, insert signal-announcements into process's buffers
b0310da4
JB
2341 right away.
2342
2343 If we can, we try to signal PROCESS by sending control characters
2344 down the pipe. This allows us to signal inferiors who have changed
2345 their uid, for which killpg would return an EPERM error. */
d0d6b7c5 2346
f9738840 2347static void
d0d6b7c5
JB
2348process_send_signal (process, signo, current_group, nomsg)
2349 Lisp_Object process;
2350 int signo;
2351 Lisp_Object current_group;
2352 int nomsg;
2353{
2354 Lisp_Object proc;
2355 register struct Lisp_Process *p;
2356 int gid;
2357 int no_pgrp = 0;
2358
2359 proc = get_process (process);
2360 p = XPROCESS (proc);
2361
2362 if (!EQ (p->childp, Qt))
2363 error ("Process %s is not a subprocess",
2364 XSTRING (p->name)->data);
2365 if (!XFASTINT (p->infd))
2366 error ("Process %s is not active",
2367 XSTRING (p->name)->data);
2368
2369 if (NILP (p->pty_flag))
2370 current_group = Qnil;
2371
d0d6b7c5
JB
2372 /* If we are using pgrps, get a pgrp number and make it negative. */
2373 if (!NILP (current_group))
2374 {
b0310da4 2375#ifdef SIGNALS_VIA_CHARACTERS
d0d6b7c5
JB
2376 /* If possible, send signals to the entire pgrp
2377 by sending an input character to it. */
b0310da4 2378
6be429b1
JB
2379 /* TERMIOS is the latest and bestest, and seems most likely to
2380 work. If the system has it, use it. */
2381#ifdef HAVE_TERMIOS
2382 struct termios t;
2383
2384 switch (signo)
2385 {
2386 case SIGINT:
2387 tcgetattr (XFASTINT (p->infd), &t);
2388 send_process (proc, &t.c_cc[VINTR], 1);
a87b802f 2389 return;
6be429b1
JB
2390
2391 case SIGQUIT:
2392 tcgetattr (XFASTINT (p->infd), &t);
2393 send_process (proc, &t.c_cc[VQUIT], 1);
a87b802f 2394 return;
6be429b1
JB
2395
2396 case SIGTSTP:
2397 tcgetattr (XFASTINT (p->infd), &t);
2398#ifdef VSWTCH
2399 send_process (proc, &t.c_cc[VSWTCH], 1);
2400#else
2401 send_process (proc, &t.c_cc[VSUSP], 1);
2402#endif
a87b802f 2403 return;
6be429b1
JB
2404 }
2405
2406#else /* ! HAVE_TERMIOS */
2407
b0310da4
JB
2408 /* On Berkeley descendants, the following IOCTL's retrieve the
2409 current control characters. */
d0d6b7c5 2410#if defined (TIOCGLTC) && defined (TIOCGETC)
b0310da4 2411
d0d6b7c5
JB
2412 struct tchars c;
2413 struct ltchars lc;
2414
2415 switch (signo)
2416 {
2417 case SIGINT:
2418 ioctl (XFASTINT (p->infd), TIOCGETC, &c);
2419 send_process (proc, &c.t_intrc, 1);
f9738840 2420 return;
d0d6b7c5
JB
2421 case SIGQUIT:
2422 ioctl (XFASTINT (p->infd), TIOCGETC, &c);
2423 send_process (proc, &c.t_quitc, 1);
f9738840 2424 return;
0ad77c54 2425#ifdef SIGTSTP
d0d6b7c5
JB
2426 case SIGTSTP:
2427 ioctl (XFASTINT (p->infd), TIOCGLTC, &lc);
2428 send_process (proc, &lc.t_suspc, 1);
f9738840 2429 return;
b0310da4 2430#endif /* ! defined (SIGTSTP) */
d0d6b7c5 2431 }
b0310da4
JB
2432
2433#else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
2434
2435 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
2436 characters. */
2437#ifdef TCGETA
d0d6b7c5
JB
2438 struct termio t;
2439 switch (signo)
2440 {
2441 case SIGINT:
2442 ioctl (XFASTINT (p->infd), TCGETA, &t);
2443 send_process (proc, &t.c_cc[VINTR], 1);
f9738840 2444 return;
d0d6b7c5
JB
2445 case SIGQUIT:
2446 ioctl (XFASTINT (p->infd), TCGETA, &t);
2447 send_process (proc, &t.c_cc[VQUIT], 1);
f9738840 2448 return;
7d79e3b4 2449#ifdef SIGTSTP
d0d6b7c5
JB
2450 case SIGTSTP:
2451 ioctl (XFASTINT (p->infd), TCGETA, &t);
2452 send_process (proc, &t.c_cc[VSWTCH], 1);
f9738840 2453 return;
b0310da4 2454#endif /* ! defined (SIGTSTP) */
d0d6b7c5 2455 }
b0310da4
JB
2456#else /* ! defined (TCGETA) */
2457 Your configuration files are messed up.
2458 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
2459 you'd better be using one of the alternatives above! */
2460#endif /* ! defined (TCGETA) */
2461#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
6be429b1 2462#endif /* ! defined HAVE_TERMIOS */
b0310da4 2463#endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
d0d6b7c5 2464
301c3fe4 2465#ifdef TIOCGPGRP
d0d6b7c5
JB
2466 /* Get the pgrp using the tty itself, if we have that.
2467 Otherwise, use the pty to get the pgrp.
2468 On pfa systems, saka@pfu.fujitsu.co.JP writes:
b0310da4
JB
2469 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
2470 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
d0d6b7c5
JB
2471 His patch indicates that if TIOCGPGRP returns an error, then
2472 we should just assume that p->pid is also the process group id. */
2473 {
2474 int err;
2475
2476 if (!NILP (p->subtty))
2477 err = ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
2478 else
2479 err = ioctl (XFASTINT (p->infd), TIOCGPGRP, &gid);
2480
2481#ifdef pfa
2482 if (err == -1)
2483 gid = - XFASTINT (p->pid);
301c3fe4 2484#endif /* ! defined (pfa) */
d0d6b7c5
JB
2485 }
2486 if (gid == -1)
2487 no_pgrp = 1;
2488 else
2489 gid = - gid;
b0310da4 2490#else /* ! defined (TIOCGPGRP ) */
301c3fe4
JB
2491 /* Can't select pgrps on this system, so we know that
2492 the child itself heads the pgrp. */
2493 gid = - XFASTINT (p->pid);
2494#endif /* ! defined (TIOCGPGRP ) */
d0d6b7c5
JB
2495 }
2496 else
2497 gid = - XFASTINT (p->pid);
d0d6b7c5
JB
2498
2499 switch (signo)
2500 {
2501#ifdef SIGCONT
2502 case SIGCONT:
2503 p->raw_status_low = Qnil;
2504 p->raw_status_high = Qnil;
2505 p->status = Qrun;
2506 XSETINT (p->tick, ++process_tick);
2507 if (!nomsg)
2508 status_notify ();
2509 break;
301c3fe4 2510#endif /* ! defined (SIGCONT) */
d0d6b7c5
JB
2511 case SIGINT:
2512#ifdef VMS
2513 send_process (proc, "\003", 1); /* ^C */
2514 goto whoosh;
2515#endif
2516 case SIGQUIT:
2517#ifdef VMS
2518 send_process (proc, "\031", 1); /* ^Y */
2519 goto whoosh;
2520#endif
2521 case SIGKILL:
2522#ifdef VMS
2523 sys$forcex (&(XFASTINT (p->pid)), 0, 1);
2524 whoosh:
2525#endif
2526 flush_pending_output (XFASTINT (p->infd));
2527 break;
2528 }
2529
2530 /* If we don't have process groups, send the signal to the immediate
2531 subprocess. That isn't really right, but it's better than any
2532 obvious alternative. */
2533 if (no_pgrp)
2534 {
2535 kill (XFASTINT (p->pid), signo);
2536 return;
2537 }
2538
2539 /* gid may be a pid, or minus a pgrp's number */
2540#ifdef TIOCSIGSEND
2541 if (!NILP (current_group))
2542 ioctl (XFASTINT (p->infd), TIOCSIGSEND, signo);
2543 else
2544 {
2545 gid = - XFASTINT (p->pid);
2546 kill (gid, signo);
2547 }
301c3fe4 2548#else /* ! defined (TIOCSIGSEND) */
d0d6b7c5 2549 EMACS_KILLPG (-gid, signo);
301c3fe4 2550#endif /* ! defined (TIOCSIGSEND) */
d0d6b7c5
JB
2551}
2552
2553DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
2554 "Interrupt process PROCESS. May be process or name of one.\n\
ebb9e16f 2555PROCESS may be a process, a buffer, or the name of a process or buffer.\n\
d0d6b7c5
JB
2556Nil or no arg means current buffer's process.\n\
2557Second arg CURRENT-GROUP non-nil means send signal to\n\
2558the current process-group of the process's controlling terminal\n\
2559rather than to the process's own process group.\n\
2560If the process is a shell, this means interrupt current subjob\n\
2561rather than the shell.")
2562 (process, current_group)
2563 Lisp_Object process, current_group;
2564{
2565 process_send_signal (process, SIGINT, current_group, 0);
2566 return process;
2567}
2568
2569DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
2570 "Kill process PROCESS. May be process or name of one.\n\
2571See function `interrupt-process' for more details on usage.")
2572 (process, current_group)
2573 Lisp_Object process, current_group;
2574{
2575 process_send_signal (process, SIGKILL, current_group, 0);
2576 return process;
2577}
2578
2579DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
2580 "Send QUIT signal to process PROCESS. May be process or name of one.\n\
2581See function `interrupt-process' for more details on usage.")
2582 (process, current_group)
2583 Lisp_Object process, current_group;
2584{
2585 process_send_signal (process, SIGQUIT, current_group, 0);
2586 return process;
2587}
2588
2589DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
2590 "Stop process PROCESS. May be process or name of one.\n\
2591See function `interrupt-process' for more details on usage.")
2592 (process, current_group)
2593 Lisp_Object process, current_group;
2594{
2595#ifndef SIGTSTP
2596 error ("no SIGTSTP support");
2597#else
2598 process_send_signal (process, SIGTSTP, current_group, 0);
2599#endif
2600 return process;
2601}
2602
2603DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
2604 "Continue process PROCESS. May be process or name of one.\n\
2605See function `interrupt-process' for more details on usage.")
2606 (process, current_group)
2607 Lisp_Object process, current_group;
2608{
2609#ifdef SIGCONT
2610 process_send_signal (process, SIGCONT, current_group, 0);
2611#else
2612 error ("no SIGCONT support");
2613#endif
2614 return process;
2615}
2616
2617DEFUN ("signal-process", Fsignal_process, Ssignal_process,
2618 2, 2, "nProcess number: \nnSignal code: ",
2619 "Send the process with number PID the signal with code CODE.\n\
2620Both PID and CODE are integers.")
2621 (pid, sig)
2622 Lisp_Object pid, sig;
2623{
2624 CHECK_NUMBER (pid, 0);
2625 CHECK_NUMBER (sig, 1);
2626 return make_number (kill (XINT (pid), XINT (sig)));
2627}
2628
2629DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
2630 "Make PROCESS see end-of-file in its input.\n\
2631Eof comes after any text already sent to it.\n\
ebb9e16f
JB
2632PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2633nil, indicating the current buffer's process.")
d0d6b7c5
JB
2634 (process)
2635 Lisp_Object process;
2636{
2637 Lisp_Object proc;
2638
2639 proc = get_process (process);
577d03d5
RS
2640
2641 /* Make sure the process is really alive. */
2642 if (! NILP (XPROCESS (proc)->raw_status_low))
2643 update_status (XPROCESS (proc));
2644 if (! EQ (XPROCESS (proc)->status, Qrun))
dcf970e6 2645 error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data);
577d03d5 2646
d0d6b7c5
JB
2647 /* Sending a zero-length record is supposed to mean eof
2648 when TIOCREMOTE is turned on. */
2649#ifdef DID_REMOTE
2650 {
2651 char buf[1];
2652 write (XFASTINT (XPROCESS (proc)->outfd), buf, 0);
2653 }
2654#else /* did not do TOICREMOTE */
2655#ifdef VMS
2656 send_process (proc, "\032", 1); /* ^z */
2657#else
2658 if (!NILP (XPROCESS (proc)->pty_flag))
2659 send_process (proc, "\004", 1);
2660 else
2661 {
2662 close (XPROCESS (proc)->outfd);
5437e9f9 2663 XFASTINT (XPROCESS (proc)->outfd) = open (NULL_DEVICE, O_WRONLY);
d0d6b7c5
JB
2664 }
2665#endif /* VMS */
2666#endif /* did not do TOICREMOTE */
2667 return process;
2668}
2669
2670/* Kill all processes associated with `buffer'.
2671 If `buffer' is nil, kill all processes */
2672
2673kill_buffer_processes (buffer)
2674 Lisp_Object buffer;
2675{
2676 Lisp_Object tail, proc;
2677
2678 for (tail = Vprocess_alist; XGCTYPE (tail) == Lisp_Cons;
2679 tail = XCONS (tail)->cdr)
2680 {
2681 proc = XCONS (XCONS (tail)->car)->cdr;
2682 if (XGCTYPE (proc) == Lisp_Process
2683 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
2684 {
2685 if (NETCONN_P (proc))
2686 deactivate_process (proc);
2687 else if (XFASTINT (XPROCESS (proc)->infd))
2688 process_send_signal (proc, SIGHUP, Qnil, 1);
2689 }
2690 }
2691}
2692\f
2693/* On receipt of a signal that a child status has changed,
2694 loop asking about children with changed statuses until
2695 the system says there are no more.
2696 All we do is change the status;
2697 we do not run sentinels or print notifications.
2698 That is saved for the next time keyboard input is done,
2699 in order to avoid timing errors. */
2700
2701/** WARNING: this can be called during garbage collection.
2702 Therefore, it must not be fooled by the presence of mark bits in
2703 Lisp objects. */
2704
2705/** USG WARNING: Although it is not obvious from the documentation
2706 in signal(2), on a USG system the SIGCLD handler MUST NOT call
2707 signal() before executing at least one wait(), otherwise the handler
2708 will be called again, resulting in an infinite loop. The relevant
2709 portion of the documentation reads "SIGCLD signals will be queued
2710 and the signal-catching function will be continually reentered until
2711 the queue is empty". Invoking signal() causes the kernel to reexamine
2712 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
2713
2714SIGTYPE
2715sigchld_handler (signo)
2716 int signo;
2717{
2718 int old_errno = errno;
2719 Lisp_Object proc;
2720 register struct Lisp_Process *p;
6be429b1 2721 extern EMACS_TIME *input_available_clear_time;
d0d6b7c5
JB
2722
2723#ifdef BSD4_1
2724 extern int sigheld;
2725 sigheld |= sigbit (SIGCHLD);
2726#endif
2727
2728 while (1)
2729 {
2730 register int pid;
2731 WAITTYPE w;
2732 Lisp_Object tail;
2733
2734#ifdef WNOHANG
2735#ifndef WUNTRACED
2736#define WUNTRACED 0
2737#endif /* no WUNTRACED */
2738 /* Keep trying to get a status until we get a definitive result. */
2739 do
2740 {
2741 errno = 0;
2742 pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
2743 }
2744 while (pid <= 0 && errno == EINTR);
2745
2746 if (pid <= 0)
2747 {
2748 /* A real failure. We have done all our job, so return. */
2749
2750 /* USG systems forget handlers when they are used;
2751 must reestablish each time */
2752#ifdef USG
2753 signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
2754#endif
2755#ifdef BSD4_1
2756 sigheld &= ~sigbit (SIGCHLD);
2757 sigrelse (SIGCHLD);
2758#endif
2759 errno = old_errno;
2760 return;
2761 }
2762#else
2763 pid = wait (&w);
2764#endif /* no WNOHANG */
2765
2766 /* Find the process that signaled us, and record its status. */
2767
2768 p = 0;
2769 for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
2770 {
2771 proc = XCONS (XCONS (tail)->car)->cdr;
2772 p = XPROCESS (proc);
2773 if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
2774 break;
2775 p = 0;
2776 }
2777
2778 /* Look for an asynchronous process whose pid hasn't been filled
2779 in yet. */
2780 if (p == 0)
2781 for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
2782 {
2783 proc = XCONS (XCONS (tail)->car)->cdr;
2784 p = XPROCESS (proc);
2785 if (XTYPE (p->pid) == Lisp_Int && XINT (p->pid) == -1)
2786 break;
2787 p = 0;
2788 }
2789
2790 /* Change the status of the process that was found. */
2791 if (p != 0)
2792 {
2793 union { int i; WAITTYPE wt; } u;
2794
2795 XSETINT (p->tick, ++process_tick);
2796 u.wt = w;
2797 XFASTINT (p->raw_status_low) = u.i & 0xffff;
2798 XFASTINT (p->raw_status_high) = u.i >> 16;
2799
2800 /* If process has terminated, stop waiting for its output. */
2801 if (WIFSIGNALED (w) || WIFEXITED (w))
f9738840
JB
2802 if (XFASTINT (p->infd))
2803 FD_CLR (XFASTINT (p->infd), &input_wait_mask);
6be429b1
JB
2804
2805 /* Tell wait_reading_process_input that it needs to wake up and
2806 look around. */
2807 if (input_available_clear_time)
2808 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
d0d6b7c5
JB
2809 }
2810
2811 /* There was no asynchronous process found for that id. Check
2812 if we have a synchronous process. */
2813 else
2814 {
2815 synch_process_alive = 0;
2816
2817 /* Report the status of the synchronous process. */
2818 if (WIFEXITED (w))
2819 synch_process_retcode = WRETCODE (w);
2820 else if (WIFSIGNALED (w))
b0310da4 2821#ifndef VMS
95e8068d 2822 synch_process_death = (char *) sys_siglist[WTERMSIG (w)];
b0310da4
JB
2823#else
2824 synch_process_death = sys_errlist[WTERMSIG (w)];
2825#endif
6be429b1
JB
2826
2827 /* Tell wait_reading_process_input that it needs to wake up and
2828 look around. */
2829 if (input_available_clear_time)
2830 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
d0d6b7c5
JB
2831 }
2832
2833 /* On some systems, we must return right away.
2834 If any more processes want to signal us, we will
2835 get another signal.
2836 Otherwise (on systems that have WNOHANG), loop around
2837 to use up all the processes that have something to tell us. */
2838#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG))
2839#ifdef USG
2840 signal (signo, sigchld_handler);
2841#endif
2842 errno = old_errno;
2843 return;
2844#endif /* USG, but not HPUX with WNOHANG */
2845 }
2846}
2847\f
2848
2849static Lisp_Object
2850exec_sentinel_unwind (data)
2851 Lisp_Object data;
2852{
2853 XPROCESS (XCONS (data)->car)->sentinel = XCONS (data)->cdr;
2854 return Qnil;
2855}
2856
2857static void
2858exec_sentinel (proc, reason)
2859 Lisp_Object proc, reason;
2860{
2861 Lisp_Object sentinel;
2862 register struct Lisp_Process *p = XPROCESS (proc);
2863 int count = specpdl_ptr - specpdl;
2864
2865 sentinel = p->sentinel;
2866 if (NILP (sentinel))
2867 return;
2868
2869 /* Zilch the sentinel while it's running, to avoid recursive invocations;
2870 assure that it gets restored no matter how the sentinel exits. */
2871 p->sentinel = Qnil;
2872 record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
2873 /* Inhibit quit so that random quits don't screw up a running filter. */
2874 specbind (Qinhibit_quit, Qt);
2875 call2 (sentinel, proc, reason);
2876 unbind_to (count);
2877}
2878
2879/* Report all recent events of a change in process status
2880 (either run the sentinel or output a message).
2881 This is done while Emacs is waiting for keyboard input. */
2882
2883status_notify ()
2884{
2885 register Lisp_Object proc, buffer;
2886 Lisp_Object tail = Qnil;
2887 Lisp_Object msg = Qnil;
2888 struct gcpro gcpro1, gcpro2;
2889
2890 /* We need to gcpro tail; if read_process_output calls a filter
2891 which deletes a process and removes the cons to which tail points
2892 from Vprocess_alist, and then causes a GC, tail is an unprotected
2893 reference. */
2894 GCPRO2 (tail, msg);
2895
2896 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
2897 {
2898 Lisp_Object symbol;
2899 register struct Lisp_Process *p;
2900
2901 proc = Fcdr (Fcar (tail));
2902 p = XPROCESS (proc);
2903
2904 if (XINT (p->tick) != XINT (p->update_tick))
2905 {
2906 XSETINT (p->update_tick, XINT (p->tick));
2907
2908 /* If process is still active, read any output that remains. */
2909 if (XFASTINT (p->infd))
2910 while (read_process_output (proc, XFASTINT (p->infd)) > 0);
2911
2912 buffer = p->buffer;
2913
2914 /* Get the text to use for the message. */
2915 if (!NILP (p->raw_status_low))
2916 update_status (p);
2917 msg = status_message (p->status);
2918
2919 /* If process is terminated, deactivate it or delete it. */
2920 symbol = p->status;
2921 if (XTYPE (p->status) == Lisp_Cons)
2922 symbol = XCONS (p->status)->car;
2923
2924 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
2925 || EQ (symbol, Qclosed))
2926 {
2927 if (delete_exited_processes)
2928 remove_process (proc);
2929 else
2930 deactivate_process (proc);
2931 }
2932
2933 /* Now output the message suitably. */
2934 if (!NILP (p->sentinel))
2935 exec_sentinel (proc, msg);
2936 /* Don't bother with a message in the buffer
2937 when a process becomes runnable. */
2938 else if (!EQ (symbol, Qrun) && !NILP (buffer))
2939 {
2940 Lisp_Object ro = XBUFFER (buffer)->read_only;
2941 Lisp_Object tem;
2942 struct buffer *old = current_buffer;
2943 int opoint;
2944
2945 /* Avoid error if buffer is deleted
2946 (probably that's why the process is dead, too) */
2947 if (NILP (XBUFFER (buffer)->name))
2948 continue;
2949 Fset_buffer (buffer);
2950 opoint = point;
2951 /* Insert new output into buffer
2952 at the current end-of-output marker,
2953 thus preserving logical ordering of input and output. */
2954 if (XMARKER (p->mark)->buffer)
2955 SET_PT (marker_position (p->mark));
2956 else
2957 SET_PT (ZV);
2958 if (point <= opoint)
2959 opoint += XSTRING (msg)->size + XSTRING (p->name)->size + 10;
2960
2961 tem = current_buffer->read_only;
2962 current_buffer->read_only = Qnil;
2963 insert_string ("\nProcess ");
2964 Finsert (1, &p->name);
2965 insert_string (" ");
2966 Finsert (1, &msg);
2967 current_buffer->read_only = tem;
2968 Fset_marker (p->mark, make_number (point), p->buffer);
2969
2970 SET_PT (opoint);
2971 set_buffer_internal (old);
2972 }
2973 }
2974 } /* end for */
2975
2976 update_mode_lines++; /* in case buffers use %s in mode-line-format */
2977 redisplay_preserve_echo_area ();
2978
2979 update_tick = process_tick;
2980
2981 UNGCPRO;
2982}
2983\f
2984init_process ()
2985{
2986 register int i;
2987
2988#ifdef SIGCHLD
2989#ifndef CANNOT_DUMP
2990 if (! noninteractive || initialized)
2991#endif
2992 signal (SIGCHLD, sigchld_handler);
2993#endif
2994
2995 FD_ZERO (&input_wait_mask);
2996 FD_SET (0, &input_wait_mask);
2997 Vprocess_alist = Qnil;
2998 for (i = 0; i < MAXDESC; i++)
2999 {
3000 chan_process[i] = Qnil;
3001 proc_buffered_char[i] = -1;
3002 }
3003}
08564963 3004#if 0
d0d6b7c5
JB
3005DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 0, 1, 0,
3006 "Return the connection type of `PROCESS'. This can be nil (pipe),\n\
3007t or pty (pty) or stream (socket connection).")
3008 (process)
3009 Lisp_Object process;
3010{
3011 return XPROCESS (process)->type;
3012}
3013#endif
3014syms_of_process ()
3015{
d0d6b7c5
JB
3016#ifdef HAVE_SOCKETS
3017 stream_process = intern ("stream");
3018#endif
3019 Qprocessp = intern ("processp");
3020 staticpro (&Qprocessp);
3021 Qrun = intern ("run");
3022 staticpro (&Qrun);
3023 Qstop = intern ("stop");
3024 staticpro (&Qstop);
3025 Qsignal = intern ("signal");
3026 staticpro (&Qsignal);
3027
3028 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
3029 here again.
3030
3031 Qexit = intern ("exit");
3032 staticpro (&Qexit); */
3033
3034 Qopen = intern ("open");
3035 staticpro (&Qopen);
3036 Qclosed = intern ("closed");
3037 staticpro (&Qclosed);
3038
3039 staticpro (&Vprocess_alist);
3040
3041 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
3042 "*Non-nil means delete processes immediately when they exit.\n\
3043nil means don't delete them until `list-processes' is run.");
3044
3045 delete_exited_processes = 1;
3046
3047 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
3048 "Control type of device used to communicate with subprocesses.\n\
3049Values are nil to use a pipe, and t or 'pty for a pty. Note that if\n\
3050pty's are not available, this variable will be ignored. The value takes\n\
3051effect when `start-process' is called.");
3052 Vprocess_connection_type = Qt;
3053
3054 defsubr (&Sprocessp);
3055 defsubr (&Sget_process);
3056 defsubr (&Sget_buffer_process);
3057 defsubr (&Sdelete_process);
3058 defsubr (&Sprocess_status);
3059 defsubr (&Sprocess_exit_status);
3060 defsubr (&Sprocess_id);
3061 defsubr (&Sprocess_name);
3062 defsubr (&Sprocess_command);
3063 defsubr (&Sset_process_buffer);
3064 defsubr (&Sprocess_buffer);
3065 defsubr (&Sprocess_mark);
3066 defsubr (&Sset_process_filter);
3067 defsubr (&Sprocess_filter);
3068 defsubr (&Sset_process_sentinel);
3069 defsubr (&Sprocess_sentinel);
3070 defsubr (&Sprocess_kill_without_query);
3071 defsubr (&Slist_processes);
3072 defsubr (&Sprocess_list);
3073 defsubr (&Sstart_process);
3074#ifdef HAVE_SOCKETS
3075 defsubr (&Sopen_network_stream);
3076#endif /* HAVE_SOCKETS */
3077 defsubr (&Saccept_process_output);
3078 defsubr (&Sprocess_send_region);
3079 defsubr (&Sprocess_send_string);
3080 defsubr (&Sinterrupt_process);
3081 defsubr (&Skill_process);
3082 defsubr (&Squit_process);
3083 defsubr (&Sstop_process);
3084 defsubr (&Scontinue_process);
3085 defsubr (&Sprocess_send_eof);
3086 defsubr (&Ssignal_process);
3087 defsubr (&Swaiting_for_user_input_p);
3088/* defsubr (&Sprocess_connection); */
3089}
3090
6720a7fb
JB
3091\f
3092#else /* not subprocesses */
3093
3094#include <sys/types.h>
3095#include <errno.h>
3096
3097#include "lisp.h"
3098#include "systime.h"
3099#include "termopts.h"
3100
ff11dfa1 3101extern int frame_garbaged;
6720a7fb
JB
3102
3103
3104/* As described above, except assuming that there are no subprocesses:
3105
3106 Wait for timeout to elapse and/or keyboard input to be available.
3107
3108 time_limit is:
3109 timeout in seconds, or
3110 zero for no limit, or
3111 -1 means gobble data immediately available but don't wait for any.
3112
f76475ad 3113 read_kbd is a Lisp_Object:
6720a7fb
JB
3114 0 to ignore keyboard input, or
3115 1 to return when input is available, or
3116 -1 means caller will actually read the input, so don't throw to
3117 the quit handler.
3118 We know that read_kbd will never be a Lisp_Process, since
3119 `subprocesses' isn't defined.
3120
3121 do_display != 0 means redisplay should be done to show subprocess
3122 output that arrives. This version of the function ignores it.
3123
eb8c3be9 3124 Return true iff we received input from any process. */
6720a7fb
JB
3125
3126int
3127wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
f76475ad
JB
3128 int time_limit, microsecs;
3129 Lisp_Object read_kbd;
3130 int do_display;
6720a7fb
JB
3131{
3132 EMACS_TIME end_time, timeout, *timeout_p;
3133 int waitchannels;
3134
3135 /* What does time_limit really mean? */
3136 if (time_limit || microsecs)
3137 {
3138 /* It's not infinite. */
3139 timeout_p = &timeout;
3140
3141 if (time_limit == -1)
3142 /* In fact, it's zero. */
3143 EMACS_SET_SECS_USECS (timeout, 0, 0);
3144 else
3145 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
3146
3147 /* How far in the future is that? */
3148 EMACS_GET_TIME (end_time);
3149 EMACS_ADD_TIME (end_time, end_time, timeout);
3150 }
3151 else
3152 /* It's infinite. */
3153 timeout_p = 0;
3154
3155 /* Turn off periodic alarms (in case they are in use)
3156 because the select emulator uses alarms. */
3157 stop_polling ();
3158
3159 for (;;)
3160 {
3161 int nfds;
3162
f76475ad 3163 waitchannels = XINT (read_kbd) ? 1 : 0;
6720a7fb
JB
3164
3165 /* If calling from keyboard input, do not quit
3166 since we want to return C-g as an input character.
3167 Otherwise, do pending quit if requested. */
f76475ad 3168 if (XINT (read_kbd) >= 0)
6720a7fb
JB
3169 QUIT;
3170
3171 if (timeout_p)
3172 {
3173 EMACS_GET_TIME (*timeout_p);
3174 EMACS_SUB_TIME (*timeout_p, end_time, *timeout_p);
3175 if (EMACS_TIME_NEG_P (*timeout_p))
3176 break;
3177 }
3178
3179 /* Cause C-g and alarm signals to take immediate action,
3180 and cause input available signals to zero out timeout. */
f76475ad 3181 if (XINT (read_kbd) < 0)
6720a7fb
JB
3182 set_waiting_for_input (&timeout);
3183
ff11dfa1 3184 /* If a frame has been newly mapped and needs updating,
6720a7fb 3185 reprocess its display stuff. */
ff11dfa1 3186 if (frame_garbaged)
6720a7fb
JB
3187 redisplay_preserve_echo_area ();
3188
f76475ad 3189 if (XINT (read_kbd) && detect_input_pending ())
6720a7fb
JB
3190 nfds = 0;
3191 else
3192 nfds = select (1, &waitchannels, 0, 0, timeout_p);
3193
3194 /* Make C-g and alarm signals set flags again */
3195 clear_waiting_for_input ();
3196
3197 /* If we woke up due to SIGWINCH, actually change size now. */
3198 do_pending_window_change ();
3199
3200 if (nfds == -1)
3201 {
3202 /* If the system call was interrupted, then go around the
3203 loop again. */
3204 if (errno == EINTR)
3205 waitchannels = 0;
3206 }
3207#ifdef sun
3208 else if (nfds > 0 && (waitchannels & 1) && interrupt_input)
3209 /* System sometimes fails to deliver SIGIO. */
3210 kill (getpid (), SIGIO);
3211#endif
f76475ad 3212 if (XINT (read_kbd) && interrupt_input && (waitchannels & 1))
6720a7fb
JB
3213 kill (0, SIGIO);
3214
3215 /* If we have timed out (nfds == 0) or found some input (nfds > 0),
3216 we should exit. */
3217 if (nfds >= 0)
3218 break;
3219 }
3220
a87b802f
JB
3221 start_polling ();
3222
6720a7fb
JB
3223 return 0;
3224}
3225
3226
3227DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
3228 "Return the (or, a) process associated with BUFFER.\n\
3229This copy of Emacs has not been built to support subprocesses, so this\n\
3230function always returns nil.")
3231 (name)
3232 register Lisp_Object name;
3233{
3234 return Qnil;
3235}
3236
3237/* Kill all processes associated with `buffer'.
3238 If `buffer' is nil, kill all processes.
3239 Since we have no subprocesses, this does nothing. */
3240
3241kill_buffer_processes (buffer)
3242 Lisp_Object buffer;
3243{
3244}
3245
3246init_process ()
3247{
3248}
3249
3250syms_of_process ()
3251{
3252 defsubr (&Sget_buffer_process);
3253}
3254
3255\f
3256#endif /* not subprocesses */