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