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