1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1990 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 1, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
21 #include <signal.h>
22
23 #include "config.h"
24
25 #ifdef subprocesses
26 /* The entire file is within this conditional */
27
28 #include <stdio.h>
29 #include <errno.h>
30 #include <setjmp.h>
31 #include <sys/types.h> /* some typedefs are used in sys/file.h */
32 #include <sys/file.h>
33 #include <sys/stat.h>
34
35 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
36 #include <sys/socket.h>
37 #include <netdb.h>
38 #include <netinet/in.h>
39 #endif /* HAVE_SOCKETS */
40
41 #if defined(BSD) || defined(STRIDE)
42 #include <sys/ioctl.h>
43 #if !defined (O_NDELAY) && defined (HAVE_PTYS)
44 #include <fcntl.h>
45 #endif /* HAVE_PTYS and no O_NDELAY */
46 #endif /* BSD or STRIDE */
47 #ifdef USG
48 #include <termio.h>
49 #include <fcntl.h>
50 #endif /* USG */
51
52 #ifdef NEED_BSDTTY
53 #include <sys/bsdtty.h>
54 #endif
55
56 #ifdef HPUX
57 #undef TIOCGPGRP
58 #endif
59
60 #ifdef IRIS
61 #include <sys/sysmacros.h> /* for "minor" */
62 #include <sys/time.h>
63 #else
64 #ifdef UNIPLUS
65 #include <sys/time.h>
66
67 #else /* not IRIS, not UNIPLUS */
68 #ifdef HAVE_TIMEVAL
69 /* _h_BSDTYPES is checked because on ISC unix, socket.h includes
70 both time.h and sys/time.h, and the latter file is protected
71 from repeated inclusion. */
72 #if defined(USG) && !defined(AIX) && !defined(_h_BSDTYPES) && !defined(USG_SYS_TIME)
73 #include <time.h>
74 #else /* AIX or USG_SYS_TIME, or not USG */
75 #include <sys/time.h>
76 #endif /* AIX or USG_SYS_TIME, or not USG */
77 #endif /* HAVE_TIMEVAL */
78
79 #endif /* not UNIPLUS */
80 #endif /* not IRIS */
81
82 #if defined (HPUX) && defined (HAVE_PTYS)
83 #include <sys/ptyio.h>
84 #endif
85
86 #ifdef AIX
87 #include <sys/pty.h>
88 #include <unistd.h>
89 #endif /* AIX */
90
91 #ifdef SYSV_PTYS
92 #include <sys/tty.h>
93 #include <sys/pty.h>
94 #endif
95
96 #undef NULL
97 #include "lisp.h"
98 #include "window.h"
99 #include "buffer.h"
100 #include "process.h"
101 #include "termhooks.h"
102 #include "termopts.h"
103 #include "commands.h"
104
105 Lisp_Object Qrun, Qstop, Qsignal, Qexit, Qopen, Qclosed;
106
107 /* a process object is a network connection when its childp field is neither
108 Qt nor Qnil but is instead a string (name of foreign host we
109 are connected to + name of port we are connected to) */
110
111 #ifdef HAVE_SOCKETS
112 #define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String)
113 #else
114 #define NETCONN_P(p) 0
115 #endif /* HAVE_SOCKETS */
116
117 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
118 testing SIGCHLD. */
119
120 #if !defined (SIGCHLD) && defined (SIGCLD)
121 #define SIGCHLD SIGCLD
122 #endif /* SIGCLD */
123
124 /* Define the structure that the wait system call stores.
125 On many systems, there is a structure defined for this.
126 But on vanilla-ish USG systems there is not. */
127
128 #ifndef WAITTYPE
129 #if !defined (BSD) && !defined (UNIPLUS) && !defined (STRIDE) && !(defined (HPUX) && !defined (NOMULTIPLEJOBS)) && !defined (HAVE_WAIT_HEADER)
130 #define WAITTYPE int
131 #define WIFSTOPPED(w) ((w&0377) == 0177)
132 #define WIFSIGNALED(w) ((w&0377) != 0177 && (w&~0377) == 0)
133 #define WIFEXITED(w) ((w&0377) == 0)
134 #define WRETCODE(w) (w >> 8)
135 #define WSTOPSIG(w) (w >> 8)
136 #define WTERMSIG(w) (w & 0377)
137 #ifndef WCOREDUMP
138 #define WCOREDUMP(w) ((w&0200) != 0)
139 #endif
140 #else
141 #ifdef BSD4_1
142 #include <wait.h>
143 #else
144 #include <sys/wait.h>
145 #endif /* not BSD 4.1 */
146
147 #define WAITTYPE union wait
148 #ifndef WRETCODE
149 #define WRETCODE(w) w.w_retcode
150 #endif
151 #ifndef WCOREDUMP
152 #define WCOREDUMP(w) w.w_coredump
153 #endif
154
155 #ifdef HPUX
156 /* HPUX version 7 has broken definitions of these. */
157 #undef WTERMSIG
158 #undef WSTOPSIG
159 #undef WIFSTOPPED
160 #undef WIFSIGNALED
161 #undef WIFEXITED
162 #endif
163
164 #ifndef WTERMSIG
165 #define WTERMSIG(w) w.w_termsig
166 #endif
167 #ifndef WSTOPSIG
168 #define WSTOPSIG(w) w.w_stopsig
169 #endif
170 #ifndef WIFSTOPPED
171 #define WIFSTOPPED(w) (WTERMSIG (w) == 0177)
172 #endif
173 #ifndef WIFSIGNALED
174 #define WIFSIGNALED(w) (WTERMSIG (w) != 0177 && (WSTOPSIG (w)) == 0)
175 #endif
176 #ifndef WIFEXITED
177 #define WIFEXITED(w) (WTERMSIG (w) == 0)
178 #endif
179 #endif /* BSD or UNIPLUS or STRIDE */
180 #endif /* no WAITTYPE */
181
182 #ifndef BSD4_4
183 extern errno;
184 extern sys_nerr;
185 extern char *sys_errlist[];
186 #endif
187
188 #ifndef BSD4_1
189 #ifndef BSD4_4
190 extern char *sys_siglist[];
191 #endif
192 #else
193 char *sys_siglist[] =
194 {
195 "bum signal!!",
196 "hangup",
197 "interrupt",
198 "quit",
199 "illegal instruction",
200 "trace trap",
201 "iot instruction",
202 "emt instruction",
203 "floating point exception",
204 "kill",
205 "bus error",
206 "segmentation violation",
207 "bad argument to system call",
208 "write on a pipe with no one to read it",
209 "alarm clock",
210 "software termination signal from kill",
211 "status signal",
212 "sendable stop signal not from tty",
213 "stop signal from tty",
214 "continue a stopped process",
215 "child status has changed",
216 "background read attempted from control tty",
217 "background write attempted from control tty",
218 "input record available at control tty",
219 "exceeded CPU time limit",
220 "exceeded file size limit"
221 };
222 #endif
223
224 #ifdef vipc
225
226 #include "vipc.h"
227 extern int comm_server;
228 extern int net_listen_address;
229 #endif /* vipc */
230
231 /* t means use pty, nil means use a pipe,
232 maybe other values to come. */
233 Lisp_Object Vprocess_connection_type;
234
235 #ifdef SKTPAIR
236 #ifndef HAVE_SOCKETS
237 #include <sys/socket.h>
238 #endif
239 #endif /* SKTPAIR */
240
241 /* Number of events of change of status of a process. */
242 int process_tick;
243
244 /* Number of events for which the user or sentinel has been notified. */
245 int update_tick;
246
247 int delete_exited_processes;
248
249 #ifdef FD_SET
250 /* We could get this from param.h, but better not to depend on finding that.
251 And better not to risk that it might define other symbols used in this
252 file. */
253 #define MAXDESC 64
254 #define SELECT_TYPE fd_set
255 #else /* no FD_SET */
256 #define MAXDESC 32
257 #define SELECT_TYPE int
258
259 /* Define the macros to access a single-int bitmap of descriptors. */
260 #define FD_SET(n, p) (*(p) |= (1 << (n)))
261 #define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
262 #define FD_ISSET(n, p) (*(p) & (1 << (n)))
263 #define FD_ZERO(p) (*(p) = 0)
264 #endif /* no FD_SET */
265
266 /* Mask of bits indicating the descriptors that we wait for input on */
267
268 SELECT_TYPE input_wait_mask;
269
270 /* Indexed by descriptor, gives the process (if any) for that descriptor */
271 Lisp_Object chan_process[MAXDESC];
272
273 /* Alist of elements (NAME . PROCESS) */
274 Lisp_Object Vprocess_alist;
275
276 Lisp_Object Qprocessp;
277
278 Lisp_Object get_process ();
279
280 /* Buffered-ahead input char from process, indexed by channel.
281 -1 means empty (no char is buffered).
282 Used on sys V where the only way to tell if there is any
283 output from the process is to read at least one char.
284 Always -1 on systems that support FIONREAD. */
285
286 int proc_buffered_char[MAXDESC];
287
288 /* These variables hold the filter about to be run, and its args,
289 between read_process_output and run_filter.
290 Also used in exec_sentinel for sentinels. */
291 Lisp_Object this_filter;
292 Lisp_Object filter_process, filter_string;
293
294 /* Compute the Lisp form of the process status, p->status,
295 from the numeric status that was returned by `wait'. */
296
297 update_status (p)
298 struct Lisp_Process *p;
299 {
300 union { int i; WAITTYPE wt; } u;
301 u.i = XFASTINT (p->raw_status_low) + (XFASTINT (p->raw_status_high) << 16);
302 p->status = status_convert (u.wt);
303 p->raw_status_low = Qnil;
304 p->raw_status_high = Qnil;
305 }
306
307 /* Convert a process status word in Unix format
308 to the list that we use internally. */
309
310 Lisp_Object
status_convert(w)311 status_convert (w)
312 WAITTYPE w;
313 {
314 if (WIFSTOPPED (w))
315 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
316 else if (WIFEXITED (w))
317 return Fcons (Qexit, Fcons (make_number (WRETCODE (w)),
318 WCOREDUMP (w) ? Qt : Qnil));
319 else if (WIFSIGNALED (w))
320 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
321 WCOREDUMP (w) ? Qt : Qnil));
322 else
323 return Qrun;
324 }
325
326 /* Given a status-list, extract the three pieces of information
327 and store them individually through the three pointers. */
328
329 void
decode_status(l,symbol,code,coredump)330 decode_status (l, symbol, code, coredump)
331 Lisp_Object l;
332 Lisp_Object *symbol;
333 int *code;
334 int *coredump;
335 {
336 Lisp_Object tem;
337
338 if (XTYPE (l) == Lisp_Symbol)
339 {
340 *symbol = l;
341 *code = 0;
342 *coredump = 0;
343 }
344 else
345 {
346 *symbol = XCONS (l)->car;
347 tem = XCONS (l)->cdr;
348 *code = XFASTINT (XCONS (tem)->car);
349 tem = XFASTINT (XCONS (tem)->cdr);
350 *coredump = !NULL (tem);
351 }
352 }
353
354 /* Return a string describing a process status list. */
355
356 Lisp_Object
status_message(status)357 status_message (status)
358 Lisp_Object status;
359 {
360 Lisp_Object symbol;
361 int code, coredump;
362 Lisp_Object string, string2;
363
364 decode_status (status, &symbol, &code, &coredump);
365
366 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
367 {
368 string = build_string (code < NSIG ? sys_siglist[code] : "unknown");
369 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
370 XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
371 return concat2 (string, string2);
372 }
373 else if (EQ (symbol, Qexit))
374 {
375 if (code == 0)
376 return build_string ("finished\n");
377 string = Fint_to_string (make_number (code));
378 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
379 return concat2 (build_string ("exited abnormally with code "),
380 concat2 (string, string2));
381 }
382 else
383 return Fcopy_sequence (Fsymbol_name (symbol));
384 }
385
386 #ifdef HAVE_PTYS
387
388 /* Open an available pty, returning a file descriptor.
389 Return -1 on failure.
390 The file name of the terminal corresponding to the pty
391 is left in the variable pty_name. */
392
393 char pty_name[24];
394
395 int
allocate_pty()396 allocate_pty ()
397 {
398 struct stat stb;
399 register c, i;
400 int fd;
401
402 #ifdef PTY_ITERATION
403 PTY_ITERATION
404 #else
405 for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
406 for (i = 0; i < 16; i++)
407 #endif
408 {
409 #ifdef PTY_NAME_SPRINTF
410 PTY_NAME_SPRINTF
411 #else
412 #ifdef HPUX
413 sprintf (pty_name, "/dev/ptym/pty%c%x", c, i);
414 #else
415 #ifdef RTU
416 sprintf (pty_name, "/dev/pty%x", i);
417 #else
418 sprintf (pty_name, "/dev/pty%c%x", c, i);
419 #endif /* not RTU */
420 #endif /* not HPUX */
421 #endif /* no PTY_NAME_SPRINTF */
422
423 #ifndef IRIS
424 if (stat (pty_name, &stb) < 0)
425 return -1;
426 #ifdef O_NONBLOCK
427 fd = open (pty_name, O_RDWR | O_NONBLOCK, 0);
428 #else
429 fd = open (pty_name, O_RDWR | O_NDELAY, 0);
430 #endif
431 #else /* Unusual IRIS code */
432 fd = open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
433 if (fd < 0)
434 return -1;
435 if (fstat (fd, &stb) < 0)
436 return -1;
437 #endif /* IRIS */
438
439 if (fd >= 0)
440 {
441 /* check to make certain that both sides are available
442 this avoids a nasty yet stupid bug in rlogins */
443 #ifdef PTY_TTY_NAME_SPRINTF
444 PTY_TTY_NAME_SPRINTF
445 #else
446 /* In version 19, make these special cases use the macro above. */
447 #ifdef HPUX
448 sprintf (pty_name, "/dev/pty/tty%c%x", c, i);
449 #else
450 #ifdef RTU
451 sprintf (pty_name, "/dev/ttyp%x", i);
452 #else
453 #ifdef IRIS
454 sprintf (pty_name, "/dev/ttyq%d", minor (stb.st_rdev));
455 #else
456 sprintf (pty_name, "/dev/tty%c%x", c, i);
457 #endif /* not IRIS */
458 #endif /* not RTU */
459 #endif /* not HPUX */
460 #endif /* no PTY_TTY_NAME_SPRINTF */
461 #ifndef UNIPLUS
462 if (access (pty_name, 6) != 0)
463 {
464 close (fd);
465 #ifndef IRIS
466 continue;
467 #else
468 return -1;
469 #endif /* IRIS */
470 }
471 #endif /* not UNIPLUS */
472 setup_pty (fd);
473 return fd;
474 }
475 }
476 return -1;
477 }
478 #endif /* HAVE_PTYS */
479
480 Lisp_Object
make_process(name)481 make_process (name)
482 Lisp_Object name;
483 {
484 register Lisp_Object val, tem, name1;
485 register struct Lisp_Process *p;
486 char suffix[10];
487 register int i;
488
489 /* size of process structure includes the vector header,
490 so deduct for that. But struct Lisp_Vector includes the first
491 element, thus deducts too much, so add it back. */
492 val = Fmake_vector (make_number ((sizeof (struct Lisp_Process)
493 - sizeof (struct Lisp_Vector)
494 + sizeof (Lisp_Object))
495 / sizeof (Lisp_Object)),
496 Qnil);
497 XSETTYPE (val, Lisp_Process);
498
499 p = XPROCESS (val);
500 XFASTINT (p->infd) = 0;
501 XFASTINT (p->outfd) = 0;
502 XFASTINT (p->pid) = 0;
503 XFASTINT (p->tick) = 0;
504 XFASTINT (p->update_tick) = 0;
505 p->raw_status_low = Qnil;
506 p->raw_status_high = Qnil;
507 p->status = Qrun;
508 p->mark = Fmake_marker ();
509
510 /* If name is already in use, modify it until it is unused. */
511
512 name1 = name;
513 for (i = 1; ; i++)
514 {
515 tem = Fget_process (name1);
516 if (NULL (tem)) break;
517 sprintf (suffix, "<%d>", i);
518 name1 = concat2 (name, build_string (suffix));
519 }
520 name = name1;
521 p->name = name;
522 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
523 return val;
524 }
525
remove_process(proc)526 remove_process (proc)
527 register Lisp_Object proc;
528 {
529 register Lisp_Object pair;
530
531 pair = Frassq (proc, Vprocess_alist);
532 Vprocess_alist = Fdelq (pair, Vprocess_alist);
533 Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil);
534
535 deactivate_process (proc);
536 }
537
538 DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
539 "Return t if OBJECT is a process.")
540 (obj)
541 Lisp_Object obj;
542 {
543 return XTYPE (obj) == Lisp_Process ? Qt : Qnil;
544 }
545
546 DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
547 "Return the process named NAME, or nil if there is none.")
548 (name)
549 register Lisp_Object name;
550 {
551 if (XTYPE (name) == Lisp_Process)
552 return name;
553 CHECK_STRING (name, 0);
554 return Fcdr (Fassoc (name, Vprocess_alist));
555 }
556
557 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
558 "Return the (or, a) process associated with BUFFER.\n\
559 BUFFER may be a buffer or the name of one.")
560 (name)
561 register Lisp_Object name;
562 {
563 register Lisp_Object buf, tail, proc;
564
565 if (NULL (name)) return Qnil;
566 buf = Fget_buffer (name);
567 if (NULL (buf)) return Qnil;
568
569 for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
570 {
571 proc = Fcdr (Fcar (tail));
572 if (XTYPE (proc) == Lisp_Process && EQ (XPROCESS (proc)->buffer, buf))
573 return proc;
574 }
575 return Qnil;
576 }
577
578 /* This is how commands for the user decode process arguments */
579
580 Lisp_Object
get_process(name)581 get_process (name)
582 register Lisp_Object name;
583 {
584 register Lisp_Object proc;
585 if (NULL (name))
586 proc = Fget_buffer_process (Fcurrent_buffer ());
587 else
588 {
589 proc = Fget_process (name);
590 if (NULL (proc))
591 proc = Fget_buffer_process (Fget_buffer (name));
592 }
593
594 if (!NULL (proc))
595 return proc;
596
597 if (NULL (name))
598 error ("Current buffer has no process");
599 else
600 error ("Process %s does not exist", XSTRING (name)->data);
601 /* NOTREACHED */
602 }
603
604 DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
605 "Delete PROCESS: kill it and forget about it immediately.\n\
606 PROCESS may be a process or the name of one, or a buffer name.")
607 (proc)
608 register Lisp_Object proc;
609 {
610 proc = get_process (proc);
611 XPROCESS (proc)->raw_status_low = Qnil;
612 XPROCESS (proc)->raw_status_high = Qnil;
613 if (NETCONN_P (proc))
614 {
615 XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
616 XSETINT (XPROCESS (proc)->tick, ++process_tick);
617 }
618 else if (XFASTINT (XPROCESS (proc)->infd))
619 {
620 Fkill_process (proc, Qnil);
621 /* Do this now, since remove_process will make sigchld_handler do nothing. */
622 XPROCESS (proc)->status
623 = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
624 XSETINT (XPROCESS (proc)->tick, ++process_tick);
625 status_notify ();
626 }
627 remove_process (proc);
628 return Qnil;
629 }
630
631 DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
632 "Return the status of PROCESS: a symbol, one of these:\n\
633 run -- for a process that is running.\n\
634 stop -- for a process stopped but continuable.\n\
635 exit -- for a process that has exited.\n\
636 signal -- for a process that has got a fatal signal.\n\
637 open -- for a network stream connection that is open.\n\
638 closed -- for a network stream connection that is closed.\n\
639 nil -- if arg is a process name and no such process exists.")
640 /* command -- for a command channel opened to Emacs by another process.\n\
641 external -- for an i/o channel opened to Emacs by another process.\n\ */
642 (proc)
643 register Lisp_Object proc;
644 {
645 register struct Lisp_Process *p;
646 proc = Fget_process (proc);
647 if (NULL (proc))
648 return proc;
649 p = XPROCESS (proc);
650 if (!NULL (p->raw_status_low))
651 update_status (p);
652 if (XTYPE (p->status) == Lisp_Cons)
653 return XCONS (p->status)->car;
654 return p->status;
655 }
656
657 DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
658 1, 1, 0,
659 "Return the exit status of PROCESS or the signal number that killed it.\n\
660 If PROCESS has not yet exited or died, return 0.")
661 (proc)
662 register Lisp_Object proc;
663 {
664 CHECK_PROCESS (proc, 0);
665 if (!NULL (XPROCESS (proc)->raw_status_low))
666 update_status (XPROCESS (proc));
667 if (XTYPE (XPROCESS (proc)->status) == Lisp_Cons)
668 return XCONS (XCONS (XPROCESS (proc)->status)->cdr)->car;
669 return make_number (0);
670 }
671
672 DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
673 "Return the process id of PROCESS.\n\
674 This is the pid of the Unix process which PROCESS uses or talks to.\n\
675 For a network connection, this value is nil.")
676 (proc)
677 register Lisp_Object proc;
678 {
679 CHECK_PROCESS (proc, 0);
680 return XPROCESS (proc)->pid;
681 }
682
683 DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
684 "Return the name of PROCESS, as a string.\n\
685 This is the name of the program invoked in PROCESS,\n\
686 possibly modified to make it unique among process names.")
687 (proc)
688 register Lisp_Object proc;
689 {
690 CHECK_PROCESS (proc, 0);
691 return XPROCESS (proc)->name;
692 }
693
694 DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
695 "Return the command that was executed to start PROCESS.\n\
696 This is a list of strings, the first string being the program executed\n\
697 and the rest of the strings being the arguments given to it.\n\
698 For a non-child channel, this is nil.")
699 (proc)
700 register Lisp_Object proc;
701 {
702 CHECK_PROCESS (proc, 0);
703 return XPROCESS (proc)->command;
704 }
705
706 DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
707 2, 2, 0,
708 "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
709 (proc, buffer)
710 register Lisp_Object proc, buffer;
711 {
712 CHECK_PROCESS (proc, 0);
713 if (!NULL (buffer))
714 CHECK_BUFFER (buffer, 1);
715 XPROCESS (proc)->buffer = buffer;
716 return buffer;
717 }
718
719 DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
720 1, 1, 0,
721 "Return the buffer PROCESS is associated with.\n\
722 Output from PROCESS is inserted in this buffer\n\
723 unless PROCESS has a filter.")
724 (proc)
725 register Lisp_Object proc;
726 {
727 CHECK_PROCESS (proc, 0);
728 return XPROCESS (proc)->buffer;
729 }
730
731 DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
732 1, 1, 0,
733 "Return the marker for the end of the last output from PROCESS.")
734 (proc)
735 register Lisp_Object proc;
736 {
737 CHECK_PROCESS (proc, 0);
738 return XPROCESS (proc)->mark;
739 }
740
741 DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
742 2, 2, 0,
743 "Give PROCESS the filter function FILTER; nil means no filter.\n\
744 When a process has a filter, each time it does output\n\
745 the entire string of output is passed to the filter.\n\
746 The filter gets two arguments: the process and the string of output.\n\
747 If the process has a filter, its buffer is not used for output.")
748 (proc, filter)
749 register Lisp_Object proc, filter;
750 {
751 CHECK_PROCESS (proc, 0);
752 XPROCESS (proc)->filter = filter;
753 return filter;
754 }
755
756 DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
757 1, 1, 0,
758 "Returns the filter function of PROCESS; nil if none.\n\
759 See set-process-filter for more info on filter functions.")
760 (proc)
761 register Lisp_Object proc;
762 {
763 CHECK_PROCESS (proc, 0);
764 return XPROCESS (proc)->filter;
765 }
766
767 DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
768 2, 2, 0,
769 "Give PROCESS the sentinel SENTINEL; nil for none.\n\
770 The sentinel is called as a function when the process changes state.\n\
771 It gets two arguments: the process, and a string describing the change.")
772 (proc, sentinel)
773 register Lisp_Object proc, sentinel;
774 {
775 CHECK_PROCESS (proc, 0);
776 XPROCESS (proc)->sentinel = sentinel;
777 return sentinel;
778 }
779
780 DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
781 1, 1, 0,
782 "Return the sentinel of PROCESS; nil if none.\n\
783 See set-process-sentinel for more info on sentinels.")
784 (proc)
785 register Lisp_Object proc;
786 {
787 CHECK_PROCESS (proc, 0);
788 return XPROCESS (proc)->sentinel;
789 }
790
791 DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
792 Sprocess_kill_without_query, 1, 2, 0,
793 "Say no query needed if PROCESS is running when Emacs is exited.\n\
794 Optional second argument if non-nil says to require a query.\n\
795 Value is t if a query was formerly required.")
796 (proc, value)
797 register Lisp_Object proc, value;
798 {
799 Lisp_Object tem;
800 CHECK_PROCESS (proc, 0);
801 tem = XPROCESS (proc)->kill_without_query;
802 XPROCESS (proc)->kill_without_query = Fnull (value);
803 return Fnull (tem);
804 }
805
806 Lisp_Object
list_processes_1()807 list_processes_1 ()
808 {
809 register Lisp_Object tail, tem;
810 Lisp_Object proc, minspace, tem1;
811 register struct buffer *old = current_buffer;
812 register struct Lisp_Process *p;
813 register int state;
814 char tembuf[80];
815
816 XFASTINT (minspace) = 1;
817
818 set_buffer_internal (XBUFFER (Vstandard_output));
819 Fbuffer_flush_undo (Vstandard_output);
820
821 current_buffer->truncate_lines = Qt;
822
823 write_string ("\
824 Proc Status Buffer Command\n\
825 ---- ------ ------ -------\n", -1);
826
827 for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
828 {
829 Lisp_Object symbol;
830
831 proc = Fcdr (Fcar (tail));
832 p = XPROCESS (proc);
833 if (NULL (p->childp))
834 continue;
835
836 Finsert (1, &p->name);
837 Findent_to (make_number (13), minspace);
838
839 if (!NULL (p->raw_status_low))
840 update_status (p);
841 symbol = p->status;
842 if (XTYPE (p->status) == Lisp_Cons)
843 symbol = XCONS (p->status)->car;
844
845 if (EQ (symbol, Qsignal))
846 {
847 Lisp_Object tem;
848 tem = Fcar (Fcdr (p->status));
849 if (XINT (tem) < NSIG)
850 write_string (sys_siglist [XINT (tem)], -1);
851 else
852 Fprinc (symbol, Qnil);
853 }
854 else
855 Fprinc (symbol, Qnil);
856
857 if (EQ (symbol, Qexit))
858 {
859 Lisp_Object tem;
860 tem = Fcar (Fcdr (p->status));
861 if (XFASTINT (tem))
862 {
863 sprintf (tembuf, " %d", XFASTINT (tem));
864 write_string (tembuf, -1);
865 }
866 }
867
868 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
869 remove_process (proc);
870
871 Findent_to (make_number (22), minspace);
872 if (NULL (p->buffer))
873 InsStr ("(none)");
874 else if (NULL (XBUFFER (p->buffer)->name))
875 InsStr ("(Killed)");
876 else
877 Finsert (1, &XBUFFER (p->buffer)->name);
878
879 Findent_to (make_number (37), minspace);
880
881 if (NETCONN_P (proc))
882 {
883 sprintf (tembuf, "(network stream connection to %s)\n",
884 XSTRING (p->childp)->data);
885 InsStr (tembuf);
886 }
887 else
888 {
889 tem = p->command;
890 while (1)
891 {
892 tem1 = Fcar (tem);
893 Finsert (1, &tem1);
894 tem = Fcdr (tem);
895 if (NULL (tem))
896 break;
897 InsStr (" ");
898 }
899 InsStr ("\n");
900 }
901 }
902
903 return Qnil;
904 }
905
906 DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",
907 "Display a list of all processes.\n\
908 \(Any processes listed as Exited or Signaled are actually eliminated\n\
909 after the listing is made.)")
910 ()
911 {
912 internal_with_output_to_temp_buffer ("*Process List*",
913 list_processes_1, Qnil);
914 return Qnil;
915 }
916
917 DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
918 "Return a list of all processes.")
919 ()
920 {
921 return Fmapcar (Qcdr, Vprocess_alist);
922 }
923
924 DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
925 "Start a program in a subprocess. Return the process object for it.\n\
926 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
927 NAME is name for process. It is modified if necessary to make it unique.\n\
928 BUFFER is the buffer or (buffer-name) to associate with the process.\n\
929 Process output goes at end of that buffer, unless you specify\n\
930 an output stream or filter function to handle the output.\n\
931 BUFFER may be also nil, meaning that this process is not associated\n\
932 with any buffer\n\
933 Third arg is program file name. It is searched for as in the shell.\n\
934 Remaining arguments are strings to give program as arguments.")
935 (nargs, args)
936 int nargs;
937 register Lisp_Object *args;
938 {
939 Lisp_Object buffer, name, program, proc, tem;
940 register unsigned char **new_argv;
941 register int i;
942
943 buffer = args[1];
944 if (!NULL (buffer))
945 buffer = Fget_buffer_create (buffer);
946
947 name = args[0];
948 CHECK_STRING (name, 0);
949
950 program = args[2];
951
952 CHECK_STRING (program, 2);
953
954 new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
955
956 for (i = 3; i < nargs; i++)
957 {
958 tem = args[i];
959 CHECK_STRING (tem, i);
960 new_argv[i - 2] = XSTRING (tem)->data;
961 }
962 new_argv[i - 2] = 0;
963 new_argv[0] = XSTRING (program)->data;
964
965 /* If program file name is not absolute, search our path for it */
966 if (new_argv[0][0] != '/')
967 {
968 tem = Qnil;
969 openp (Vexec_path, program, "", &tem, 1);
970 if (NULL (tem))
971 report_file_error ("Searching for program", Fcons (program, Qnil));
972 new_argv[0] = XSTRING (tem)->data;
973 }
974
975 proc = make_process (name);
976
977 XPROCESS (proc)->childp = Qt;
978 XPROCESS (proc)->command_channel_p = Qnil;
979 XPROCESS (proc)->buffer = buffer;
980 XPROCESS (proc)->sentinel = Qnil;
981 XPROCESS (proc)->filter = Qnil;
982 XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
983
984 create_process (proc, new_argv);
985
986 return proc;
987 }
988
create_process_1(signo)989 create_process_1 (signo)
990 int signo;
991 {
992 #ifdef USG
993 /* USG systems forget handlers when they are used;
994 must reestablish each time */
995 signal (signo, create_process_1);
996 #endif /* USG */
997 }
998
999 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1000 #ifdef USG
1001 #ifdef SIGCHLD
1002 /* Mimic blocking of signals on system V, which doesn't really have it. */
1003
1004 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1005 int sigchld_deferred;
1006
1007 create_process_sigchld ()
1008 {
1009 signal (SIGCHLD, create_process_sigchld);
1010
1011 sigchld_deferred = 1;
1012 }
1013 #endif
1014 #endif
1015 #endif
1016
create_process(process,new_argv)1017 create_process (process, new_argv)
1018 Lisp_Object process;
1019 char **new_argv;
1020 {
1021 int pid, inchannel, outchannel, forkin, forkout;
1022 int sv[2];
1023 #ifdef SIGCHLD
1024 int (*sigchld)();
1025 #endif
1026 char **env;
1027 int pty_flag = 0;
1028 extern char **environ;
1029
1030 #ifdef MAINTAIN_ENVIRONMENT
1031 env = (char **) alloca (size_of_current_environ ());
1032 get_current_environ (env);
1033 #else
1034 env = environ;
1035 #endif /* MAINTAIN_ENVIRONMENT */
1036
1037 inchannel = outchannel = -1;
1038
1039 #ifdef HAVE_PTYS
1040 if (EQ (Vprocess_connection_type, Qt))
1041 outchannel = inchannel = allocate_pty ();
1042
1043 if (inchannel >= 0)
1044 {
1045 #ifndef USG
1046 /* On USG systems it does not work to open
1047 the pty's tty here and then close and reopen it in the child. */
1048 forkout = forkin = open (pty_name, O_RDWR, 0);
1049 if (forkin < 0)
1050 report_file_error ("Opening pty", Qnil);
1051 #else
1052 forkin = forkout = -1;
1053 #endif
1054 pty_flag = 1;
1055 }
1056 else
1057 #endif /* HAVE_PTYS */
1058 #ifdef SKTPAIR
1059 {
1060 if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0)
1061 report_file_error ("Opening socketpair", Qnil);
1062 outchannel = inchannel = sv[0];
1063 forkout = forkin = sv[1];
1064 }
1065 #else /* not SKTPAIR */
1066 {
1067 pipe (sv);
1068 inchannel = sv[0];
1069 forkout = sv[1];
1070 pipe (sv);
1071 outchannel = sv[1];
1072 forkin = sv[0];
1073 }
1074 #endif /* not SKTPAIR */
1075
1076 #if 0
1077 /* Replaced by close_process_descs */
1078 set_exclusive_use (inchannel);
1079 set_exclusive_use (outchannel);
1080 #endif
1081
1082 /* Stride people say it's a mystery why this is needed
1083 as well as the O_NDELAY, but that it fails without this. */
1084 #ifdef STRIDE
1085 {
1086 int one = 1;
1087 ioctl (inchannel, FIONBIO, &one);
1088 }
1089 #endif
1090
1091 #ifdef O_NONBLOCK
1092 fcntl (inchannel, F_SETFL, O_NONBLOCK);
1093 #else
1094 #ifdef O_NDELAY
1095 fcntl (inchannel, F_SETFL, O_NDELAY);
1096 #endif
1097 #endif
1098
1099 /* Record this as an active process, with its channels.
1100 As a result, child_setup will close Emacs's side of the pipes. */
1101 chan_process[inchannel] = process;
1102 XFASTINT (XPROCESS (process)->infd) = inchannel;
1103 XFASTINT (XPROCESS (process)->outfd) = outchannel;
1104 XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
1105 XPROCESS (process)->status = Qrun;
1106
1107 /* Delay interrupts until we have a chance to store
1108 the new fork's pid in its process structure */
1109 #ifdef SIGCHLD
1110 #ifdef BSD4_1
1111 sighold (SIGCHLD);
1112 #else /* not BSD4_1 */
1113 #ifdef HPUX
1114 sigsetmask (1 << (SIGCHLD - 1));
1115 #else /* not HPUX */
1116 #if defined (BSD) || defined (UNIPLUS)
1117 sigsetmask (1 << (SIGCHLD - 1));
1118 #else /* ordinary USG */
1119 #if 0
1120 sigchld_deferred = 0;
1121 sigchld = (int (*)()) signal (SIGCHLD, create_process_sigchld);
1122 #endif
1123 #endif /* ordinary USG */
1124 #endif /* not HPUX */
1125 #endif /* not BSD4_1 */
1126 #endif /* SIGCHLD */
1127
1128 /* Until we store the proper pid, enable sigchld_handler
1129 to recognize an unknown pid as standing for this process. */
1130 XSETINT (XPROCESS (process)->pid, -1);
1131
1132 {
1133 /* child_setup must clobber environ on systems with true vfork.
1134 Protect it from permanent change. */
1135 char **save_environ = environ;
1136
1137 pid = vfork ();
1138 if (pid == 0)
1139 {
1140 int xforkin = forkin;
1141 int xforkout = forkout;
1142
1143 #if 0 /* This was probably a mistake--it duplicates code later on,
1144 but fails to handle all the cases. */
1145 /* Make SIGCHLD work again in the child. */
1146 sigsetmask (0);
1147 #endif
1148
1149 /* Make the pty be the controlling terminal of the process. */
1150 #ifdef HAVE_PTYS
1151 /* First, disconnect its current controlling terminal. */
1152 #ifdef HAVE_SETSID
1153 setsid ();
1154 #ifdef TIOCSCTTY
1155 /* Make the pty's terminal the controlling terminal. */
1156 if (pty_flag && (ioctl (xforkin, TIOCSCTTY, 0) < 0))
1157 abort ();
1158 #endif
1159 #else /* not HAVE_SETSID */
1160 #ifdef USG
1161 /* It's very important to call setpgrp() here and no time
1162 afterwards. Otherwise, we lose our controlling tty which
1163 is set when we open the pty. */
1164 setpgrp ();
1165 #endif /* USG */
1166 #endif /* not HAVE_SETSID */
1167 #ifdef TIOCNOTTY
1168 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1169 can do TIOCSPGRP only to the process's controlling tty. */
1170 if (pty_flag)
1171 {
1172 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1173 I can't test it since I don't have 4.3. */
1174 int j = open ("/dev/tty", O_RDWR, 0);
1175 ioctl (j, TIOCNOTTY, 0);
1176 close (j);
1177 #ifndef USG
1178 /* In order to get a controlling terminal on some versions
1179 of BSD, it is necessary to put the process in pgrp 0
1180 before it opens the terminal. */
1181 setpgrp (0, 0);
1182 #endif
1183 }
1184 #endif /* TIOCNOTTY */
1185
1186 #if !defined (RTU) && !defined (UNIPLUS)
1187 /*** There is a suggestion that this ought to be a
1188 conditional on TIOCSPGRP. */
1189 /* Now close the pty (if we had it open) and reopen it.
1190 This makes the pty the controlling terminal of the subprocess. */
1191 if (pty_flag)
1192 {
1193 /* I wonder if close (open (pty_name, ...)) would work? */
1194 if (xforkin >= 0)
1195 close (xforkin);
1196 xforkout = xforkin = open (pty_name, O_RDWR, 0);
1197
1198 if (xforkin < 0)
1199 abort ();
1200 }
1201 #endif /* not UNIPLUS and not RTU */
1202 #ifdef SETUP_SLAVE_PTY
1203 SETUP_SLAVE_PTY;
1204 #endif /* SETUP_SLAVE_PTY */
1205 #ifdef AIX
1206 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1207 Now reenable it in the child, so it will die when we want it to. */
1208 if (pty_flag)
1209 signal (SIGHUP, SIG_DFL);
1210 #endif
1211 #endif /* HAVE_PTYS */
1212 #ifdef SIGCHLD
1213 #ifdef BSD4_1
1214 sigrelse (SIGCHLD);
1215 #else /* not BSD4_1 */
1216 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1217 sigsetmask (0);
1218 #else /* ordinary USG */
1219 signal (SIGCHLD, sigchld);
1220 #endif /* ordinary USG */
1221 #endif /* not BSD4_1 */
1222 #endif /* SIGCHLD */
1223 child_setup_tty (xforkout);
1224 child_setup (xforkin, xforkout, xforkout, new_argv, env);
1225 }
1226 environ = save_environ;
1227 }
1228
1229 if (pid < 0)
1230 {
1231 remove_process (process);
1232 report_file_error ("Doing vfork", Qnil);
1233 }
1234
1235 XFASTINT (XPROCESS (process)->pid) = pid;
1236
1237 FD_SET (inchannel, &input_wait_mask);
1238
1239 /* If the subfork execv fails, and it exits,
1240 this close hangs. I don't know why.
1241 So have an interrupt jar it loose. */
1242 stop_polling ();
1243 signal (SIGALRM, create_process_1);
1244 alarm (1);
1245 if (forkin >= 0)
1246 close (forkin);
1247 alarm (0);
1248 start_polling ();
1249 if (forkin != forkout && forkout >= 0)
1250 close (forkout);
1251
1252 #ifdef SIGCHLD
1253 #ifdef BSD4_1
1254 sigrelse (SIGCHLD);
1255 #else /* not BSD4_1 */
1256 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1257 sigsetmask (0);
1258 #else /* ordinary USG */
1259 #if 0
1260 signal (SIGCHLD, sigchld);
1261 /* Now really handle any of these signals
1262 that came in during this function. */
1263 if (sigchld_deferred)
1264 kill (getpid (), SIGCHLD);
1265 #endif
1266 #endif /* ordinary USG */
1267 #endif /* not BSD4_1 */
1268 #endif /* SIGCHLD */
1269 }
1270
1271 #ifdef HAVE_SOCKETS
1272
1273 /* open a TCP network connection to a given HOST/SERVICE. Treated
1274 exactly like a normal process when reading and writing. Only
1275 differences are in status display and process deletion. A network
1276 connection has no PID; you cannot signal it. All you can do is
1277 deactivate and close it via delete-process */
1278
1279 DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,
1280 4, 4, 0,
1281 "Open a TCP connection for a service to a host.\n\
1282 Returns a subprocess-object to represent the connection.\n\
1283 Input and output work as for subprocesses; `delete-process' closes it.\n\
1284 Args are NAME BUFFER HOST SERVICE.\n\
1285 NAME is name for process. It is modified if necessary to make it unique.\n\
1286 BUFFER is the buffer (or buffer-name) to associate with the process.\n\
1287 Process output goes at end of that buffer, unless you specify\n\
1288 an output stream or filter function to handle the output.\n\
1289 BUFFER may be also nil, meaning that this process is not associated\n\
1290 with any buffer\n\
1291 Third arg is name of the host to connect to.\n\
1292 Fourth arg SERVICE is name of the service desired, or an integer\n\
1293 specifying a port number to connect to.")
1294 (name, buffer, host, service)
1295 Lisp_Object name, buffer, host, service;
1296 {
1297 Lisp_Object proc;
1298 register int i;
1299 struct sockaddr_in address;
1300 struct servent *svc_info;
1301 struct hostent *host_info;
1302 int s, outch, inch;
1303 char errstring[80];
1304 int port;
1305 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1306
1307 GCPRO4 (name, buffer, host, service);
1308 CHECK_STRING (name, 0);
1309 CHECK_STRING (host, 0);
1310 if (XTYPE(service) == Lisp_Int)
1311 port = htons ((unsigned short) XINT (service));
1312 else
1313 {
1314 CHECK_STRING (service, 0);
1315 svc_info = getservbyname (XSTRING (service)->data, "tcp");
1316 if (svc_info == 0)
1317 error ("Unknown service \"%s\"", XSTRING (service)->data);
1318 port = svc_info->s_port;
1319 }
1320
1321 host_info = gethostbyname (XSTRING (host)->data);
1322 if (host_info == 0)
1323 error ("Unknown host \"%s\"", XSTRING(host)->data);
1324
1325 bzero (&address, sizeof address);
1326 bcopy (host_info->h_addr, (char *) &address.sin_addr, host_info->h_length);
1327 address.sin_family = host_info->h_addrtype;
1328 address.sin_port = port;
1329
1330 s = socket (host_info->h_addrtype, SOCK_STREAM, 0);
1331 if (s < 0)
1332 report_file_error ("error creating socket", Fcons (name, Qnil));
1333
1334 if (connect (s, &address, sizeof address) == -1)
1335 {
1336 close (s);
1337 error ("Host \"%s\" not responding", XSTRING (host)->data);
1338 }
1339
1340 inch = s;
1341 outch = dup (s);
1342 if (outch < 0)
1343 report_file_error ("error duplicating socket", Fcons (name, Qnil));
1344
1345 if (!NULL (buffer))
1346 buffer = Fget_buffer_create (buffer);
1347 proc = make_process (name);
1348
1349 chan_process[inch] = proc;
1350
1351 #ifdef O_NONBLOCK
1352 fcntl (inch, F_SETFL, O_NONBLOCK);
1353 #else
1354 #ifdef O_NDELAY
1355 fcntl (inch, F_SETFL, O_NDELAY);
1356 #endif
1357 #endif
1358
1359 XPROCESS (proc)->childp = host;
1360 XPROCESS (proc)->command_channel_p = Qnil;
1361 XPROCESS (proc)->buffer = buffer;
1362 XPROCESS (proc)->sentinel = Qnil;
1363 XPROCESS (proc)->filter = Qnil;
1364 XPROCESS (proc)->command = Qnil;
1365 XPROCESS (proc)->pid = Qnil;
1366 XPROCESS (proc)->kill_without_query = Qt;
1367 XFASTINT (XPROCESS (proc)->infd) = s;
1368 XFASTINT (XPROCESS (proc)->outfd) = outch;
1369 XPROCESS (proc)->status = Qrun;
1370 FD_SET (inch, &input_wait_mask);
1371
1372 UNGCPRO;
1373 return proc;
1374 }
1375 #endif /* HAVE_SOCKETS */
1376
deactivate_process(proc)1377 deactivate_process (proc)
1378 Lisp_Object proc;
1379 {
1380 register int inchannel, outchannel;
1381 register struct Lisp_Process *p = XPROCESS (proc);
1382
1383 inchannel = XFASTINT (p->infd);
1384 outchannel = XFASTINT (p->outfd);
1385
1386 if (inchannel)
1387 {
1388 /* Beware SIGCHLD hereabouts. */
1389 flush_pending_output (inchannel);
1390 close (inchannel);
1391 if (outchannel && outchannel != inchannel)
1392 close (outchannel);
1393
1394 XFASTINT (p->infd) = 0;
1395 XFASTINT (p->outfd) = 0;
1396 chan_process[inchannel] = Qnil;
1397 FD_CLR (inchannel, &input_wait_mask);
1398 }
1399 }
1400
1401 /* Close all descriptors currently in use for communication
1402 with subprocess. This is used in a newly-forked subprocess
1403 to get rid of irrelevant descriptors. */
1404
close_process_descs()1405 close_process_descs ()
1406 {
1407 int i;
1408 for (i = 0; i < MAXDESC; i++)
1409 {
1410 Lisp_Object process;
1411 process = chan_process[i];
1412 if (!NULL (process))
1413 {
1414 int in = XFASTINT (XPROCESS (process)->infd);
1415 int out = XFASTINT (XPROCESS (process)->outfd);
1416 close (in);
1417 if (in != out)
1418 close (out);
1419 }
1420 }
1421 }
1422
1423 DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
1424 0, 1, 0,
1425 "Allow any pending output from subprocesses to be read by Emacs.\n\
1426 It is read into the process' buffers or given to their filter functions.\n\
1427 Non-nil arg PROCESS means do not return until some output has been received\n\
1428 from PROCESS.")
1429 (proc)
1430 register Lisp_Object proc;
1431 {
1432 if (NULL (proc))
1433 wait_reading_process_input (-1, 0, 0);
1434 else
1435 {
1436 proc = get_process (proc);
1437 wait_reading_process_input (0, XPROCESS (proc), 0);
1438 }
1439 return Qnil;
1440 }
1441
1442 /* This variable is different from waiting_for_input in keyboard.c.
1443 It is used to communicate to a lisp process-filter/sentinel (via the
1444 function Fwaiting_for_user_input_p below) whether emacs was waiting
1445 for user-input when that process-filter was called.
1446 waiting_for_input cannot be used as that is by definition 0 when
1447 lisp code is being evalled */
1448 static int waiting_for_user_input_p;
1449
1450 /* Read and dispose of subprocess output
1451 while waiting for timeout to elapse and/or keyboard input to be available.
1452
1453 time_limit is the timeout in seconds, or zero for no limit.
1454 -1 means gobble data available immediately but don't wait for any.
1455
1456 read_kbd is 1 to return when input is available.
1457 -1 means caller will actually read the input.
1458 A pointer to a struct Lisp_Process means wait until
1459 something arrives from that process.
1460
1461 do_display means redisplay should be done to show
1462 subprocess output that arrives. */
1463
wait_reading_process_input(time_limit,read_kbd,do_display)1464 wait_reading_process_input (time_limit, read_kbd, do_display)
1465 int time_limit, read_kbd, do_display;
1466 {
1467 register int channel, nfds, m;
1468 SELECT_TYPE Available;
1469 SELECT_TYPE Exception;
1470 int xerrno;
1471 Lisp_Object proc;
1472 #ifdef HAVE_TIMEVAL
1473 struct timeval timeout, end_time, garbage;
1474 #else
1475 long timeout, end_time, temp;
1476 #endif /* not HAVE_TIMEVAL */
1477 SELECT_TYPE Atemp;
1478 int wait_channel = 0;
1479 struct Lisp_Process *wait_proc = 0;
1480 extern kbd_count;
1481
1482 /* Detect when read_kbd is really the address of a Lisp_Process. */
1483 if (read_kbd > 10 || read_kbd < -1)
1484 {
1485 wait_proc = (struct Lisp_Process *) read_kbd;
1486 wait_channel = XFASTINT (wait_proc->infd);
1487 read_kbd = 0;
1488 }
1489 waiting_for_user_input_p = read_kbd;
1490
1491 /* Since we may need to wait several times,
1492 compute the absolute time to return at. */
1493 if (time_limit)
1494 {
1495 #ifdef HAVE_TIMEVAL
1496 gettimeofday (&end_time, &garbage);
1497 end_time.tv_sec += time_limit;
1498 #else /* not HAVE_TIMEVAL */
1499 time (&end_time);
1500 end_time += time_limit;
1501 #endif /* not HAVE_TIMEVAL */
1502 }
1503
1504 #if 0 /* Select emulator claims to preserve alarms.
1505 And there are many ways to get out of this function by longjmp. */
1506 /* Turn off periodic alarms (in case they are in use)
1507 because the select emulator uses alarms. */
1508 stop_polling ();
1509 #endif
1510
1511 while (1)
1512 {
1513 /* If calling from keyboard input, do not quit
1514 since we want to return C-g as an input character.
1515 Otherwise, do pending quit if requested. */
1516 if (read_kbd >= 0)
1517 {
1518 #if 0
1519 /* This is the same condition tested by QUIT.
1520 We need to resume polling if we are going to quit. */
1521 if (!NULL (Vquit_flag) && NULL (Vinhibit_quit))
1522 {
1523 start_polling ();
1524 QUIT;
1525 }
1526 #endif
1527 QUIT;
1528 }
1529
1530 /* If status of something has changed, and no input is available,
1531 notify the user of the change right away */
1532 if (update_tick != process_tick && do_display)
1533 {
1534 Atemp = input_wait_mask;
1535 #ifdef HAVE_TIMEVAL
1536 timeout.tv_sec=0; timeout.tv_usec=0;
1537 #else /* not HAVE_TIMEVAL */
1538 timeout = 0;
1539 #endif /* not HAVE_TIMEVAL */
1540 if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0)
1541 status_notify ();
1542 }
1543
1544 /* Don't wait for output from a non-running process. */
1545 if (wait_proc != 0 && !NULL (wait_proc->raw_status_low))
1546 update_status (wait_proc);
1547 if (wait_proc != 0
1548 && ! EQ (wait_proc->status, Qrun))
1549 break;
1550
1551 if (fix_screen_hook)
1552 (*fix_screen_hook) ();
1553
1554 /* Compute time from now till when time limit is up */
1555 /* Exit if already run out */
1556 if (time_limit == -1)
1557 {
1558 /* -1 specified for timeout means
1559 gobble output available now
1560 but don't wait at all. */
1561 #ifdef HAVE_TIMEVAL
1562 timeout.tv_sec = 0;
1563 timeout.tv_usec = 0;
1564 #else
1565 timeout = 0;
1566 #endif /* not HAVE_TIMEVAL */
1567 }
1568 else if (time_limit)
1569 {
1570 #ifdef HAVE_TIMEVAL
1571 gettimeofday (&timeout, &garbage);
1572 timeout.tv_sec = end_time.tv_sec - timeout.tv_sec;
1573 timeout.tv_usec = end_time.tv_usec - timeout.tv_usec;
1574 if (timeout.tv_usec < 0)
1575 timeout.tv_usec += 1000000,
1576 timeout.tv_sec--;
1577 if (timeout.tv_sec < 0)
1578 break;
1579 #else /* not HAVE_TIMEVAL */
1580 time (&temp);
1581 timeout = end_time - temp;
1582 if (timeout < 0)
1583 break;
1584 #endif /* not HAVE_TIMEVAL */
1585 }
1586 else
1587 {
1588 #ifdef HAVE_TIMEVAL
1589 /* If no real timeout, loop sleeping with a big timeout
1590 so that input interrupt can wake us up by zeroing it */
1591 timeout.tv_sec = 100;
1592 timeout.tv_usec = 0;
1593 #else /* not HAVE_TIMEVAL */
1594 timeout = 100000; /* 100000 recognized by the select emulator */
1595 #endif /* not HAVE_TIMEVAL */
1596 }
1597
1598 /* Cause quitting and alarm signals to take immediate action,
1599 and cause input available signals to zero out timeout */
1600 if (read_kbd < 0)
1601 set_waiting_for_input (&timeout);
1602
1603 /* Wait till there is something to do */
1604
1605 Available = Exception = input_wait_mask;
1606 if (!read_kbd)
1607 FD_CLR (0, &Available);
1608
1609 if (read_kbd && kbd_count)
1610 nfds = 0;
1611 else
1612 #ifdef IBMRTAIX
1613 nfds = select (MAXDESC, &Available, 0, 0, &timeout);
1614 #else
1615 #ifdef HPUX
1616 nfds = select (MAXDESC, &Available, 0, 0, &timeout);
1617 #else
1618 nfds = select (MAXDESC, &Available, 0, &Exception, &timeout);
1619 #endif
1620 #endif
1621 xerrno = errno;
1622
1623 if (fix_screen_hook)
1624 (*fix_screen_hook) ();
1625
1626 /* Make C-g and alarm signals set flags again */
1627 clear_waiting_for_input ();
1628
1629 /* If we woke up due to SIGWINCH, actually change size now. */
1630 do_pending_window_change ();
1631
1632 if (time_limit && nfds == 0) /* timeout elapsed */
1633 break;
1634 if (nfds < 0)
1635 {
1636 if (xerrno == EINTR)
1637 FD_ZERO (&Available);
1638 #ifdef ALLIANT
1639 /* This happens for no known reason on ALLIANT.
1640 I am guessing that this is the right response. -- RMS. */
1641 else if (xerrno == EFAULT)
1642 FD_ZERO (&Available);
1643 #endif
1644 else if (xerrno == EBADF)
1645 #ifdef AIX
1646 /* AIX will return EBADF on a call to select involving a ptc if the
1647 associated pts isn't open. Since this will only happen just as
1648 a child is dying, just ignore the situation -- SIGCHLD will come
1649 along quite quickly, and after cleanup the ptc will no longer be
1650 checked, so this error will stop recurring. */
1651 FD_ZERO (&Available); /* Cannot depend on values returned. */
1652 #else /* not AIX */
1653 abort ();
1654 #endif /* not AIX */
1655 else
1656 error("select error: %s", sys_errlist[xerrno]);
1657 }
1658 #ifdef sun
1659 else if (nfds > 0 && FD_ISSET (0, &Available) && interrupt_input)
1660 /* System sometimes fails to deliver SIGIO. */
1661 kill (getpid (), SIGIO);
1662 #endif
1663
1664 /* Check for keyboard input */
1665 /* If there is any, return immediately
1666 to give it higher priority than subprocesses */
1667
1668 if (read_kbd && detect_input_pending ())
1669 break;
1670
1671 #ifdef vipc
1672 /* Check for connection from other process */
1673
1674 if (FD_ISSET (comm_server, &Available))
1675 {
1676 FD_CLR (comm_server, &Available);
1677 create_commchan ();
1678 }
1679 #endif vipc
1680
1681 /* Check for data from a process or a command channel */
1682
1683 for (channel = 3; channel < MAXDESC; channel++)
1684 {
1685 if (FD_ISSET (channel, &Available))
1686 {
1687 int nread;
1688
1689 FD_CLR (channel, &Available);
1690 /* If waiting for this channel,
1691 arrange to return as soon as no more input
1692 to be processed. No more waiting. */
1693 if (wait_channel == channel)
1694 {
1695 wait_channel = 0;
1696 time_limit = -1;
1697 }
1698 proc = chan_process[channel];
1699 if (NULL (proc))
1700 continue;
1701
1702 #ifdef vipc
1703 /* It's a command channel */
1704 if (!NULL (XPROCESS (proc)->command_channel_p))
1705 {
1706 ProcessCommChan (channel, proc);
1707 if (NULL (XPROCESS (proc)->command_channel_p))
1708 {
1709 /* It has ceased to be a command channel! */
1710 int bytes_available;
1711 if (ioctl (channel, FIONREAD, &bytes_available) < 0)
1712 bytes_available = 0;
1713 if (bytes_available)
1714 FD_SET (channel, &Available);
1715 }
1716 continue;
1717 }
1718 #endif vipc
1719
1720 /* Read data from the process, starting with our
1721 buffered-ahead character if we have one. */
1722
1723 nread = read_process_output (proc, channel);
1724 if (nread > 0)
1725 {
1726 /* Since read_process_output can run a filter,
1727 which can call accept-process-output,
1728 don't try to read from any other processes
1729 before doing the select again. */
1730 FD_ZERO (&Available);
1731
1732 if (do_display)
1733 redisplay_preserve_echo_area ();
1734 }
1735 #ifdef EWOULDBLOCK
1736 else if (nread == -1 && errno == EWOULDBLOCK)
1737 ;
1738 #else
1739 #ifdef O_NONBLOCK
1740 else if (nread == -1 && errno == EAGAIN)
1741 ;
1742 #else
1743 #ifdef O_NDELAY
1744 else if (nread == -1 && errno == EAGAIN)
1745 ;
1746 /* Note that we cannot distinguish between no input
1747 available now and a closed pipe.
1748 With luck, a closed pipe will be accompanied by
1749 subprocess termination and SIGCHLD. */
1750 else if (nread == 0)
1751 ;
1752 #endif /* O_NDELAY */
1753 #endif /* O_NONBLOCK */
1754 #endif /* EWOULDBLOCK */
1755 #ifdef HAVE_PTYS
1756 /* On some OSs with ptys, when the process on one end of
1757 a pty exits, the other end gets an error reading with
1758 errno = EIO instead of getting an EOF (0 bytes read).
1759 Therefore, if we get an error reading and errno =
1760 EIO, just continue, because the child process has
1761 exited and should clean itself up soon (e.g. when we
1762 get a SIGCHLD). */
1763 else if (nread == -1 && errno == EIO)
1764 ;
1765 #endif /* HAVE_PTYS */
1766 /* If we can detect process termination, don't consider the process
1767 gone just because its pipe is closed. */
1768 #ifdef SIGCHLD
1769 else if (nread == 0)
1770 ;
1771 #endif
1772 else
1773 {
1774 /* Preserve status of processes already terminated. */
1775 XSETINT (XPROCESS (proc)->tick, ++process_tick);
1776 deactivate_process (proc);
1777 if (!NULL (XPROCESS (proc)->raw_status_low))
1778 update_status (XPROCESS (proc));
1779 if (EQ (XPROCESS (proc)->status, Qrun))
1780 XPROCESS (proc)->status
1781 = Fcons (Qexit, Fcons (make_number (256), Qnil));
1782 }
1783 }
1784 } /* end for */
1785 } /* end while */
1786
1787 #if 0
1788 /* Resume periodic signals to poll for input, if necessary. */
1789 start_polling ();
1790 #endif
1791 }
1792
1793 /* Actually call the filter. This gets the information via variables
1794 because internal_condition_case won't pass arguments. */
1795
1796 Lisp_Object
run_filter()1797 run_filter ()
1798 {
1799 return call2 (this_filter, filter_process, filter_string);
1800 }
1801
1802 /* Read pending output from the process channel,
1803 starting with our buffered-ahead character if we have one.
1804 Yield number of characters read.
1805
1806 This function reads at most 1024 characters.
1807 If you want to read all available subprocess output,
1808 you must call it repeatedly until it returns zero. */
1809
read_process_output(proc,channel)1810 read_process_output (proc, channel)
1811 Lisp_Object proc;
1812 register int channel;
1813 {
1814 register int nchars;
1815 char chars[1024];
1816 register Lisp_Object outstream;
1817 register struct buffer *old = current_buffer;
1818 register struct Lisp_Process *p = XPROCESS (proc);
1819 register int opoint;
1820
1821 if (proc_buffered_char[channel] < 0)
1822 nchars = read (channel, chars, sizeof chars);
1823 else
1824 {
1825 chars[0] = proc_buffered_char[channel];
1826 proc_buffered_char[channel] = -1;
1827 nchars = read (channel, chars + 1, sizeof chars - 1);
1828 if (nchars < 0)
1829 nchars = 1;
1830 else
1831 nchars = nchars + 1;
1832 }
1833
1834 if (nchars <= 0) return nchars;
1835
1836 outstream = p->filter;
1837 if (!NULL (outstream))
1838 {
1839 int count = specpdl_ptr - specpdl;
1840 specbind (Qinhibit_quit, Qt);
1841 this_filter = outstream;
1842 filter_process = proc;
1843 filter_string = make_string (chars, nchars);
1844 call2 (this_filter, filter_process, filter_string);
1845 /* internal_condition_case (run_filter, Qerror, Fidentity); */
1846 unbind_to (count);
1847 return nchars;
1848 }
1849
1850 /* If no filter, write into buffer if it isn't dead. */
1851 if (!NULL (p->buffer) && !NULL (XBUFFER (p->buffer)->name))
1852 {
1853 Lisp_Object tem;
1854
1855 Fset_buffer (p->buffer);
1856 opoint = point;
1857
1858 /* Insert new output into buffer
1859 at the current end-of-output marker,
1860 thus preserving logical ordering of input and output. */
1861 if (XMARKER (p->mark)->buffer)
1862 SET_PT (marker_position (p->mark));
1863 else
1864 SET_PT (ZV);
1865 if (point <= opoint)
1866 opoint += nchars;
1867
1868 tem = current_buffer->read_only;
1869 current_buffer->read_only = Qnil;
1870 insert (chars, nchars);
1871 current_buffer->read_only = tem;
1872 Fset_marker (p->mark, make_number (point), p->buffer);
1873 update_mode_lines++;
1874
1875 SET_PT (opoint);
1876 set_buffer_internal (old);
1877 }
1878 return nchars;
1879 }
1880
1881 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
1882 0, 0, 0,
1883 "Returns non-NIL if emacs is waiting for input from the user.\n\
1884 This is intended for use by asynchronous process output filters and sentinels.")
1885 ()
1886 {
1887 return ((waiting_for_user_input_p) ? Qt : Qnil);
1888 }
1889
1890 /* Sending data to subprocess */
1891
1892 jmp_buf send_process_frame;
1893
send_process_trap()1894 send_process_trap ()
1895 {
1896 #ifdef BSD4_1
1897 sigrelse (SIGPIPE);
1898 sigrelse (SIGALRM);
1899 #endif /* BSD4_1 */
1900 longjmp (send_process_frame, 1);
1901 }
1902
send_process(proc,buf,len)1903 send_process (proc, buf, len)
1904 Lisp_Object proc;
1905 char *buf;
1906 int len;
1907 {
1908 /* Don't use register vars; longjmp can lose them. */
1909 int rv;
1910 unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
1911
1912 if (!NULL (XPROCESS (proc)->raw_status_low))
1913 update_status (XPROCESS (proc));
1914 if (! EQ (XPROCESS (proc)->status, Qrun))
1915 error ("Process %s not running", procname);
1916
1917 if (!setjmp (send_process_frame))
1918 while (len > 0)
1919 {
1920 signal (SIGPIPE, send_process_trap);
1921 rv = write (XFASTINT (XPROCESS (proc)->outfd), buf, len);
1922 signal (SIGPIPE, SIG_DFL);
1923 if (rv < 0)
1924 {
1925 #ifdef EWOULDBLOCK
1926 if (errno == EWOULDBLOCK)
1927 {
1928 /* It would be nice to accept process output here,
1929 but that is difficult. For example, it could
1930 garbage what we are sending if that is from a buffer. */
1931 immediate_quit = 1;
1932 QUIT;
1933 sleep (1);
1934 immediate_quit = 0;
1935 continue;
1936 }
1937 #endif
1938 report_file_error ("writing to process", Fcons (proc, Qnil));
1939 }
1940 buf += rv;
1941 len -= rv;
1942 }
1943 else
1944 {
1945 XPROCESS (proc)->raw_status_low = Qnil;
1946 XPROCESS (proc)->raw_status_high = Qnil;
1947 XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
1948 XSETINT (XPROCESS (proc)->tick, ++process_tick);
1949 deactivate_process (proc);
1950 error ("SIGPIPE raised on process %s; closed it", procname);
1951 }
1952 }
1953
1954 DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
1955 3, 3, 0,
1956 "Send current contents of region as input to PROCESS.\n\
1957 PROCESS may be a process name.\n\
1958 Called from program, takes three arguments, PROCESS, START and END.")
1959 (process, start, end)
1960 Lisp_Object process, start, end;
1961 {
1962 Lisp_Object proc;
1963 int start1;
1964
1965 proc = get_process (process);
1966 validate_region (&start, &end);
1967
1968 if (XINT (start) < GPT && XINT (end) > GPT)
1969 move_gap (start);
1970
1971 start1 = XINT (start);
1972 send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start));
1973
1974 return Qnil;
1975 }
1976
1977 DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
1978 2, 2, 0,
1979 "Send PROCESS the contents of STRING as input.\n\
1980 PROCESS may be a process name.")
1981 (process, string)
1982 Lisp_Object process, string;
1983 {
1984 Lisp_Object proc;
1985 CHECK_STRING (string, 1);
1986 proc = get_process (process);
1987 send_process (proc, XSTRING (string)->data, XSTRING (string)->size);
1988 return Qnil;
1989 }
1990
1991 /* send a signal number SIGNO to PROCESS.
1992 CURRENT_GROUP means send to the process group that currently owns
1993 the terminal being used to communicate with PROCESS.
1994 This is used for various commands in shell mode.
1995 If NOMSG is zero, insert signal-announcements into process's buffers
1996 right away. */
1997
process_send_signal(process,signo,current_group,nomsg)1998 process_send_signal (process, signo, current_group, nomsg)
1999 Lisp_Object process;
2000 int signo;
2001 Lisp_Object current_group;
2002 int nomsg;
2003 {
2004 Lisp_Object proc;
2005 register struct Lisp_Process *p;
2006 int gid;
2007
2008 proc = get_process (process);
2009 p = XPROCESS (proc);
2010
2011 if (!EQ (p->childp, Qt))
2012 error ("Process %s is not a subprocess",
2013 XSTRING (p->name)->data);
2014 if (!XFASTINT (p->infd))
2015 error ("Process %s is not active",
2016 XSTRING (p->name)->data);
2017
2018 if (NULL (p->pty_flag))
2019 current_group = Qnil;
2020
2021 #ifdef TIOCGPGRP /* Not sure about this! (fnf) */
2022 /* If we are using pgrps, get a pgrp number and make it negative. */
2023 if (!NULL (current_group))
2024 {
2025 ioctl (XFASTINT (p->infd), TIOCGPGRP, &gid);
2026 gid = - gid;
2027 }
2028 else
2029 gid = - XFASTINT (p->pid);
2030 #else /* not using pgrps */
2031 /* Can't select pgrps on this system, so we know that
2032 the child itself heads the pgrp. */
2033 gid = - XFASTINT (p->pid);
2034 #endif /* not using pgrps */
2035
2036 switch (signo)
2037 {
2038 #ifdef SIGCONT
2039 case SIGCONT:
2040 p->raw_status_low = Qnil;
2041 p->raw_status_high = Qnil;
2042 p->status = Qrun;
2043 XSETINT (p->tick, ++process_tick);
2044 if (!nomsg)
2045 status_notify ();
2046 break;
2047 #endif
2048 case SIGINT:
2049 case SIGQUIT:
2050 case SIGKILL:
2051 flush_pending_output (XFASTINT (p->infd));
2052 break;
2053 }
2054 /* gid may be a pid, or minus a pgrp's number */
2055 #ifdef TIOCSIGSEND
2056 if (!NULL (current_group))
2057 ioctl (XFASTINT (p->infd), TIOCSIGSEND, signo);
2058 else
2059 {
2060 gid = - XFASTINT (p->pid);
2061 kill (gid, signo);
2062 }
2063 #else /* no TIOCSIGSEND */
2064 #ifdef BSD
2065 /* On bsd, [man says] kill does not accept a negative number to kill a pgrp.
2066 Must do that differently. */
2067 killpg (-gid, signo);
2068 #else /* Not BSD. */
2069 kill (gid, signo);
2070 #endif /* Not BSD. */
2071 #endif /* no TIOCSIGSEND */
2072 }
2073
2074 DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
2075 "Interrupt process PROCESS. May be process or name of one.\n\
2076 Nil or no arg means current buffer's process.\n\
2077 Second arg CURRENT-GROUP non-nil means send signal to\n\
2078 the current process-group of the process's controlling terminal\n\
2079 rather than to the process's own process group.\n\
2080 If the process is a shell, this means interrupt current subjob\n\
2081 rather than the shell.")
2082 (process, current_group)
2083 Lisp_Object process, current_group;
2084 {
2085 process_send_signal (process, SIGINT, current_group, 0);
2086 return process;
2087 }
2088
2089 DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
2090 "Kill process PROCESS. May be process or name of one.\n\
2091 See function interrupt-process for more details on usage.")
2092 (process, current_group)
2093 Lisp_Object process, current_group;
2094 {
2095 process_send_signal (process, SIGKILL, current_group, 0);
2096 return process;
2097 }
2098
2099 DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
2100 "Send QUIT signal to process PROCESS. May be process or name of one.\n\
2101 See function interrupt-process for more details on usage.")
2102 (process, current_group)
2103 Lisp_Object process, current_group;
2104 {
2105 process_send_signal (process, SIGQUIT, current_group, 0);
2106 return process;
2107 }
2108
2109 DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
2110 "Stop process PROCESS. May be process or name of one.\n\
2111 See function interrupt-process for more details on usage.")
2112 (process, current_group)
2113 Lisp_Object process, current_group;
2114 {
2115 #ifndef SIGTSTP
2116 error ("no SIGTSTP support");
2117 #else
2118 process_send_signal (process, SIGTSTP, current_group, 0);
2119 #endif
2120 return process;
2121 }
2122
2123 DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
2124 "Continue process PROCESS. May be process or name of one.\n\
2125 See function interrupt-process for more details on usage.")
2126 (process, current_group)
2127 Lisp_Object process, current_group;
2128 {
2129 #ifdef SIGCONT
2130 process_send_signal (process, SIGCONT, current_group, 0);
2131 #else
2132 error ("no SIGCONT support");
2133 #endif
2134 return process;
2135 }
2136
2137 DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
2138 "Make PROCESS see end-of-file in its input.\n\
2139 Eof comes after any text already sent to it.\n\
2140 nil or no arg means current buffer's process.")
2141 (process)
2142 Lisp_Object process;
2143 {
2144 Lisp_Object proc;
2145
2146 proc = get_process (process);
2147 /* Sending a zero-length record is supposed to mean eof
2148 when TIOCREMOTE is turned on. */
2149 #ifdef DID_REMOTE
2150 {
2151 char buf[1];
2152 write (XFASTINT (XPROCESS (proc)->outfd), buf, 0);
2153 }
2154 #else /* did not do TOICREMOTE */
2155 send_process (proc, "\004", 1);
2156 #endif /* did not do TOICREMOTE */
2157 return process;
2158 }
2159
2160 /* Kill all processes associated with `buffer'.
2161 If `buffer' is nil, kill all processes */
2162
kill_buffer_processes(buffer)2163 kill_buffer_processes (buffer)
2164 Lisp_Object buffer;
2165 {
2166 Lisp_Object tail, proc;
2167
2168 for (tail = Vprocess_alist; XGCTYPE (tail) == Lisp_Cons;
2169 tail = XCONS (tail)->cdr)
2170 {
2171 proc = XCONS (XCONS (tail)->car)->cdr;
2172 if (XGCTYPE (proc) == Lisp_Process
2173 && (NULL (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
2174 {
2175 if (NETCONN_P (proc))
2176 deactivate_process (proc);
2177 else if (XFASTINT (XPROCESS (proc)->infd))
2178 process_send_signal (proc, SIGHUP, Qnil, 1);
2179 }
2180 }
2181 }
2182
2183 /* On receipt of a signal that a child status has changed,
2184 loop asking about children with changed statuses until
2185 the system says there are no more.
2186 All we do is change the status;
2187 we do not run sentinels or print notifications.
2188 That is saved for the next time keyboard input is done,
2189 in order to avoid timing errors. */
2190
2191 /** WARNING: this can be called during garbage collection.
2192 Therefore, it must not be fooled by the presence of mark bits in
2193 Lisp objects. */
2194
2195 /** USG WARNING: Although it is not obvious from the documentation
2196 in signal(2), on a USG system the SIGCLD handler MUST NOT call
2197 signal() before executing at least one wait(), otherwise the handler
2198 will be called again, resulting in an infinite loop. The relevant
2199 portion of the documentation reads "SIGCLD signals will be queued
2200 and the signal-catching function will be continually reentered until
2201 the queue is empty". Invoking signal() causes the kernel to reexamine
2202 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
2203
sigchld_handler(signo)2204 sigchld_handler (signo)
2205 int signo;
2206 {
2207 int old_errno = errno;
2208 Lisp_Object proc;
2209 register struct Lisp_Process *p;
2210
2211 #ifdef BSD4_1
2212 extern int synch_process_pid;
2213 extern int sigheld;
2214 sigheld |= sigbit (SIGCHLD);
2215 #endif
2216
2217 while (1)
2218 {
2219 register int pid;
2220 WAITTYPE w;
2221 Lisp_Object tail;
2222
2223 #ifdef WNOHANG
2224 #ifndef WUNTRACED
2225 #define WUNTRACED 0
2226 #endif /* no WUNTRACED */
2227 /* Keep trying to get a status until we get a definitive result. */
2228 do
2229 {
2230 errno = 0;
2231 pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
2232 }
2233 while (pid <= 0 && errno == EINTR);
2234
2235 if (pid <= 0)
2236 {
2237 /* A real failure. We have done all our job, so return. */
2238
2239 /* USG systems forget handlers when they are used;
2240 must reestablish each time */
2241 #ifdef USG
2242 signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
2243 #endif
2244 #ifdef BSD4_1
2245 sigheld &= ~sigbit (SIGCHLD);
2246 sigrelse (SIGCHLD);
2247 #endif
2248 errno = old_errno;
2249 return;
2250 }
2251 #else
2252 pid = wait (&w);
2253 #endif /* no WNOHANG */
2254
2255 #ifdef BSD4_1
2256 if (synch_process_pid == pid)
2257 synch_process_pid = 0; /* Zero it to show process has died. */
2258 #endif
2259
2260 /* Find the process that signaled us, and record its status. */
2261
2262 p = 0;
2263 for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
2264 {
2265 proc = XCONS (XCONS (tail)->car)->cdr;
2266 p = XPROCESS (proc);
2267 if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
2268 break;
2269 p = 0;
2270 }
2271
2272 /* If we don't recognize the pid number,
2273 look for a process being created. */
2274
2275 if (p == 0)
2276 for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
2277 {
2278 proc = XCONS (XCONS (tail)->car)->cdr;
2279 p = XPROCESS (proc);
2280 if (XINT (p->pid) == -1)
2281 break;
2282 p = 0;
2283 }
2284
2285 /* Change the status of the process that was found. */
2286
2287 if (p != 0)
2288 {
2289 union { int i; WAITTYPE wt; } u;
2290
2291 XSETINT (p->tick, ++process_tick);
2292 u.wt = w;
2293 XFASTINT (p->raw_status_low) = u.i & 0xffff;
2294 XFASTINT (p->raw_status_high) = u.i >> 16;
2295
2296 /* If process has terminated, stop waiting for its output. */
2297 if (WIFSIGNALED (w) || WIFEXITED (w))
2298 if (p->infd)
2299 FD_CLR (p->infd, &input_wait_mask);
2300 }
2301
2302 /* On some systems, we must return right away.
2303 If any more processes want to signal us, we will
2304 get another signal.
2305 Otherwise (on systems that have WNOHANG), loop around
2306 to use up all the processes that have something to tell us. */
2307 #if defined (USG) && ! (defined (HPUX) && defined (WNOHANG))
2308 #ifdef USG
2309 signal (signo, sigchld_handler);
2310 #endif
2311 errno = old_errno;
2312 return;
2313 #endif /* USG, but not HPUX with WNOHANG */
2314 }
2315 }
2316
2317 /* Report all recent events of a change in process status
2318 (either run the sentinel or output a message).
2319 This is done while Emacs is waiting for keyboard input. */
2320
status_notify()2321 status_notify ()
2322 {
2323 register Lisp_Object tail, proc, buffer;
2324
2325 for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
2326 {
2327 Lisp_Object symbol, msg;
2328 register struct Lisp_Process *p;
2329
2330 proc = Fcdr (Fcar (tail));
2331 p = XPROCESS (proc);
2332
2333 if (XINT (p->tick) != XINT (p->update_tick))
2334 {
2335 struct gcpro gcpro1;
2336
2337 XSETINT (p->update_tick, XINT (p->tick));
2338
2339 /* If process is still active, read any output that remains. */
2340 if (XFASTINT (p->infd))
2341 while (read_process_output (proc, XFASTINT (p->infd)) > 0);
2342
2343 buffer = p->buffer;
2344
2345 /* Get the text to use for the message. */
2346 if (!NULL (p->raw_status_low))
2347 update_status (p);
2348 msg = status_message (p->status);
2349 GCPRO1 (msg);
2350
2351 /* If process is terminated, deactivate it or delete it. */
2352 symbol = p->status;
2353 if (XTYPE (p->status) == Lisp_Cons)
2354 symbol = XCONS (p->status)->car;
2355
2356 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
2357 || EQ (symbol, Qclosed))
2358 {
2359 if (delete_exited_processes)
2360 remove_process (proc);
2361 else
2362 deactivate_process (proc);
2363 }
2364 UNGCPRO;
2365
2366 /* Now output the message suitably. */
2367 if (!NULL (p->sentinel))
2368 exec_sentinel (proc, msg);
2369 /* Don't bother with a message in the buffer
2370 when a process becomes runnable. */
2371 else if (!EQ (symbol, Qrun) && !NULL (buffer))
2372 {
2373 Lisp_Object ro = XBUFFER (buffer)->read_only;
2374 Lisp_Object tem;
2375 struct buffer *old = current_buffer;
2376 int opoint;
2377
2378 /* Avoid error if buffer is deleted
2379 (probably that's why the process is dead, too) */
2380 if (NULL (XBUFFER (buffer)->name))
2381 continue;
2382 Fset_buffer (buffer);
2383 opoint = point;
2384 /* Insert new output into buffer
2385 at the current end-of-output marker,
2386 thus preserving logical ordering of input and output. */
2387 if (XMARKER (p->mark)->buffer)
2388 SET_PT (marker_position (p->mark));
2389 else
2390 SET_PT (ZV);
2391 if (point <= opoint)
2392 opoint += XSTRING (msg)->size + XSTRING (p->name)->size + 10;
2393
2394 tem = current_buffer->read_only;
2395 current_buffer->read_only = Qnil;
2396 GCPRO1 (msg);
2397 InsStr ("\nProcess ");
2398 Finsert (1, &p->name);
2399 InsStr (" ");
2400 Finsert (1, &msg);
2401 current_buffer->read_only = tem;
2402 Fset_marker (p->mark, make_number (point), p->buffer);
2403 UNGCPRO;
2404
2405 SET_PT (opoint);
2406 set_buffer_internal (old);
2407 }
2408 }
2409 } /* end for */
2410
2411 update_mode_lines++; /* in case buffers use %s in mode-line-format */
2412 redisplay_preserve_echo_area ();
2413
2414 update_tick = process_tick;
2415 }
2416
exec_sentinel(proc,reason)2417 exec_sentinel (proc, reason)
2418 Lisp_Object proc, reason;
2419 {
2420 Lisp_Object sentinel;
2421 register struct Lisp_Process *p = XPROCESS (proc);
2422 int count = specpdl_ptr - specpdl;
2423
2424 sentinel = p->sentinel;
2425 if (NULL (sentinel))
2426 return;
2427
2428 p->sentinel = Qnil;
2429 specbind (Qinhibit_quit, Qt);
2430 this_filter = sentinel;
2431 filter_process = proc;
2432 filter_string = reason;
2433 call2 (this_filter, filter_process, filter_string);
2434 /* internal_condition_case (run_filter, Qerror, Fidentity); */
2435 unbind_to (count);
2436 p->sentinel = sentinel;
2437 }
2438
init_process()2439 init_process ()
2440 {
2441 register int i;
2442
2443 #ifdef SIGCHLD
2444 #ifndef CANNOT_DUMP
2445 if (! noninteractive || initialized)
2446 #endif
2447 signal (SIGCHLD, sigchld_handler);
2448 #endif
2449
2450 FD_ZERO (&input_wait_mask);
2451 FD_SET (0, &input_wait_mask);
2452 Vprocess_alist = Qnil;
2453 for (i = 0; i < MAXDESC; i++)
2454 {
2455 chan_process[i] = Qnil;
2456 proc_buffered_char[i] = -1;
2457 }
2458 }
2459
syms_of_process()2460 syms_of_process ()
2461 {
2462 Qprocessp = intern ("processp");
2463 staticpro (&Qprocessp);
2464 Qrun = intern ("run");
2465 staticpro (&Qrun);
2466 Qstop = intern ("stop");
2467 staticpro (&Qstop);
2468 Qsignal = intern ("signal");
2469 staticpro (&Qsignal);
2470 Qexit = intern ("exit");
2471 staticpro (&Qexit);
2472 Qopen = intern ("open");
2473 staticpro (&Qopen);
2474 Qclosed = intern ("closed");
2475 staticpro (&Qclosed);
2476
2477 staticpro (&Vprocess_alist);
2478
2479 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
2480 "*Non-nil means delete processes immediately when they exit.\n\
2481 nil means don't delete them until `list-processes' is run.");
2482
2483 delete_exited_processes = 1;
2484
2485 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
2486 "Control type of device used to communicate with subprocesses.\n\
2487 Values are nil to use a pipe, t for a pty (or pipe if ptys not supported).\n\
2488 Value takes effect when `start-process' is called.");
2489 Vprocess_connection_type = Qt;
2490
2491 defsubr (&Sprocessp);
2492 defsubr (&Sget_process);
2493 defsubr (&Sget_buffer_process);
2494 defsubr (&Sdelete_process);
2495 defsubr (&Sprocess_status);
2496 defsubr (&Sprocess_exit_status);
2497 defsubr (&Sprocess_id);
2498 defsubr (&Sprocess_name);
2499 defsubr (&Sprocess_command);
2500 defsubr (&Sset_process_buffer);
2501 defsubr (&Sprocess_buffer);
2502 defsubr (&Sprocess_mark);
2503 defsubr (&Sset_process_filter);
2504 defsubr (&Sprocess_filter);
2505 defsubr (&Sset_process_sentinel);
2506 defsubr (&Sprocess_sentinel);
2507 defsubr (&Sprocess_kill_without_query);
2508 defsubr (&Slist_processes);
2509 defsubr (&Sprocess_list);
2510 defsubr (&Sstart_process);
2511 #ifdef HAVE_SOCKETS
2512 defsubr (&Sopen_network_stream);
2513 #endif /* HAVE_SOCKETS */
2514 defsubr (&Saccept_process_output);
2515 defsubr (&Sprocess_send_region);
2516 defsubr (&Sprocess_send_string);
2517 defsubr (&Sinterrupt_process);
2518 defsubr (&Skill_process);
2519 defsubr (&Squit_process);
2520 defsubr (&Sstop_process);
2521 defsubr (&Scontinue_process);
2522 defsubr (&Sprocess_send_eof);
2523 defsubr (&Swaiting_for_user_input_p);
2524 }
2525
2526 #endif subprocesses
2527