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