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