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