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