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