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