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