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