(show-paren-command-hook): Position show-paren-overlay-1
[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
JB
1698 addr_list[1] = 0;
1699 host_info.h_length = strlen (addr_list[0]);
1700 }
1701
1702 bzero (&address, sizeof address);
1703 bcopy (host_info_ptr->h_addr, (char *) &address.sin_addr,
1704 host_info_ptr->h_length);
1705 address.sin_family = host_info_ptr->h_addrtype;
1706 address.sin_port = port;
1707
1708 s = socket (host_info_ptr->h_addrtype, SOCK_STREAM, 0);
1709 if (s < 0)
1710 report_file_error ("error creating socket", Fcons (name, Qnil));
1711
457a9bee
RS
1712 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1713 when connect is interrupted. So let's not let it get interrupted.
1714 Note we do not turn off polling, because polling is only used
1715 when not interrupt_input, and thus not normally used on the systems
1716 which have this bug. On systems which use polling, there's no way
1717 to quit if polling is turned off. */
1718 if (interrupt_input)
1719 unrequest_sigio ();
1720
d0d6b7c5 1721 loop:
e333e864
RS
1722 if (connect (s, (struct sockaddr *) &address, sizeof address) == -1
1723 && errno != EISCONN)
d0d6b7c5
JB
1724 {
1725 int xerrno = errno;
e333e864 1726
d0d6b7c5
JB
1727 if (errno == EINTR)
1728 goto loop;
e333e864
RS
1729 if (errno == EADDRINUSE && retry < 20)
1730 {
4590788a
RS
1731 /* A delay here is needed on some FreeBSD systems,
1732 and it is harmless, since this retrying takes time anyway
1733 and should be infrequent. */
1734 Fsleep_for (make_number (1), Qnil);
e333e864
RS
1735 retry++;
1736 goto loop;
1737 }
1738
d0d6b7c5 1739 close (s);
457a9bee
RS
1740
1741 if (interrupt_input)
1742 request_sigio ();
1743
d0d6b7c5
JB
1744 errno = xerrno;
1745 report_file_error ("connection failed",
1746 Fcons (host, Fcons (name, Qnil)));
1747 }
457a9bee 1748
44ade2e9
RS
1749#ifdef POLL_FOR_INPUT
1750 unbind_to (count, Qnil);
1751#endif
1752
457a9bee
RS
1753 if (interrupt_input)
1754 request_sigio ();
1755
1d2c16fa
RS
1756#else /* TERM */
1757 s = connect_server (0);
1758 if (s < 0)
1759 report_file_error ("error creating socket", Fcons (name, Qnil));
1760 send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port));
1761 send_command (s, C_DUMB, 1, 0);
1762#endif /* TERM */
d0d6b7c5
JB
1763
1764 inch = s;
1765 outch = dup (s);
1766 if (outch < 0)
1767 report_file_error ("error duplicating socket", Fcons (name, Qnil));
1768
1769 if (!NILP (buffer))
1770 buffer = Fget_buffer_create (buffer);
1771 proc = make_process (name);
1772
1773 chan_process[inch] = proc;
1774
1775#ifdef O_NONBLOCK
1776 fcntl (inch, F_SETFL, O_NONBLOCK);
1777#else
1778#ifdef O_NDELAY
1779 fcntl (inch, F_SETFL, O_NDELAY);
1780#endif
1781#endif
1782
1783 XPROCESS (proc)->childp = host;
1784 XPROCESS (proc)->command_channel_p = Qnil;
1785 XPROCESS (proc)->buffer = buffer;
1786 XPROCESS (proc)->sentinel = Qnil;
1787 XPROCESS (proc)->filter = Qnil;
1788 XPROCESS (proc)->command = Qnil;
1789 XPROCESS (proc)->pid = Qnil;
1d056e64
KH
1790 XSETINT (XPROCESS (proc)->infd, s);
1791 XSETINT (XPROCESS (proc)->outfd, outch);
d0d6b7c5
JB
1792 XPROCESS (proc)->status = Qrun;
1793 FD_SET (inch, &input_wait_mask);
a69281ff 1794 FD_SET (inch, &non_keyboard_wait_mask);
7d0e672e
RS
1795 if (inch > max_process_desc)
1796 max_process_desc = inch;
d0d6b7c5
JB
1797
1798 UNGCPRO;
1799 return proc;
1800}
1801#endif /* HAVE_SOCKETS */
1802
1803deactivate_process (proc)
1804 Lisp_Object proc;
1805{
1806 register int inchannel, outchannel;
1807 register struct Lisp_Process *p = XPROCESS (proc);
1808
a9f2c884
RS
1809 inchannel = XINT (p->infd);
1810 outchannel = XINT (p->outfd);
d0d6b7c5 1811
a9f2c884 1812 if (inchannel >= 0)
d0d6b7c5
JB
1813 {
1814 /* Beware SIGCHLD hereabouts. */
1815 flush_pending_output (inchannel);
1816#ifdef VMS
1817 {
1818 VMS_PROC_STUFF *get_vms_process_pointer (), *vs;
1819 sys$dassgn (outchannel);
c6c6865d 1820 vs = get_vms_process_pointer (p->pid);
d0d6b7c5
JB
1821 if (vs)
1822 give_back_vms_process_stuff (vs);
1823 }
1824#else
1825 close (inchannel);
a9f2c884 1826 if (outchannel >= 0 && outchannel != inchannel)
d0d6b7c5
JB
1827 close (outchannel);
1828#endif
1829
1d056e64
KH
1830 XSETINT (p->infd, -1);
1831 XSETINT (p->outfd, -1);
d0d6b7c5
JB
1832 chan_process[inchannel] = Qnil;
1833 FD_CLR (inchannel, &input_wait_mask);
a69281ff 1834 FD_CLR (inchannel, &non_keyboard_wait_mask);
7d0e672e
RS
1835 if (inchannel == max_process_desc)
1836 {
1837 int i;
1838 /* We just closed the highest-numbered process input descriptor,
1839 so recompute the highest-numbered one now. */
1840 max_process_desc = 0;
1841 for (i = 0; i < MAXDESC; i++)
1842 if (!NILP (chan_process[i]))
1843 max_process_desc = i;
1844 }
d0d6b7c5
JB
1845 }
1846}
1847
1848/* Close all descriptors currently in use for communication
1849 with subprocess. This is used in a newly-forked subprocess
1850 to get rid of irrelevant descriptors. */
1851
1852close_process_descs ()
1853{
e98d950b 1854#ifndef WINDOWSNT
d0d6b7c5
JB
1855 int i;
1856 for (i = 0; i < MAXDESC; i++)
1857 {
1858 Lisp_Object process;
1859 process = chan_process[i];
1860 if (!NILP (process))
1861 {
a9f2c884
RS
1862 int in = XINT (XPROCESS (process)->infd);
1863 int out = XINT (XPROCESS (process)->outfd);
1864 if (in >= 0)
d0d6b7c5 1865 close (in);
a9f2c884 1866 if (out >= 0 && in != out)
d0d6b7c5
JB
1867 close (out);
1868 }
1869 }
e98d950b 1870#endif
d0d6b7c5
JB
1871}
1872\f
1873DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
1874 0, 3, 0,
1875 "Allow any pending output from subprocesses to be read by Emacs.\n\
1876It is read into the process' buffers or given to their filter functions.\n\
1877Non-nil arg PROCESS means do not return until some output has been received\n\
1878from PROCESS.\n\
1879Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\
1880seconds and microseconds to wait; return after that much time whether\n\
1881or not there is input.\n\
1882Return non-nil iff we received any output before the timeout expired.")
4ee3e309
EN
1883 (process, timeout, timeout_msecs)
1884 register Lisp_Object process, timeout, timeout_msecs;
d0d6b7c5
JB
1885{
1886 int seconds;
1887 int useconds;
1888
1889 if (! NILP (timeout_msecs))
1890 {
1891 CHECK_NUMBER (timeout_msecs, 2);
1892 useconds = XINT (timeout_msecs);
bcd69aea 1893 if (!INTEGERP (timeout))
1d056e64 1894 XSETINT (timeout, 0);
d0d6b7c5
JB
1895
1896 {
1897 int carry = useconds / 1000000;
1898
1899 XSETINT (timeout, XINT (timeout) + carry);
1900 useconds -= carry * 1000000;
1901
1902 /* I think this clause is necessary because C doesn't
1903 guarantee a particular rounding direction for negative
1904 integers. */
1905 if (useconds < 0)
1906 {
1907 XSETINT (timeout, XINT (timeout) - 1);
1908 useconds += 1000000;
1909 }
1910 }
1911 }
de946e5a
RS
1912 else
1913 useconds = 0;
d0d6b7c5
JB
1914
1915 if (! NILP (timeout))
1916 {
1917 CHECK_NUMBER (timeout, 1);
1918 seconds = XINT (timeout);
1919 if (seconds <= 0)
1920 seconds = -1;
1921 }
1922 else
1923 {
4ee3e309 1924 if (NILP (process))
d0d6b7c5
JB
1925 seconds = -1;
1926 else
1927 seconds = 0;
1928 }
1929
4ee3e309
EN
1930 if (NILP (process))
1931 XSETFASTINT (process, 0);
f76475ad 1932
d0d6b7c5 1933 return
4ee3e309 1934 (wait_reading_process_input (seconds, useconds, process, 0)
d0d6b7c5
JB
1935 ? Qt : Qnil);
1936}
1937
1938/* This variable is different from waiting_for_input in keyboard.c.
1939 It is used to communicate to a lisp process-filter/sentinel (via the
1940 function Fwaiting_for_user_input_p below) whether emacs was waiting
1941 for user-input when that process-filter was called.
1942 waiting_for_input cannot be used as that is by definition 0 when
d430ee71
RS
1943 lisp code is being evalled.
1944 This is also used in record_asynch_buffer_change.
1945 For that purpose, this must be 0
1946 when not inside wait_reading_process_input. */
d0d6b7c5
JB
1947static int waiting_for_user_input_p;
1948
1949/* Read and dispose of subprocess output while waiting for timeout to
1950 elapse and/or keyboard input to be available.
1951
de6fd4b9 1952 TIME_LIMIT is:
d0d6b7c5
JB
1953 timeout in seconds, or
1954 zero for no limit, or
1955 -1 means gobble data immediately available but don't wait for any.
1956
de6fd4b9
RS
1957 MICROSECS is:
1958 an additional duration to wait, measured in microseconds.
1959 If this is nonzero and time_limit is 0, then the timeout
1960 consists of MICROSECS only.
6e4f3667 1961
de6fd4b9 1962 READ_KBD is a lisp value:
d0d6b7c5
JB
1963 0 to ignore keyboard input, or
1964 1 to return when input is available, or
84aa3ace 1965 -1 meaning caller will actually read the input, so don't throw to
d0d6b7c5 1966 the quit handler, or
e6194ffc 1967 a cons cell, meaning wait until its car is non-nil
de6fd4b9 1968 (and gobble terminal input into the buffer if any arrives), or
f76475ad
JB
1969 a process object, meaning wait until something arrives from that
1970 process. The return value is true iff we read some input from
1971 that process.
d0d6b7c5 1972
de6fd4b9 1973 DO_DISPLAY != 0 means redisplay should be done to show subprocess
d0d6b7c5
JB
1974 output that arrives.
1975
de6fd4b9 1976 If READ_KBD is a pointer to a struct Lisp_Process, then the
d0d6b7c5
JB
1977 function returns true iff we received input from that process
1978 before the timeout elapsed.
eb8c3be9 1979 Otherwise, return true iff we received input from any process. */
d0d6b7c5
JB
1980
1981wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
f76475ad
JB
1982 int time_limit, microsecs;
1983 Lisp_Object read_kbd;
1984 int do_display;
d0d6b7c5
JB
1985{
1986 register int channel, nfds, m;
1987 static SELECT_TYPE Available;
1988 int xerrno;
1989 Lisp_Object proc;
1990 EMACS_TIME timeout, end_time, garbage;
1991 SELECT_TYPE Atemp;
a9f2c884 1992 int wait_channel = -1;
d0d6b7c5
JB
1993 struct Lisp_Process *wait_proc = 0;
1994 int got_some_input = 0;
84aa3ace 1995 Lisp_Object *wait_for_cell = 0;
d0d6b7c5
JB
1996
1997 FD_ZERO (&Available);
1998
f76475ad
JB
1999 /* If read_kbd is a process to watch, set wait_proc and wait_channel
2000 accordingly. */
bcd69aea 2001 if (PROCESSP (read_kbd))
d0d6b7c5 2002 {
f76475ad 2003 wait_proc = XPROCESS (read_kbd);
a9f2c884 2004 wait_channel = XINT (wait_proc->infd);
22719df2 2005 XSETFASTINT (read_kbd, 0);
d0d6b7c5
JB
2006 }
2007
84aa3ace 2008 /* If waiting for non-nil in a cell, record where. */
bcd69aea 2009 if (CONSP (read_kbd))
84aa3ace
RS
2010 {
2011 wait_for_cell = &XCONS (read_kbd)->car;
22719df2 2012 XSETFASTINT (read_kbd, 0);
84aa3ace
RS
2013 }
2014
f76475ad 2015 waiting_for_user_input_p = XINT (read_kbd);
d0d6b7c5
JB
2016
2017 /* Since we may need to wait several times,
2018 compute the absolute time to return at. */
2019 if (time_limit || microsecs)
2020 {
2021 EMACS_GET_TIME (end_time);
2022 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
2023 EMACS_ADD_TIME (end_time, end_time, timeout);
2024 }
2025
d0d6b7c5
JB
2026 while (1)
2027 {
c0239a0b
RS
2028 int timeout_reduced_for_timers = 0;
2029
d0d6b7c5
JB
2030 /* If calling from keyboard input, do not quit
2031 since we want to return C-g as an input character.
2032 Otherwise, do pending quit if requested. */
f76475ad 2033 if (XINT (read_kbd) >= 0)
d0d6b7c5
JB
2034 QUIT;
2035
889255b4
RS
2036 /* Exit now if the cell we're waiting for became non-nil. */
2037 if (wait_for_cell && ! NILP (*wait_for_cell))
2038 break;
2039
d0d6b7c5
JB
2040 /* Compute time from now till when time limit is up */
2041 /* Exit if already run out */
2042 if (time_limit == -1)
2043 {
2044 /* -1 specified for timeout means
2045 gobble output available now
2046 but don't wait at all. */
2047
2048 EMACS_SET_SECS_USECS (timeout, 0, 0);
2049 }
2050 else if (time_limit || microsecs)
2051 {
2052 EMACS_GET_TIME (timeout);
2053 EMACS_SUB_TIME (timeout, end_time, timeout);
2054 if (EMACS_TIME_NEG_P (timeout))
2055 break;
2056 }
2057 else
2058 {
2059 EMACS_SET_SECS_USECS (timeout, 100000, 0);
2060 }
2061
fb4c3627
RS
2062 /* If our caller will not immediately handle keyboard events,
2063 run timer events directly.
2064 (Callers that will immediately read keyboard events
2065 call timer_delay on their own.) */
2066 if (read_kbd >= 0)
2067 {
c0239a0b
RS
2068 EMACS_TIME timer_delay;
2069 timer_delay = timer_check (1);
2070 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
fb4c3627
RS
2071 {
2072 EMACS_TIME difference;
2073 EMACS_SUB_TIME (difference, timer_delay, timeout);
2074 if (EMACS_TIME_NEG_P (difference))
c0239a0b
RS
2075 {
2076 timeout = timer_delay;
2077 timeout_reduced_for_timers = 1;
2078 }
fb4c3627
RS
2079 }
2080 }
2081
90ab1a81
JB
2082 /* Cause C-g and alarm signals to take immediate action,
2083 and cause input available signals to zero out timeout.
2084
2085 It is important that we do this before checking for process
2086 activity. If we get a SIGCHLD after the explicit checks for
2087 process activity, timeout is the only way we will know. */
2088 if (XINT (read_kbd) < 0)
2089 set_waiting_for_input (&timeout);
2090
6be429b1
JB
2091 /* If status of something has changed, and no input is
2092 available, notify the user of the change right away. After
2093 this explicit check, we'll let the SIGCHLD handler zap
2094 timeout to get our attention. */
2095 if (update_tick != process_tick && do_display)
2096 {
2097 Atemp = input_wait_mask;
2098 EMACS_SET_SECS_USECS (timeout, 0, 0);
ecd1f654
KH
2099 if ((select (MAXDESC, &Atemp, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
2100 &timeout)
2101 <= 0))
90ab1a81
JB
2102 {
2103 /* It's okay for us to do this and then continue with
a0e4d3f3 2104 the loop, since timeout has already been zeroed out. */
90ab1a81
JB
2105 clear_waiting_for_input ();
2106 status_notify ();
2107 }
6be429b1
JB
2108 }
2109
2110 /* Don't wait for output from a non-running process. */
2111 if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
2112 update_status (wait_proc);
2113 if (wait_proc != 0
2114 && ! EQ (wait_proc->status, Qrun))
9aa2a7f4
JB
2115 {
2116 clear_waiting_for_input ();
2117 break;
2118 }
6be429b1 2119
d0d6b7c5
JB
2120 /* Wait till there is something to do */
2121
5e7e1da2 2122 if (! XINT (read_kbd) && wait_for_cell == 0)
a69281ff
RS
2123 Available = non_keyboard_wait_mask;
2124 else
2125 Available = input_wait_mask;
d0d6b7c5 2126
ff11dfa1 2127 /* If frame size has changed or the window is newly mapped,
ffd56f97
JB
2128 redisplay now, before we start to wait. There is a race
2129 condition here; if a SIGIO arrives between now and the select
016899c0
JB
2130 and indicates that a frame is trashed, the select may block
2131 displaying a trashed screen. */
5164ee8e 2132 if (frame_garbaged && do_display)
7286affd
RS
2133 {
2134 clear_waiting_for_input ();
2135 redisplay_preserve_echo_area ();
2136 if (XINT (read_kbd) < 0)
7efe788e 2137 set_waiting_for_input (&timeout);
7286affd 2138 }
ffd56f97 2139
f76475ad 2140 if (XINT (read_kbd) && detect_input_pending ())
a9f2c884
RS
2141 {
2142 nfds = 0;
2143 FD_ZERO (&Available);
2144 }
d0d6b7c5 2145 else
ecd1f654
KH
2146 nfds = select (MAXDESC, &Available, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
2147 &timeout);
6720a7fb 2148
d0d6b7c5
JB
2149 xerrno = errno;
2150
2151 /* Make C-g and alarm signals set flags again */
2152 clear_waiting_for_input ();
2153
2154 /* If we woke up due to SIGWINCH, actually change size now. */
2155 do_pending_window_change ();
2156
c0239a0b
RS
2157 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
2158 /* We wanted the full specified time, so return now. */
d0d6b7c5
JB
2159 break;
2160 if (nfds < 0)
2161 {
2162 if (xerrno == EINTR)
2163 FD_ZERO (&Available);
b0310da4
JB
2164#ifdef ultrix
2165 /* Ultrix select seems to return ENOMEM when it is
2166 interrupted. Treat it just like EINTR. Bleah. Note
2167 that we want to test for the "ultrix" CPP symbol, not
2168 "__ultrix__"; the latter is only defined under GCC, but
2169 not by DEC's bundled CC. -JimB */
8058415c
JB
2170 else if (xerrno == ENOMEM)
2171 FD_ZERO (&Available);
2172#endif
d0d6b7c5
JB
2173#ifdef ALLIANT
2174 /* This happens for no known reason on ALLIANT.
2175 I am guessing that this is the right response. -- RMS. */
2176 else if (xerrno == EFAULT)
2177 FD_ZERO (&Available);
2178#endif
2179 else if (xerrno == EBADF)
2180 {
2181#ifdef AIX
2182 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
2183 the child's closure of the pts gives the parent a SIGHUP, and
2184 the ptc file descriptor is automatically closed,
2185 yielding EBADF here or at select() call above.
2186 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
a0e4d3f3 2187 in m/ibmrt-aix.h), and here we just ignore the select error.
d0d6b7c5 2188 Cleanup occurs c/o status_notify after SIGCLD. */
ffd56f97 2189 FD_ZERO (&Available); /* Cannot depend on values returned */
d0d6b7c5
JB
2190#else
2191 abort ();
2192#endif
2193 }
2194 else
b062d1fe 2195 error("select error: %s", strerror (xerrno));
d0d6b7c5 2196 }
26ec91de 2197#if defined(sun) && !defined(USG5_4)
a69281ff 2198 else if (nfds > 0 && keyboard_bit_set (&Available)
dd2281ae 2199 && interrupt_input)
e0109153
JB
2200 /* System sometimes fails to deliver SIGIO.
2201
2202 David J. Mackenzie says that Emacs doesn't compile under
2203 Solaris if this code is enabled, thus the USG5_4 in the CPP
2204 conditional. "I haven't noticed any ill effects so far.
2205 If you find a Solaris expert somewhere, they might know
2206 better." */
d0d6b7c5
JB
2207 kill (getpid (), SIGIO);
2208#endif
2209
2210 /* Check for keyboard input */
2211 /* If there is any, return immediately
2212 to give it higher priority than subprocesses */
2213
e6194ffc 2214 /* We used to do this if wait_for_cell,
6cbc22ed 2215 but that caused infinite recursion in selection request events. */
5e7e1da2 2216 if ((XINT (read_kbd) || wait_for_cell)
97f3b3d6 2217 && detect_input_pending ())
6e103bac
RS
2218 {
2219 swallow_events ();
2220 if (detect_input_pending ())
2221 break;
2222 }
d0d6b7c5 2223
84aa3ace
RS
2224 /* Exit now if the cell we're waiting for became non-nil. */
2225 if (wait_for_cell && ! NILP (*wait_for_cell))
2226 break;
2227
4746118a 2228#ifdef SIGIO
d0d6b7c5
JB
2229 /* If we think we have keyboard input waiting, but didn't get SIGIO
2230 go read it. This can happen with X on BSD after logging out.
2231 In that case, there really is no input and no SIGIO,
2232 but select says there is input. */
2233
dd2281ae 2234 if (XINT (read_kbd) && interrupt_input
a69281ff 2235 && (keyboard_bit_set (&Available)))
d0d6b7c5 2236 kill (0, SIGIO);
4746118a 2237#endif
d0d6b7c5 2238
d0d6b7c5
JB
2239 if (! wait_proc)
2240 got_some_input |= nfds > 0;
2241
32676c08
JB
2242 /* If checking input just got us a size-change event from X,
2243 obey it now if we should. */
97f3b3d6 2244 if (XINT (read_kbd) || wait_for_cell)
32676c08
JB
2245 do_pending_window_change ();
2246
a9f2c884
RS
2247 /* Check for data from a process. */
2248 /* Really FIRST_PROC_DESC should be 0 on Unix,
2249 but this is safer in the short run. */
a69281ff 2250 for (channel = 0; channel <= max_process_desc; channel++)
d0d6b7c5 2251 {
a69281ff
RS
2252 if (FD_ISSET (channel, &Available)
2253 && FD_ISSET (channel, &non_keyboard_wait_mask))
d0d6b7c5
JB
2254 {
2255 int nread;
2256
2257 /* If waiting for this channel, arrange to return as
2258 soon as no more input to be processed. No more
2259 waiting. */
2260 if (wait_channel == channel)
2261 {
a9f2c884 2262 wait_channel = -1;
d0d6b7c5
JB
2263 time_limit = -1;
2264 got_some_input = 1;
2265 }
2266 proc = chan_process[channel];
2267 if (NILP (proc))
2268 continue;
2269
d0d6b7c5
JB
2270 /* Read data from the process, starting with our
2271 buffered-ahead character if we have one. */
2272
2273 nread = read_process_output (proc, channel);
2274 if (nread > 0)
2275 {
2276 /* Since read_process_output can run a filter,
2277 which can call accept-process-output,
2278 don't try to read from any other processes
2279 before doing the select again. */
2280 FD_ZERO (&Available);
2281
2282 if (do_display)
2283 redisplay_preserve_echo_area ();
2284 }
2285#ifdef EWOULDBLOCK
2286 else if (nread == -1 && errno == EWOULDBLOCK)
2287 ;
2288#else
2289#ifdef O_NONBLOCK
2290 else if (nread == -1 && errno == EAGAIN)
2291 ;
2292#else
2293#ifdef O_NDELAY
2294 else if (nread == -1 && errno == EAGAIN)
2295 ;
2296 /* Note that we cannot distinguish between no input
2297 available now and a closed pipe.
2298 With luck, a closed pipe will be accompanied by
2299 subprocess termination and SIGCHLD. */
2300 else if (nread == 0 && !NETCONN_P (proc))
2301 ;
ffd56f97
JB
2302#endif /* O_NDELAY */
2303#endif /* O_NONBLOCK */
2304#endif /* EWOULDBLOCK */
d0d6b7c5
JB
2305#ifdef HAVE_PTYS
2306 /* On some OSs with ptys, when the process on one end of
2307 a pty exits, the other end gets an error reading with
2308 errno = EIO instead of getting an EOF (0 bytes read).
2309 Therefore, if we get an error reading and errno =
2310 EIO, just continue, because the child process has
2311 exited and should clean itself up soon (e.g. when we
2312 get a SIGCHLD). */
2313 else if (nread == -1 && errno == EIO)
2314 ;
ffd56f97
JB
2315#endif /* HAVE_PTYS */
2316 /* If we can detect process termination, don't consider the process
2317 gone just because its pipe is closed. */
d0d6b7c5
JB
2318#ifdef SIGCHLD
2319 else if (nread == 0 && !NETCONN_P (proc))
2320 ;
2321#endif
2322 else
2323 {
2324 /* Preserve status of processes already terminated. */
2325 XSETINT (XPROCESS (proc)->tick, ++process_tick);
2326 deactivate_process (proc);
2327 if (!NILP (XPROCESS (proc)->raw_status_low))
2328 update_status (XPROCESS (proc));
2329 if (EQ (XPROCESS (proc)->status, Qrun))
2330 XPROCESS (proc)->status
2331 = Fcons (Qexit, Fcons (make_number (256), Qnil));
2332 }
2333 }
ffd56f97
JB
2334 } /* end for each file descriptor */
2335 } /* end while exit conditions not met */
d0d6b7c5 2336
d430ee71
RS
2337 waiting_for_user_input_p = 0;
2338
ffd56f97
JB
2339 /* If calling from keyboard input, do not quit
2340 since we want to return C-g as an input character.
2341 Otherwise, do pending quit if requested. */
f76475ad 2342 if (XINT (read_kbd) >= 0)
ffd56f97
JB
2343 {
2344 /* Prevent input_pending from remaining set if we quit. */
2345 clear_input_pending ();
2346 QUIT;
2347 }
d0d6b7c5
JB
2348
2349 return got_some_input;
2350}
2351\f
3b9a3dfa
RS
2352/* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
2353
2354static Lisp_Object
2355read_process_output_call (fun_and_args)
2356 Lisp_Object fun_and_args;
2357{
2358 return apply1 (XCONS (fun_and_args)->car, XCONS (fun_and_args)->cdr);
2359}
2360
2361static Lisp_Object
2362read_process_output_error_handler (error)
2363 Lisp_Object error;
2364{
2365 cmd_error_internal (error, "error in process filter: ");
2366 Vinhibit_quit = Qt;
2367 update_echo_area ();
833ba342 2368 Fsleep_for (make_number (2), Qnil);
3b9a3dfa
RS
2369}
2370
d0d6b7c5
JB
2371/* Read pending output from the process channel,
2372 starting with our buffered-ahead character if we have one.
2373 Yield number of characters read.
2374
2375 This function reads at most 1024 characters.
2376 If you want to read all available subprocess output,
2377 you must call it repeatedly until it returns zero. */
2378
2379read_process_output (proc, channel)
2380 Lisp_Object proc;
2381 register int channel;
2382{
2383 register int nchars;
2384#ifdef VMS
2385 char *chars;
2386#else
2387 char chars[1024];
2388#endif
2389 register Lisp_Object outstream;
2390 register struct buffer *old = current_buffer;
2391 register struct Lisp_Process *p = XPROCESS (proc);
2392 register int opoint;
2393
2394#ifdef VMS
2395 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
2396
2397 vs = get_vms_process_pointer (p->pid);
2398 if (vs)
2399 {
2400 if (!vs->iosb[0])
2401 return(0); /* Really weird if it does this */
2402 if (!(vs->iosb[0] & 1))
2403 return -1; /* I/O error */
2404 }
2405 else
2406 error ("Could not get VMS process pointer");
2407 chars = vs->inputBuffer;
2408 nchars = clean_vms_buffer (chars, vs->iosb[1]);
2409 if (nchars <= 0)
2410 {
2411 start_vms_process_read (vs); /* Crank up the next read on the process */
2412 return 1; /* Nothing worth printing, say we got 1 */
2413 }
2414#else /* not VMS */
2415
2416 if (proc_buffered_char[channel] < 0)
e98d950b
RS
2417#ifdef WINDOWSNT
2418 nchars = read_child_output (channel, chars, sizeof (chars));
2419#else
d0d6b7c5 2420 nchars = read (channel, chars, sizeof chars);
e98d950b 2421#endif
d0d6b7c5
JB
2422 else
2423 {
2424 chars[0] = proc_buffered_char[channel];
2425 proc_buffered_char[channel] = -1;
e98d950b
RS
2426#ifdef WINDOWSNT
2427 nchars = read_child_output (channel, chars + 1, sizeof (chars) - 1);
2428#else
d0d6b7c5 2429 nchars = read (channel, chars + 1, sizeof chars - 1);
e98d950b 2430#endif
d0d6b7c5
JB
2431 if (nchars < 0)
2432 nchars = 1;
2433 else
2434 nchars = nchars + 1;
2435 }
2436#endif /* not VMS */
2437
2438 if (nchars <= 0) return nchars;
2439
2440 outstream = p->filter;
2441 if (!NILP (outstream))
2442 {
2443 /* We inhibit quit here instead of just catching it so that
2444 hitting ^G when a filter happens to be running won't screw
2445 it up. */
2446 int count = specpdl_ptr - specpdl;
30c78175 2447 Lisp_Object odeactivate;
dfc21838 2448 Lisp_Object obuffer, okeymap;
30c78175 2449
dfc21838
RS
2450 /* No need to gcpro these, because all we do with them later
2451 is test them for EQness, and none of them should be a string. */
30c78175 2452 odeactivate = Vdeactivate_mark;
dfc21838
RS
2453 XSETBUFFER (obuffer, current_buffer);
2454 okeymap = current_buffer->keymap;
30c78175 2455
d0d6b7c5 2456 specbind (Qinhibit_quit, Qt);
6545aada 2457 specbind (Qlast_nonmenu_event, Qt);
3b9a3dfa 2458
7074fde6 2459 running_asynch_code = 1;
3b9a3dfa
RS
2460 internal_condition_case_1 (read_process_output_call,
2461 Fcons (outstream,
2462 Fcons (proc,
7074fde6
FP
2463 Fcons (make_string (chars,
2464 nchars),
3b9a3dfa
RS
2465 Qnil))),
2466 !NILP (Vdebug_on_error) ? Qnil : Qerror,
2467 read_process_output_error_handler);
7074fde6
FP
2468 running_asynch_code = 0;
2469 restore_match_data ();
d0d6b7c5 2470
592ce97f 2471 /* Handling the process output should not deactivate the mark. */
30c78175
RS
2472 Vdeactivate_mark = odeactivate;
2473
7973cfa8
RS
2474#if 0 /* Call record_asynch_buffer_change unconditionally,
2475 because we might have changed minor modes or other things
2476 that affect key bindings. */
dfc21838
RS
2477 if (! EQ (Fcurrent_buffer (), obuffer)
2478 || ! EQ (current_buffer->keymap, okeymap))
7973cfa8 2479#endif
927e08be
RS
2480 /* But do it only if the caller is actually going to read events.
2481 Otherwise there's no need to make him wake up, and it could
2482 cause trouble (for example it would make Fsit_for return). */
2483 if (waiting_for_user_input_p == -1)
2484 record_asynch_buffer_change ();
d72534ba 2485
d0d6b7c5
JB
2486#ifdef VMS
2487 start_vms_process_read (vs);
2488#endif
2ea6d561 2489 unbind_to (count, Qnil);
d0d6b7c5
JB
2490 return nchars;
2491 }
2492
2493 /* If no filter, write into buffer if it isn't dead. */
2494 if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
2495 {
b0310da4
JB
2496 Lisp_Object old_read_only;
2497 Lisp_Object old_begv, old_zv;
30c78175
RS
2498 Lisp_Object odeactivate;
2499
2500 odeactivate = Vdeactivate_mark;
d0d6b7c5
JB
2501
2502 Fset_buffer (p->buffer);
2503 opoint = point;
b0310da4 2504 old_read_only = current_buffer->read_only;
22719df2
KH
2505 XSETFASTINT (old_begv, BEGV);
2506 XSETFASTINT (old_zv, ZV);
b0310da4
JB
2507
2508 current_buffer->read_only = Qnil;
d0d6b7c5
JB
2509
2510 /* Insert new output into buffer
2511 at the current end-of-output marker,
2512 thus preserving logical ordering of input and output. */
2513 if (XMARKER (p->mark)->buffer)
53aad33f 2514 SET_PT (clip_to_bounds (BEGV, marker_position (p->mark), ZV));
d0d6b7c5
JB
2515 else
2516 SET_PT (ZV);
b0310da4
JB
2517
2518 /* If the output marker is outside of the visible region, save
2519 the restriction and widen. */
2520 if (! (BEGV <= point && point <= ZV))
2521 Fwiden ();
2522
2523 /* Make sure opoint floats ahead of any new text, just as point
2524 would. */
d0d6b7c5
JB
2525 if (point <= opoint)
2526 opoint += nchars;
2527
b0310da4
JB
2528 /* Insert after old_begv, but before old_zv. */
2529 if (point < XFASTINT (old_begv))
7c6f34f0 2530 XSETFASTINT (old_begv, XFASTINT (old_begv) + nchars);
b0310da4 2531 if (point <= XFASTINT (old_zv))
7c6f34f0 2532 XSETFASTINT (old_zv, XFASTINT (old_zv) + nchars);
b0310da4 2533
d0d6b7c5
JB
2534 /* Insert before markers in case we are inserting where
2535 the buffer's mark is, and the user's next command is Meta-y. */
2536 insert_before_markers (chars, nchars);
d0d6b7c5 2537 Fset_marker (p->mark, make_number (point), p->buffer);
b0310da4 2538
d0d6b7c5
JB
2539 update_mode_lines++;
2540
b0310da4
JB
2541 /* If the restriction isn't what it should be, set it. */
2542 if (XFASTINT (old_begv) != BEGV || XFASTINT (old_zv) != ZV)
2543 Fnarrow_to_region (old_begv, old_zv);
2544
592ce97f 2545 /* Handling the process output should not deactivate the mark. */
30c78175
RS
2546 Vdeactivate_mark = odeactivate;
2547
b0310da4 2548 current_buffer->read_only = old_read_only;
d0d6b7c5
JB
2549 SET_PT (opoint);
2550 set_buffer_internal (old);
2551 }
2552#ifdef VMS
2553 start_vms_process_read (vs);
2554#endif
2555 return nchars;
2556}
2557
2558DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
2559 0, 0, 0,
8b4d685f 2560 "Returns non-nil if emacs is waiting for input from the user.\n\
d0d6b7c5
JB
2561This is intended for use by asynchronous process output filters and sentinels.")
2562 ()
2563{
8b4d685f 2564 return (waiting_for_user_input_p ? Qt : Qnil);
d0d6b7c5
JB
2565}
2566\f
2567/* Sending data to subprocess */
2568
2569jmp_buf send_process_frame;
2570
2571SIGTYPE
2572send_process_trap ()
2573{
2574#ifdef BSD4_1
2575 sigrelse (SIGPIPE);
2576 sigrelse (SIGALRM);
2577#endif /* BSD4_1 */
2578 longjmp (send_process_frame, 1);
2579}
2580
4556b700
RS
2581/* Send some data to process PROC.
2582 BUF is the beginning of the data; LEN is the number of characters.
2583 OBJECT is the Lisp object that the data comes from. */
2584
2585send_process (proc, buf, len, object)
ecd1f654 2586 volatile Lisp_Object proc;
d0d6b7c5
JB
2587 char *buf;
2588 int len;
4556b700 2589 Lisp_Object object;
d0d6b7c5 2590{
ecd1f654 2591 /* Use volatile to protect variables from being clobbered by longjmp. */
d0d6b7c5 2592 int rv;
ecd1f654 2593 volatile unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
d0d6b7c5 2594
d0d6b7c5
JB
2595#ifdef VMS
2596 struct Lisp_Process *p = XPROCESS (proc);
2597 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
2598#endif /* VMS */
2599
2600 if (! NILP (XPROCESS (proc)->raw_status_low))
2601 update_status (XPROCESS (proc));
2602 if (! EQ (XPROCESS (proc)->status, Qrun))
2603 error ("Process %s not running", procname);
2604
2605#ifdef VMS
2606 vs = get_vms_process_pointer (p->pid);
2607 if (vs == 0)
2608 error ("Could not find this process: %x", p->pid);
2609 else if (write_to_vms_process (vs, buf, len))
2610 ;
2611#else
4556b700
RS
2612
2613 if (pty_max_bytes == 0)
2614 {
2615#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
2616 pty_max_bytes = fpathconf (XFASTINT (XPROCESS (proc)->outfd),
2617 _PC_MAX_CANON);
2618 if (pty_max_bytes < 0)
2619 pty_max_bytes = 250;
2620#else
2621 pty_max_bytes = 250;
2622#endif
2623 /* Deduct one, to leave space for the eof. */
2624 pty_max_bytes--;
2625 }
2626
d0d6b7c5
JB
2627 if (!setjmp (send_process_frame))
2628 while (len > 0)
2629 {
2630 int this = len;
4746118a 2631 SIGTYPE (*old_sigpipe)();
93b4f699
RS
2632 int flush_pty = 0;
2633
4556b700
RS
2634 /* Decide how much data we can send in one batch.
2635 Long lines need to be split into multiple batches. */
2636 if (!NILP (XPROCESS (proc)->pty_flag))
93b4f699 2637 {
4556b700
RS
2638 /* Starting this at zero is always correct when not the first iteration
2639 because the previous iteration ended by sending C-d.
2640 It may not be correct for the first iteration
2641 if a partial line was sent in a separate send_process call.
2642 If that proves worth handling, we need to save linepos
2643 in the process object. */
2644 int linepos = 0;
2645 char *ptr = buf;
2646 char *end = buf + len;
2647
2648 /* Scan through this text for a line that is too long. */
2649 while (ptr != end && linepos < pty_max_bytes)
2650 {
2651 if (*ptr == '\n')
2652 linepos = 0;
2653 else
2654 linepos++;
2655 ptr++;
2656 }
2657 /* If we found one, break the line there
2658 and put in a C-d to force the buffer through. */
2659 this = ptr - buf;
93b4f699
RS
2660 }
2661
4556b700
RS
2662 /* Send this batch, using one or more write calls. */
2663 while (this > 0)
d0d6b7c5 2664 {
4556b700
RS
2665 old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
2666 rv = write (XINT (XPROCESS (proc)->outfd), buf, this);
2667 signal (SIGPIPE, old_sigpipe);
2668
2669 if (rv < 0)
2670 {
2671 if (0
d0d6b7c5 2672#ifdef EWOULDBLOCK
4556b700 2673 || errno == EWOULDBLOCK
d0d6b7c5
JB
2674#endif
2675#ifdef EAGAIN
4556b700 2676 || errno == EAGAIN
d0d6b7c5 2677#endif
4556b700
RS
2678 )
2679 /* Buffer is full. Wait, accepting input;
2680 that may allow the program
2681 to finish doing output and read more. */
2682 {
2683 Lisp_Object zero;
2684 int offset;
2685
2686 /* Running filters might relocate buffers or strings.
2687 Arrange to relocate BUF. */
2688 if (BUFFERP (object))
2689 offset = BUF_PTR_CHAR_POS (XBUFFER (object),
2690 (unsigned char *) buf);
2691 else if (STRINGP (object))
2692 offset = buf - (char *) XSTRING (object)->data;
2693
22719df2 2694 XSETFASTINT (zero, 0);
4556b700
RS
2695 wait_reading_process_input (1, 0, zero, 0);
2696
2697 if (BUFFERP (object))
2698 buf = (char *) BUF_CHAR_ADDRESS (XBUFFER (object), offset);
2699 else if (STRINGP (object))
2700 buf = offset + (char *) XSTRING (object)->data;
2701
2702 rv = 0;
2703 }
2704 else
2705 /* This is a real error. */
2706 report_file_error ("writing to process", Fcons (proc, Qnil));
d0d6b7c5 2707 }
4556b700
RS
2708 buf += rv;
2709 len -= rv;
2710 this -= rv;
d0d6b7c5 2711 }
f76475ad 2712
4556b700
RS
2713 /* If we sent just part of the string, put in an EOF
2714 to force it through, before we send the rest. */
2715 if (len > 0)
2716 Fprocess_send_eof (proc);
d0d6b7c5
JB
2717 }
2718#endif
2719 else
2720 {
2721 XPROCESS (proc)->raw_status_low = Qnil;
2722 XPROCESS (proc)->raw_status_high = Qnil;
2723 XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
2724 XSETINT (XPROCESS (proc)->tick, ++process_tick);
2725 deactivate_process (proc);
2726#ifdef VMS
2727 error ("Error writing to process %s; closed it", procname);
2728#else
2729 error ("SIGPIPE raised on process %s; closed it", procname);
2730#endif
2731 }
2732}
2733
2734DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
2735 3, 3, 0,
2736 "Send current contents of region as input to PROCESS.\n\
ebb9e16f
JB
2737PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2738nil, indicating the current buffer's process.\n\
d0d6b7c5
JB
2739Called from program, takes three arguments, PROCESS, START and END.\n\
2740If the region is more than 500 characters long,\n\
2741it is sent in several bunches. This may happen even for shorter regions.\n\
2742Output from processes can arrive in between bunches.")
2743 (process, start, end)
2744 Lisp_Object process, start, end;
2745{
2746 Lisp_Object proc;
2747 int start1;
2748
2749 proc = get_process (process);
2750 validate_region (&start, &end);
2751
2752 if (XINT (start) < GPT && XINT (end) > GPT)
2753 move_gap (start);
2754
2755 start1 = XINT (start);
4556b700
RS
2756 send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start),
2757 Fcurrent_buffer ());
d0d6b7c5
JB
2758
2759 return Qnil;
2760}
2761
2762DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
2763 2, 2, 0,
2764 "Send PROCESS the contents of STRING as input.\n\
ebb9e16f
JB
2765PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2766nil, indicating the current buffer's process.\n\
d0d6b7c5
JB
2767If STRING is more than 500 characters long,\n\
2768it is sent in several bunches. This may happen even for shorter strings.\n\
2769Output from processes can arrive in between bunches.")
2770 (process, string)
2771 Lisp_Object process, string;
2772{
2773 Lisp_Object proc;
2774 CHECK_STRING (string, 1);
2775 proc = get_process (process);
4556b700 2776 send_process (proc, XSTRING (string)->data, XSTRING (string)->size, string);
d0d6b7c5
JB
2777 return Qnil;
2778}
2779\f
2780/* send a signal number SIGNO to PROCESS.
2781 CURRENT_GROUP means send to the process group that currently owns
2782 the terminal being used to communicate with PROCESS.
2783 This is used for various commands in shell mode.
2784 If NOMSG is zero, insert signal-announcements into process's buffers
b0310da4
JB
2785 right away.
2786
2787 If we can, we try to signal PROCESS by sending control characters
e333e864 2788 down the pty. This allows us to signal inferiors who have changed
b0310da4 2789 their uid, for which killpg would return an EPERM error. */
d0d6b7c5 2790
f9738840 2791static void
d0d6b7c5
JB
2792process_send_signal (process, signo, current_group, nomsg)
2793 Lisp_Object process;
2794 int signo;
2795 Lisp_Object current_group;
2796 int nomsg;
2797{
2798 Lisp_Object proc;
2799 register struct Lisp_Process *p;
2800 int gid;
2801 int no_pgrp = 0;
2802
2803 proc = get_process (process);
2804 p = XPROCESS (proc);
2805
2806 if (!EQ (p->childp, Qt))
2807 error ("Process %s is not a subprocess",
2808 XSTRING (p->name)->data);
a9f2c884 2809 if (XINT (p->infd) < 0)
d0d6b7c5
JB
2810 error ("Process %s is not active",
2811 XSTRING (p->name)->data);
2812
2813 if (NILP (p->pty_flag))
2814 current_group = Qnil;
2815
d0d6b7c5
JB
2816 /* If we are using pgrps, get a pgrp number and make it negative. */
2817 if (!NILP (current_group))
2818 {
b0310da4 2819#ifdef SIGNALS_VIA_CHARACTERS
d0d6b7c5
JB
2820 /* If possible, send signals to the entire pgrp
2821 by sending an input character to it. */
b0310da4 2822
6be429b1
JB
2823 /* TERMIOS is the latest and bestest, and seems most likely to
2824 work. If the system has it, use it. */
2825#ifdef HAVE_TERMIOS
2826 struct termios t;
2827
2828 switch (signo)
2829 {
2830 case SIGINT:
a9f2c884 2831 tcgetattr (XINT (p->infd), &t);
4556b700 2832 send_process (proc, &t.c_cc[VINTR], 1, Qnil);
a87b802f 2833 return;
6be429b1
JB
2834
2835 case SIGQUIT:
a9f2c884 2836 tcgetattr (XINT (p->infd), &t);
4556b700 2837 send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
a87b802f 2838 return;
6be429b1
JB
2839
2840 case SIGTSTP:
a9f2c884 2841 tcgetattr (XINT (p->infd), &t);
d0adf46f 2842#if defined (VSWTCH) && !defined (PREFER_VSUSP)
4556b700 2843 send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
6be429b1 2844#else
4556b700 2845 send_process (proc, &t.c_cc[VSUSP], 1, Qnil);
6be429b1 2846#endif
a87b802f 2847 return;
6be429b1
JB
2848 }
2849
2850#else /* ! HAVE_TERMIOS */
2851
b0310da4
JB
2852 /* On Berkeley descendants, the following IOCTL's retrieve the
2853 current control characters. */
d0d6b7c5 2854#if defined (TIOCGLTC) && defined (TIOCGETC)
b0310da4 2855
d0d6b7c5
JB
2856 struct tchars c;
2857 struct ltchars lc;
2858
2859 switch (signo)
2860 {
2861 case SIGINT:
a9f2c884 2862 ioctl (XINT (p->infd), TIOCGETC, &c);
4556b700 2863 send_process (proc, &c.t_intrc, 1, Qnil);
f9738840 2864 return;
d0d6b7c5 2865 case SIGQUIT:
a9f2c884 2866 ioctl (XINT (p->infd), TIOCGETC, &c);
4556b700 2867 send_process (proc, &c.t_quitc, 1, Qnil);
f9738840 2868 return;
0ad77c54 2869#ifdef SIGTSTP
d0d6b7c5 2870 case SIGTSTP:
a9f2c884 2871 ioctl (XINT (p->infd), TIOCGLTC, &lc);
4556b700 2872 send_process (proc, &lc.t_suspc, 1, Qnil);
f9738840 2873 return;
b0310da4 2874#endif /* ! defined (SIGTSTP) */
d0d6b7c5 2875 }
b0310da4
JB
2876
2877#else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
2878
2879 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
2880 characters. */
2881#ifdef TCGETA
d0d6b7c5
JB
2882 struct termio t;
2883 switch (signo)
2884 {
2885 case SIGINT:
a9f2c884 2886 ioctl (XINT (p->infd), TCGETA, &t);
4556b700 2887 send_process (proc, &t.c_cc[VINTR], 1, Qnil);
f9738840 2888 return;
d0d6b7c5 2889 case SIGQUIT:
a9f2c884 2890 ioctl (XINT (p->infd), TCGETA, &t);
4556b700 2891 send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
f9738840 2892 return;
7d79e3b4 2893#ifdef SIGTSTP
d0d6b7c5 2894 case SIGTSTP:
a9f2c884 2895 ioctl (XINT (p->infd), TCGETA, &t);
4556b700 2896 send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
f9738840 2897 return;
b0310da4 2898#endif /* ! defined (SIGTSTP) */
d0d6b7c5 2899 }
b0310da4
JB
2900#else /* ! defined (TCGETA) */
2901 Your configuration files are messed up.
2902 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
2903 you'd better be using one of the alternatives above! */
2904#endif /* ! defined (TCGETA) */
2905#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
6be429b1 2906#endif /* ! defined HAVE_TERMIOS */
b0310da4 2907#endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
d0d6b7c5 2908
301c3fe4 2909#ifdef TIOCGPGRP
d0d6b7c5
JB
2910 /* Get the pgrp using the tty itself, if we have that.
2911 Otherwise, use the pty to get the pgrp.
2912 On pfa systems, saka@pfu.fujitsu.co.JP writes:
b0310da4
JB
2913 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
2914 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
d0d6b7c5
JB
2915 His patch indicates that if TIOCGPGRP returns an error, then
2916 we should just assume that p->pid is also the process group id. */
2917 {
2918 int err;
2919
2920 if (!NILP (p->subtty))
2921 err = ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
2922 else
a9f2c884 2923 err = ioctl (XINT (p->infd), TIOCGPGRP, &gid);
d0d6b7c5
JB
2924
2925#ifdef pfa
2926 if (err == -1)
2927 gid = - XFASTINT (p->pid);
301c3fe4 2928#endif /* ! defined (pfa) */
d0d6b7c5
JB
2929 }
2930 if (gid == -1)
2931 no_pgrp = 1;
2932 else
2933 gid = - gid;
b0310da4 2934#else /* ! defined (TIOCGPGRP ) */
301c3fe4
JB
2935 /* Can't select pgrps on this system, so we know that
2936 the child itself heads the pgrp. */
2937 gid = - XFASTINT (p->pid);
2938#endif /* ! defined (TIOCGPGRP ) */
d0d6b7c5
JB
2939 }
2940 else
2941 gid = - XFASTINT (p->pid);
d0d6b7c5
JB
2942
2943 switch (signo)
2944 {
2945#ifdef SIGCONT
2946 case SIGCONT:
2947 p->raw_status_low = Qnil;
2948 p->raw_status_high = Qnil;
2949 p->status = Qrun;
2950 XSETINT (p->tick, ++process_tick);
2951 if (!nomsg)
2952 status_notify ();
2953 break;
301c3fe4 2954#endif /* ! defined (SIGCONT) */
d0d6b7c5
JB
2955 case SIGINT:
2956#ifdef VMS
4556b700 2957 send_process (proc, "\003", 1, Qnil); /* ^C */
d0d6b7c5
JB
2958 goto whoosh;
2959#endif
2960 case SIGQUIT:
2961#ifdef VMS
4556b700 2962 send_process (proc, "\031", 1, Qnil); /* ^Y */
d0d6b7c5
JB
2963 goto whoosh;
2964#endif
2965 case SIGKILL:
2966#ifdef VMS
2967 sys$forcex (&(XFASTINT (p->pid)), 0, 1);
2968 whoosh:
2969#endif
a9f2c884 2970 flush_pending_output (XINT (p->infd));
d0d6b7c5
JB
2971 break;
2972 }
2973
2974 /* If we don't have process groups, send the signal to the immediate
2975 subprocess. That isn't really right, but it's better than any
2976 obvious alternative. */
2977 if (no_pgrp)
2978 {
2979 kill (XFASTINT (p->pid), signo);
2980 return;
2981 }
2982
2983 /* gid may be a pid, or minus a pgrp's number */
2984#ifdef TIOCSIGSEND
2985 if (!NILP (current_group))
a9f2c884 2986 ioctl (XINT (p->infd), TIOCSIGSEND, signo);
d0d6b7c5
JB
2987 else
2988 {
2989 gid = - XFASTINT (p->pid);
2990 kill (gid, signo);
2991 }
301c3fe4 2992#else /* ! defined (TIOCSIGSEND) */
d0d6b7c5 2993 EMACS_KILLPG (-gid, signo);
301c3fe4 2994#endif /* ! defined (TIOCSIGSEND) */
d0d6b7c5
JB
2995}
2996
2997DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
2998 "Interrupt process PROCESS. May be process or name of one.\n\
ebb9e16f 2999PROCESS may be a process, a buffer, or the name of a process or buffer.\n\
e333e864 3000nil or no arg means current buffer's process.\n\
d0d6b7c5
JB
3001Second arg CURRENT-GROUP non-nil means send signal to\n\
3002the current process-group of the process's controlling terminal\n\
3003rather than to the process's own process group.\n\
3004If the process is a shell, this means interrupt current subjob\n\
3005rather than the shell.")
3006 (process, current_group)
3007 Lisp_Object process, current_group;
3008{
3009 process_send_signal (process, SIGINT, current_group, 0);
3010 return process;
3011}
3012
3013DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
3014 "Kill process PROCESS. May be process or name of one.\n\
3015See function `interrupt-process' for more details on usage.")
3016 (process, current_group)
3017 Lisp_Object process, current_group;
3018{
3019 process_send_signal (process, SIGKILL, current_group, 0);
3020 return process;
3021}
3022
3023DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
3024 "Send QUIT signal to process PROCESS. May be process or name of one.\n\
3025See function `interrupt-process' for more details on usage.")
3026 (process, current_group)
3027 Lisp_Object process, current_group;
3028{
3029 process_send_signal (process, SIGQUIT, current_group, 0);
3030 return process;
3031}
3032
3033DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
3034 "Stop process PROCESS. May be process or name of one.\n\
3035See function `interrupt-process' for more details on usage.")
3036 (process, current_group)
3037 Lisp_Object process, current_group;
3038{
3039#ifndef SIGTSTP
3040 error ("no SIGTSTP support");
3041#else
3042 process_send_signal (process, SIGTSTP, current_group, 0);
3043#endif
3044 return process;
3045}
3046
3047DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
3048 "Continue process PROCESS. May be process or name of one.\n\
3049See function `interrupt-process' for more details on usage.")
3050 (process, current_group)
3051 Lisp_Object process, current_group;
3052{
3053#ifdef SIGCONT
3054 process_send_signal (process, SIGCONT, current_group, 0);
3055#else
3056 error ("no SIGCONT support");
3057#endif
3058 return process;
3059}
3060
3061DEFUN ("signal-process", Fsignal_process, Ssignal_process,
3062 2, 2, "nProcess number: \nnSignal code: ",
4766242d
RS
3063 "Send the process with process id PID the signal with code SIGCODE.\n\
3064PID must be an integer. The process need not be a child of this Emacs.\n\
3065SIGCODE may be an integer, or a symbol whose name is a signal name.")
3066 (pid, sigcode)
3067 Lisp_Object pid, sigcode;
d0d6b7c5
JB
3068{
3069 CHECK_NUMBER (pid, 0);
4766242d
RS
3070
3071#define handle_signal(NAME, VALUE) \
3072 else if (!strcmp (name, NAME)) \
3073 XSETINT (sigcode, VALUE)
3074
3075 if (INTEGERP (sigcode))
3076 ;
3077 else
3078 {
3079 unsigned char *name;
3080
3081 CHECK_SYMBOL (sigcode, 1);
3082 name = XSYMBOL (sigcode)->name->data;
3083
3084 if (0)
3085 ;
3086#ifdef SIGHUP
3087 handle_signal ("SIGHUP", SIGHUP);
3088#endif
3089#ifdef SIGINT
3090 handle_signal ("SIGINT", SIGINT);
3091#endif
3092#ifdef SIGQUIT
3093 handle_signal ("SIGQUIT", SIGQUIT);
3094#endif
3095#ifdef SIGILL
3096 handle_signal ("SIGILL", SIGILL);
3097#endif
3098#ifdef SIGABRT
3099 handle_signal ("SIGABRT", SIGABRT);
3100#endif
3101#ifdef SIGEMT
3102 handle_signal ("SIGEMT", SIGEMT);
3103#endif
3104#ifdef SIGKILL
3105 handle_signal ("SIGKILL", SIGKILL);
3106#endif
3107#ifdef SIGFPE
3108 handle_signal ("SIGFPE", SIGFPE);
3109#endif
3110#ifdef SIGBUS
3111 handle_signal ("SIGBUS", SIGBUS);
3112#endif
3113#ifdef SIGSEGV
3114 handle_signal ("SIGSEGV", SIGSEGV);
3115#endif
3116#ifdef SIGSYS
3117 handle_signal ("SIGSYS", SIGSYS);
3118#endif
3119#ifdef SIGPIPE
3120 handle_signal ("SIGPIPE", SIGPIPE);
3121#endif
3122#ifdef SIGALRM
3123 handle_signal ("SIGALRM", SIGALRM);
3124#endif
3125#ifdef SIGTERM
3126 handle_signal ("SIGTERM", SIGTERM);
3127#endif
3128#ifdef SIGURG
3129 handle_signal ("SIGURG", SIGURG);
3130#endif
3131#ifdef SIGSTOP
3132 handle_signal ("SIGSTOP", SIGSTOP);
3133#endif
3134#ifdef SIGTSTP
3135 handle_signal ("SIGTSTP", SIGTSTP);
3136#endif
3137#ifdef SIGCONT
3138 handle_signal ("SIGCONT", SIGCONT);
3139#endif
3140#ifdef SIGCHLD
3141 handle_signal ("SIGCHLD", SIGCHLD);
3142#endif
3143#ifdef SIGTTIN
3144 handle_signal ("SIGTTIN", SIGTTIN);
3145#endif
3146#ifdef SIGTTOU
3147 handle_signal ("SIGTTOU", SIGTTOU);
3148#endif
3149#ifdef SIGIO
3150 handle_signal ("SIGIO", SIGIO);
3151#endif
3152#ifdef SIGXCPU
3153 handle_signal ("SIGXCPU", SIGXCPU);
3154#endif
3155#ifdef SIGXFSZ
3156 handle_signal ("SIGXFSZ", SIGXFSZ);
3157#endif
3158#ifdef SIGVTALRM
3159 handle_signal ("SIGVTALRM", SIGVTALRM);
3160#endif
3161#ifdef SIGPROF
3162 handle_signal ("SIGPROF", SIGPROF);
3163#endif
3164#ifdef SIGWINCH
3165 handle_signal ("SIGWINCH", SIGWINCH);
3166#endif
3167#ifdef SIGINFO
3168 handle_signal ("SIGINFO", SIGINFO);
3169#endif
3170#ifdef SIGUSR1
3171 handle_signal ("SIGUSR1", SIGUSR1);
3172#endif
3173#ifdef SIGUSR2
3174 handle_signal ("SIGUSR2", SIGUSR2);
3175#endif
3176 else
9fa195a2 3177 error ("Undefined signal name %s", name);
4766242d
RS
3178 }
3179
3180#undef handle_signal
3181
e98d950b
RS
3182#ifdef WINDOWSNT
3183 /* Only works for kill-type signals */
4766242d 3184 return make_number (win32_kill_process (XINT (pid), XINT (sigcode)));
e98d950b 3185#else
4766242d 3186 return make_number (kill (XINT (pid), XINT (sigcode)));
e98d950b 3187#endif
d0d6b7c5
JB
3188}
3189
3190DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
3191 "Make PROCESS see end-of-file in its input.\n\
3192Eof comes after any text already sent to it.\n\
ebb9e16f 3193PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
d33a00f2
RS
3194nil, indicating the current buffer's process.\n\
3195If PROCESS is a network connection, or is a process communicating\n\
3196through a pipe (as opposed to a pty), then you cannot send any more\n\
3197text to PROCESS after you call this function.")
d0d6b7c5
JB
3198 (process)
3199 Lisp_Object process;
3200{
3201 Lisp_Object proc;
3202
3203 proc = get_process (process);
577d03d5
RS
3204
3205 /* Make sure the process is really alive. */
3206 if (! NILP (XPROCESS (proc)->raw_status_low))
3207 update_status (XPROCESS (proc));
3208 if (! EQ (XPROCESS (proc)->status, Qrun))
dcf970e6 3209 error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data);
577d03d5 3210
d0d6b7c5 3211#ifdef VMS
4556b700 3212 send_process (proc, "\032", 1, Qnil); /* ^z */
d0d6b7c5
JB
3213#else
3214 if (!NILP (XPROCESS (proc)->pty_flag))
4556b700 3215 send_process (proc, "\004", 1, Qnil);
d0d6b7c5
JB
3216 else
3217 {
a9f2c884 3218 close (XINT (XPROCESS (proc)->outfd));
1d056e64 3219 XSETINT (XPROCESS (proc)->outfd, open (NULL_DEVICE, O_WRONLY));
d0d6b7c5
JB
3220 }
3221#endif /* VMS */
d0d6b7c5
JB
3222 return process;
3223}
3224
3225/* Kill all processes associated with `buffer'.
3226 If `buffer' is nil, kill all processes */
3227
3228kill_buffer_processes (buffer)
3229 Lisp_Object buffer;
3230{
3231 Lisp_Object tail, proc;
3232
b5b502d6 3233 for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
d0d6b7c5
JB
3234 {
3235 proc = XCONS (XCONS (tail)->car)->cdr;
b5b502d6 3236 if (GC_PROCESSP (proc)
d0d6b7c5
JB
3237 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
3238 {
3239 if (NETCONN_P (proc))
e1ab4959 3240 Fdelete_process (proc);
a9f2c884 3241 else if (XINT (XPROCESS (proc)->infd) >= 0)
d0d6b7c5
JB
3242 process_send_signal (proc, SIGHUP, Qnil, 1);
3243 }
3244 }
3245}
3246\f
3247/* On receipt of a signal that a child status has changed,
3248 loop asking about children with changed statuses until
3249 the system says there are no more.
3250 All we do is change the status;
3251 we do not run sentinels or print notifications.
3252 That is saved for the next time keyboard input is done,
3253 in order to avoid timing errors. */
3254
3255/** WARNING: this can be called during garbage collection.
3256 Therefore, it must not be fooled by the presence of mark bits in
3257 Lisp objects. */
3258
3259/** USG WARNING: Although it is not obvious from the documentation
3260 in signal(2), on a USG system the SIGCLD handler MUST NOT call
3261 signal() before executing at least one wait(), otherwise the handler
3262 will be called again, resulting in an infinite loop. The relevant
3263 portion of the documentation reads "SIGCLD signals will be queued
3264 and the signal-catching function will be continually reentered until
3265 the queue is empty". Invoking signal() causes the kernel to reexamine
3266 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
3267
3268SIGTYPE
3269sigchld_handler (signo)
3270 int signo;
3271{
3272 int old_errno = errno;
3273 Lisp_Object proc;
3274 register struct Lisp_Process *p;
6be429b1 3275 extern EMACS_TIME *input_available_clear_time;
d0d6b7c5
JB
3276
3277#ifdef BSD4_1
3278 extern int sigheld;
3279 sigheld |= sigbit (SIGCHLD);
3280#endif
3281
3282 while (1)
3283 {
3284 register int pid;
3285 WAITTYPE w;
3286 Lisp_Object tail;
3287
3288#ifdef WNOHANG
3289#ifndef WUNTRACED
3290#define WUNTRACED 0
3291#endif /* no WUNTRACED */
3292 /* Keep trying to get a status until we get a definitive result. */
3293 do
3294 {
3295 errno = 0;
3296 pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
3297 }
3298 while (pid <= 0 && errno == EINTR);
3299
3300 if (pid <= 0)
3301 {
3302 /* A real failure. We have done all our job, so return. */
3303
3304 /* USG systems forget handlers when they are used;
3305 must reestablish each time */
3306#ifdef USG
3307 signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
3308#endif
3309#ifdef BSD4_1
3310 sigheld &= ~sigbit (SIGCHLD);
3311 sigrelse (SIGCHLD);
3312#endif
3313 errno = old_errno;
3314 return;
3315 }
3316#else
3317 pid = wait (&w);
3318#endif /* no WNOHANG */
3319
3320 /* Find the process that signaled us, and record its status. */
3321
3322 p = 0;
7968cc2d 3323 for (tail = Vprocess_alist; CONSP (tail); tail = XCONS (tail)->cdr)
d0d6b7c5
JB
3324 {
3325 proc = XCONS (XCONS (tail)->car)->cdr;
3326 p = XPROCESS (proc);
3327 if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
3328 break;
3329 p = 0;
3330 }
3331
3332 /* Look for an asynchronous process whose pid hasn't been filled
3333 in yet. */
3334 if (p == 0)
7968cc2d 3335 for (tail = Vprocess_alist; CONSP (tail); tail = XCONS (tail)->cdr)
d0d6b7c5
JB
3336 {
3337 proc = XCONS (XCONS (tail)->car)->cdr;
3338 p = XPROCESS (proc);
bcd69aea 3339 if (INTEGERP (p->pid) && XINT (p->pid) == -1)
d0d6b7c5
JB
3340 break;
3341 p = 0;
3342 }
3343
3344 /* Change the status of the process that was found. */
3345 if (p != 0)
3346 {
3347 union { int i; WAITTYPE wt; } u;
e98d950b 3348 int clear_desc_flag = 0;
d0d6b7c5
JB
3349
3350 XSETINT (p->tick, ++process_tick);
3351 u.wt = w;
5fc0154c
RS
3352 XSETINT (p->raw_status_low, u.i & 0xffff);
3353 XSETINT (p->raw_status_high, u.i >> 16);
d0d6b7c5
JB
3354
3355 /* If process has terminated, stop waiting for its output. */
e98d950b
RS
3356 if ((WIFSIGNALED (w) || WIFEXITED (w))
3357 && XINT (p->infd) >= 0)
3358 clear_desc_flag = 1;
3359
3360 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
3361 if (clear_desc_flag)
3362 {
3363 FD_CLR (XINT (p->infd), &input_wait_mask);
3364 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
3365 }
6be429b1
JB
3366
3367 /* Tell wait_reading_process_input that it needs to wake up and
3368 look around. */
3369 if (input_available_clear_time)
3370 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
d0d6b7c5
JB
3371 }
3372
3373 /* There was no asynchronous process found for that id. Check
3374 if we have a synchronous process. */
3375 else
3376 {
3377 synch_process_alive = 0;
3378
3379 /* Report the status of the synchronous process. */
3380 if (WIFEXITED (w))
3381 synch_process_retcode = WRETCODE (w);
3382 else if (WIFSIGNALED (w))
b97ad9ea
RS
3383 {
3384 int code = WTERMSIG (w);
3385 char *signame = 0;
3386
3387 if (code < NSIG)
3388 {
b0310da4 3389#ifndef VMS
ed0cae05
RS
3390 /* Suppress warning if the table has const char *. */
3391 signame = (char *) sys_siglist[code];
b0310da4 3392#else
b97ad9ea 3393 signame = sys_errlist[code];
b0310da4 3394#endif
b97ad9ea
RS
3395 }
3396 if (signame == 0)
3397 signame = "unknown";
3398
3399 synch_process_death = signame;
3400 }
6be429b1
JB
3401
3402 /* Tell wait_reading_process_input that it needs to wake up and
3403 look around. */
3404 if (input_available_clear_time)
3405 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
d0d6b7c5
JB
3406 }
3407
3408 /* On some systems, we must return right away.
3409 If any more processes want to signal us, we will
3410 get another signal.
3411 Otherwise (on systems that have WNOHANG), loop around
3412 to use up all the processes that have something to tell us. */
e98d950b 3413#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG)) || defined (WINDOWSNT)
d0d6b7c5
JB
3414#ifdef USG
3415 signal (signo, sigchld_handler);
3416#endif
3417 errno = old_errno;
3418 return;
3419#endif /* USG, but not HPUX with WNOHANG */
3420 }
3421}
3422\f
3423
3424static Lisp_Object
3425exec_sentinel_unwind (data)
3426 Lisp_Object data;
3427{
3428 XPROCESS (XCONS (data)->car)->sentinel = XCONS (data)->cdr;
3429 return Qnil;
3430}
3431
3b9a3dfa
RS
3432static Lisp_Object
3433exec_sentinel_error_handler (error)
3434 Lisp_Object error;
3435{
3436 cmd_error_internal (error, "error in process sentinel: ");
3437 Vinhibit_quit = Qt;
3438 update_echo_area ();
833ba342 3439 Fsleep_for (make_number (2), Qnil);
3b9a3dfa
RS
3440}
3441
d0d6b7c5
JB
3442static void
3443exec_sentinel (proc, reason)
3444 Lisp_Object proc, reason;
3445{
dfc21838 3446 Lisp_Object sentinel, obuffer, odeactivate, okeymap;
d0d6b7c5
JB
3447 register struct Lisp_Process *p = XPROCESS (proc);
3448 int count = specpdl_ptr - specpdl;
3449
dfc21838
RS
3450 /* No need to gcpro these, because all we do with them later
3451 is test them for EQness, and none of them should be a string. */
8fb3cf64 3452 odeactivate = Vdeactivate_mark;
dfc21838
RS
3453 XSETBUFFER (obuffer, current_buffer);
3454 okeymap = current_buffer->keymap;
3455
d0d6b7c5
JB
3456 sentinel = p->sentinel;
3457 if (NILP (sentinel))
3458 return;
3459
3460 /* Zilch the sentinel while it's running, to avoid recursive invocations;
3461 assure that it gets restored no matter how the sentinel exits. */
3462 p->sentinel = Qnil;
3463 record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
3464 /* Inhibit quit so that random quits don't screw up a running filter. */
3465 specbind (Qinhibit_quit, Qt);
6545aada 3466 specbind (Qlast_nonmenu_event, Qt);
3b9a3dfa 3467
7074fde6 3468 running_asynch_code = 1;
3b9a3dfa
RS
3469 internal_condition_case_1 (read_process_output_call,
3470 Fcons (sentinel,
3471 Fcons (proc, Fcons (reason, Qnil))),
3472 !NILP (Vdebug_on_error) ? Qnil : Qerror,
3473 exec_sentinel_error_handler);
7074fde6
FP
3474 running_asynch_code = 0;
3475 restore_match_data ();
8fb3cf64
KH
3476
3477 Vdeactivate_mark = odeactivate;
7973cfa8 3478#if 0
dfc21838
RS
3479 if (! EQ (Fcurrent_buffer (), obuffer)
3480 || ! EQ (current_buffer->keymap, okeymap))
7973cfa8 3481#endif
927e08be
RS
3482 /* But do it only if the caller is actually going to read events.
3483 Otherwise there's no need to make him wake up, and it could
3484 cause trouble (for example it would make Fsit_for return). */
3485 if (waiting_for_user_input_p == -1)
3486 record_asynch_buffer_change ();
8fb3cf64 3487
2ea6d561 3488 unbind_to (count, Qnil);
d0d6b7c5
JB
3489}
3490
3491/* Report all recent events of a change in process status
3492 (either run the sentinel or output a message).
3493 This is done while Emacs is waiting for keyboard input. */
3494
3495status_notify ()
3496{
3497 register Lisp_Object proc, buffer;
2e4149a8 3498 Lisp_Object tail, msg;
d0d6b7c5
JB
3499 struct gcpro gcpro1, gcpro2;
3500
2e4149a8
KH
3501 tail = Qnil;
3502 msg = Qnil;
d0d6b7c5
JB
3503 /* We need to gcpro tail; if read_process_output calls a filter
3504 which deletes a process and removes the cons to which tail points
3505 from Vprocess_alist, and then causes a GC, tail is an unprotected
3506 reference. */
3507 GCPRO2 (tail, msg);
3508
30623085
RS
3509 /* Set this now, so that if new processes are created by sentinels
3510 that we run, we get called again to handle their status changes. */
3511 update_tick = process_tick;
3512
3513 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
d0d6b7c5 3514 {
30623085
RS
3515 Lisp_Object symbol;
3516 register struct Lisp_Process *p;
3517
3518 proc = Fcdr (Fcar (tail));
3519 p = XPROCESS (proc);
3520
3521 if (XINT (p->tick) != XINT (p->update_tick))
d0d6b7c5 3522 {
30623085 3523 XSETINT (p->update_tick, XINT (p->tick));
d0d6b7c5 3524
30623085
RS
3525 /* If process is still active, read any output that remains. */
3526 if (XINT (p->infd) >= 0)
3527 while (! EQ (p->filter, Qt)
3528 && read_process_output (proc, XINT (p->infd)) > 0);
d0d6b7c5 3529
30623085 3530 buffer = p->buffer;
d0d6b7c5 3531
30623085
RS
3532 /* Get the text to use for the message. */
3533 if (!NILP (p->raw_status_low))
3534 update_status (p);
3535 msg = status_message (p->status);
d0d6b7c5 3536
30623085
RS
3537 /* If process is terminated, deactivate it or delete it. */
3538 symbol = p->status;
3539 if (CONSP (p->status))
3540 symbol = XCONS (p->status)->car;
d0d6b7c5 3541
30623085
RS
3542 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
3543 || EQ (symbol, Qclosed))
3544 {
3545 if (delete_exited_processes)
3546 remove_process (proc);
3547 else
3548 deactivate_process (proc);
3549 }
d0d6b7c5 3550
30623085
RS
3551 /* Now output the message suitably. */
3552 if (!NILP (p->sentinel))
3553 exec_sentinel (proc, msg);
3554 /* Don't bother with a message in the buffer
3555 when a process becomes runnable. */
3556 else if (!EQ (symbol, Qrun) && !NILP (buffer))
3557 {
3558 Lisp_Object ro, tem;
3559 struct buffer *old = current_buffer;
3560 int opoint;
2e4149a8 3561
30623085 3562 ro = XBUFFER (buffer)->read_only;
d0d6b7c5 3563
30623085
RS
3564 /* Avoid error if buffer is deleted
3565 (probably that's why the process is dead, too) */
3566 if (NILP (XBUFFER (buffer)->name))
3567 continue;
3568 Fset_buffer (buffer);
3569 opoint = point;
3570 /* Insert new output into buffer
3571 at the current end-of-output marker,
3572 thus preserving logical ordering of input and output. */
3573 if (XMARKER (p->mark)->buffer)
3574 SET_PT (marker_position (p->mark));
3575 else
3576 SET_PT (ZV);
3577 if (point <= opoint)
3578 opoint += XSTRING (msg)->size + XSTRING (p->name)->size + 10;
3579
3580 tem = current_buffer->read_only;
3581 current_buffer->read_only = Qnil;
3582 insert_string ("\nProcess ");
3583 Finsert (1, &p->name);
3584 insert_string (" ");
3585 Finsert (1, &msg);
3586 current_buffer->read_only = tem;
3587 Fset_marker (p->mark, make_number (point), p->buffer);
3588
3589 SET_PT (opoint);
3590 set_buffer_internal (old);
d0d6b7c5 3591 }
30623085
RS
3592 }
3593 } /* end for */
d0d6b7c5
JB
3594
3595 update_mode_lines++; /* in case buffers use %s in mode-line-format */
3596 redisplay_preserve_echo_area ();
3597
d0d6b7c5
JB
3598 UNGCPRO;
3599}
3600\f
a69281ff
RS
3601/* The first time this is called, assume keyboard input comes from DESC
3602 instead of from where we used to expect it.
3603 Subsequent calls mean assume input keyboard can come from DESC
3604 in addition to other places. */
3605
3606static int add_keyboard_wait_descriptor_called_flag;
3607
3608void
3609add_keyboard_wait_descriptor (desc)
3610 int desc;
3611{
3612 if (! add_keyboard_wait_descriptor_called_flag)
3613 FD_CLR (0, &input_wait_mask);
3614 add_keyboard_wait_descriptor_called_flag = 1;
3615 FD_SET (desc, &input_wait_mask);
3616 if (desc > max_keyboard_desc)
3617 max_keyboard_desc = desc;
3618}
3619
3620/* From now on, do not expect DESC to give keyboard input. */
3621
3622void
3623delete_keyboard_wait_descriptor (desc)
3624 int desc;
3625{
3626 int fd;
3627 int lim = max_keyboard_desc;
3628
3629 FD_CLR (desc, &input_wait_mask);
3630
3631 if (desc == max_keyboard_desc)
3632 for (fd = 0; fd < lim; fd++)
3633 if (FD_ISSET (fd, &input_wait_mask)
3634 && !FD_ISSET (fd, &non_keyboard_wait_mask))
3635 max_keyboard_desc = fd;
3636}
3637
3638/* Return nonzero if *MASK has a bit set
3639 that corresponds to one of the keyboard input descriptors. */
3640
3641int
3642keyboard_bit_set (mask)
3643 SELECT_TYPE *mask;
3644{
3645 int fd;
3646
ee8e09af 3647 for (fd = 0; fd <= max_keyboard_desc; fd++)
a69281ff
RS
3648 if (FD_ISSET (fd, mask) && FD_ISSET (fd, &input_wait_mask)
3649 && !FD_ISSET (fd, &non_keyboard_wait_mask))
3650 return 1;
3651
3652 return 0;
3653}
3654\f
d0d6b7c5
JB
3655init_process ()
3656{
3657 register int i;
3658
3659#ifdef SIGCHLD
3660#ifndef CANNOT_DUMP
3661 if (! noninteractive || initialized)
3662#endif
3663 signal (SIGCHLD, sigchld_handler);
3664#endif
3665
3666 FD_ZERO (&input_wait_mask);
a69281ff 3667 FD_ZERO (&non_keyboard_wait_mask);
7d0e672e 3668 max_process_desc = 0;
dd2281ae 3669
a69281ff 3670 FD_SET (0, &input_wait_mask);
dd2281ae 3671
d0d6b7c5
JB
3672 Vprocess_alist = Qnil;
3673 for (i = 0; i < MAXDESC; i++)
3674 {
3675 chan_process[i] = Qnil;
3676 proc_buffered_char[i] = -1;
3677 }
3678}
312c9964 3679
d0d6b7c5
JB
3680syms_of_process ()
3681{
d0d6b7c5
JB
3682#ifdef HAVE_SOCKETS
3683 stream_process = intern ("stream");
3684#endif
3685 Qprocessp = intern ("processp");
3686 staticpro (&Qprocessp);
3687 Qrun = intern ("run");
3688 staticpro (&Qrun);
3689 Qstop = intern ("stop");
3690 staticpro (&Qstop);
3691 Qsignal = intern ("signal");
3692 staticpro (&Qsignal);
3693
3694 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
3695 here again.
3696
3697 Qexit = intern ("exit");
3698 staticpro (&Qexit); */
3699
3700 Qopen = intern ("open");
3701 staticpro (&Qopen);
3702 Qclosed = intern ("closed");
3703 staticpro (&Qclosed);
3704
6545aada
RS
3705 Qlast_nonmenu_event = intern ("last-nonmenu-event");
3706 staticpro (&Qlast_nonmenu_event);
3707
d0d6b7c5
JB
3708 staticpro (&Vprocess_alist);
3709
3710 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
3711 "*Non-nil means delete processes immediately when they exit.\n\
3712nil means don't delete them until `list-processes' is run.");
3713
3714 delete_exited_processes = 1;
3715
3716 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
3717 "Control type of device used to communicate with subprocesses.\n\
e333e864
RS
3718Values are nil to use a pipe, or t or `pty' to use a pty.\n\
3719The value has no effect if the system has no ptys or if all ptys are busy:\n\
3720then a pipe is used in any case.\n\
3721The value takes effect when `start-process' is called.");
d0d6b7c5
JB
3722 Vprocess_connection_type = Qt;
3723
3724 defsubr (&Sprocessp);
3725 defsubr (&Sget_process);
3726 defsubr (&Sget_buffer_process);
3727 defsubr (&Sdelete_process);
3728 defsubr (&Sprocess_status);
3729 defsubr (&Sprocess_exit_status);
3730 defsubr (&Sprocess_id);
3731 defsubr (&Sprocess_name);
3b9a3dfa 3732 defsubr (&Sprocess_tty_name);
d0d6b7c5
JB
3733 defsubr (&Sprocess_command);
3734 defsubr (&Sset_process_buffer);
3735 defsubr (&Sprocess_buffer);
3736 defsubr (&Sprocess_mark);
3737 defsubr (&Sset_process_filter);
3738 defsubr (&Sprocess_filter);
3739 defsubr (&Sset_process_sentinel);
396df322 3740 defsubr (&Sset_process_window_size);
d0d6b7c5
JB
3741 defsubr (&Sprocess_sentinel);
3742 defsubr (&Sprocess_kill_without_query);
3743 defsubr (&Slist_processes);
3744 defsubr (&Sprocess_list);
3745 defsubr (&Sstart_process);
3746#ifdef HAVE_SOCKETS
3747 defsubr (&Sopen_network_stream);
3748#endif /* HAVE_SOCKETS */
3749 defsubr (&Saccept_process_output);
3750 defsubr (&Sprocess_send_region);
3751 defsubr (&Sprocess_send_string);
3752 defsubr (&Sinterrupt_process);
3753 defsubr (&Skill_process);
3754 defsubr (&Squit_process);
3755 defsubr (&Sstop_process);
3756 defsubr (&Scontinue_process);
3757 defsubr (&Sprocess_send_eof);
3758 defsubr (&Ssignal_process);
3759 defsubr (&Swaiting_for_user_input_p);
3760/* defsubr (&Sprocess_connection); */
3761}
3762
6720a7fb
JB
3763\f
3764#else /* not subprocesses */
3765
3766#include <sys/types.h>
3767#include <errno.h>
3768
3769#include "lisp.h"
3770#include "systime.h"
3771#include "termopts.h"
81afb6d1 3772#include "sysselect.h"
6720a7fb 3773
ff11dfa1 3774extern int frame_garbaged;
6720a7fb
JB
3775
3776
3777/* As described above, except assuming that there are no subprocesses:
3778
3779 Wait for timeout to elapse and/or keyboard input to be available.
3780
3781 time_limit is:
3782 timeout in seconds, or
3783 zero for no limit, or
3784 -1 means gobble data immediately available but don't wait for any.
3785
f76475ad 3786 read_kbd is a Lisp_Object:
6720a7fb
JB
3787 0 to ignore keyboard input, or
3788 1 to return when input is available, or
3789 -1 means caller will actually read the input, so don't throw to
3790 the quit handler.
3791 We know that read_kbd will never be a Lisp_Process, since
3792 `subprocesses' isn't defined.
3793
3794 do_display != 0 means redisplay should be done to show subprocess
5164ee8e 3795 output that arrives.
6720a7fb 3796
eb8c3be9 3797 Return true iff we received input from any process. */
6720a7fb
JB
3798
3799int
3800wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
f76475ad
JB
3801 int time_limit, microsecs;
3802 Lisp_Object read_kbd;
3803 int do_display;
6720a7fb
JB
3804{
3805 EMACS_TIME end_time, timeout, *timeout_p;
8db121c4 3806 SELECT_TYPE waitchannels;
6720a7fb
JB
3807
3808 /* What does time_limit really mean? */
3809 if (time_limit || microsecs)
3810 {
3811 /* It's not infinite. */
3812 timeout_p = &timeout;
3813
3814 if (time_limit == -1)
3815 /* In fact, it's zero. */
3816 EMACS_SET_SECS_USECS (timeout, 0, 0);
3817 else
3818 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
3819
3820 /* How far in the future is that? */
3821 EMACS_GET_TIME (end_time);
3822 EMACS_ADD_TIME (end_time, end_time, timeout);
3823 }
3824 else
3825 /* It's infinite. */
3826 timeout_p = 0;
3827
3828 /* Turn off periodic alarms (in case they are in use)
3829 because the select emulator uses alarms. */
3830 stop_polling ();
3831
3832 for (;;)
3833 {
3834 int nfds;
3835
8db121c4
KH
3836 if (XINT (read_kbd))
3837 FD_SET (0, &waitchannels);
3838 else
3839 FD_ZERO (&waitchannels);
6720a7fb
JB
3840
3841 /* If calling from keyboard input, do not quit
3842 since we want to return C-g as an input character.
3843 Otherwise, do pending quit if requested. */
f76475ad 3844 if (XINT (read_kbd) >= 0)
6720a7fb
JB
3845 QUIT;
3846
3847 if (timeout_p)
3848 {
3849 EMACS_GET_TIME (*timeout_p);
3850 EMACS_SUB_TIME (*timeout_p, end_time, *timeout_p);
3851 if (EMACS_TIME_NEG_P (*timeout_p))
3852 break;
3853 }
3854
3855 /* Cause C-g and alarm signals to take immediate action,
3856 and cause input available signals to zero out timeout. */
f76475ad 3857 if (XINT (read_kbd) < 0)
6720a7fb
JB
3858 set_waiting_for_input (&timeout);
3859
ff11dfa1 3860 /* If a frame has been newly mapped and needs updating,
6720a7fb 3861 reprocess its display stuff. */
5164ee8e 3862 if (frame_garbaged && do_display)
6720a7fb
JB
3863 redisplay_preserve_echo_area ();
3864
f76475ad 3865 if (XINT (read_kbd) && detect_input_pending ())
6720a7fb
JB
3866 nfds = 0;
3867 else
ecd1f654
KH
3868 nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
3869 timeout_p);
6720a7fb
JB
3870
3871 /* Make C-g and alarm signals set flags again */
3872 clear_waiting_for_input ();
3873
3874 /* If we woke up due to SIGWINCH, actually change size now. */
3875 do_pending_window_change ();
3876
3877 if (nfds == -1)
3878 {
3879 /* If the system call was interrupted, then go around the
3880 loop again. */
3881 if (errno == EINTR)
8db121c4 3882 FD_ZERO (&waitchannels);
6720a7fb
JB
3883 }
3884#ifdef sun
3885 else if (nfds > 0 && (waitchannels & 1) && interrupt_input)
3886 /* System sometimes fails to deliver SIGIO. */
3887 kill (getpid (), SIGIO);
3888#endif
7324d660 3889#ifdef SIGIO
f76475ad 3890 if (XINT (read_kbd) && interrupt_input && (waitchannels & 1))
6720a7fb 3891 kill (0, SIGIO);
7324d660 3892#endif
6720a7fb
JB
3893
3894 /* If we have timed out (nfds == 0) or found some input (nfds > 0),
3895 we should exit. */
3896 if (nfds >= 0)
3897 break;
3898 }
3899
a87b802f
JB
3900 start_polling ();
3901
6720a7fb
JB
3902 return 0;
3903}
3904
3905
3906DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
51ab806a 3907 /* Don't confuse make-docfile by having two doc strings for this function.
312c9964
RS
3908 make-docfile does not pay attention to #if, for good reason! */
3909 0)
6720a7fb
JB
3910 (name)
3911 register Lisp_Object name;
3912{
3913 return Qnil;
3914}
3915
3916/* Kill all processes associated with `buffer'.
3917 If `buffer' is nil, kill all processes.
3918 Since we have no subprocesses, this does nothing. */
3919
3920kill_buffer_processes (buffer)
3921 Lisp_Object buffer;
3922{
3923}
3924
3925init_process ()
3926{
3927}
3928
3929syms_of_process ()
3930{
3931 defsubr (&Sget_buffer_process);
3932}
3933
3934\f
3935#endif /* not subprocesses */