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