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