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