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
|
650
|
1590 if (NILP (proc))
|
|
1591 XFASTINT (proc) = 0;
|
|
1592
|
578
|
1593 return
|
650
|
1594 (wait_reading_process_input (seconds, useconds, proc, 0)
|
578
|
1595 ? Qt : Qnil);
|
|
1596 }
|
|
1597
|
|
1598 /* This variable is different from waiting_for_input in keyboard.c.
|
|
1599 It is used to communicate to a lisp process-filter/sentinel (via the
|
|
1600 function Fwaiting_for_user_input_p below) whether emacs was waiting
|
|
1601 for user-input when that process-filter was called.
|
|
1602 waiting_for_input cannot be used as that is by definition 0 when
|
|
1603 lisp code is being evalled */
|
|
1604 static int waiting_for_user_input_p;
|
|
1605
|
|
1606 /* Read and dispose of subprocess output while waiting for timeout to
|
|
1607 elapse and/or keyboard input to be available.
|
|
1608
|
|
1609 time_limit is:
|
|
1610 timeout in seconds, or
|
|
1611 zero for no limit, or
|
|
1612 -1 means gobble data immediately available but don't wait for any.
|
|
1613
|
650
|
1614 read_kbd is a lisp value:
|
578
|
1615 0 to ignore keyboard input, or
|
|
1616 1 to return when input is available, or
|
|
1617 -1 means caller will actually read the input, so don't throw to
|
|
1618 the quit handler, or
|
650
|
1619 a process object, meaning wait until something arrives from that
|
|
1620 process. The return value is true iff we read some input from
|
|
1621 that process.
|
578
|
1622
|
|
1623 do_display != 0 means redisplay should be done to show subprocess
|
|
1624 output that arrives.
|
|
1625
|
|
1626 If read_kbd is a pointer to a struct Lisp_Process, then the
|
|
1627 function returns true iff we received input from that process
|
|
1628 before the timeout elapsed.
|
|
1629 Otherwise, return true iff we recieved input from any process. */
|
|
1630
|
|
1631 wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
|
650
|
1632 int time_limit, microsecs;
|
|
1633 Lisp_Object read_kbd;
|
|
1634 int do_display;
|
578
|
1635 {
|
|
1636 register int channel, nfds, m;
|
|
1637 static SELECT_TYPE Available;
|
|
1638 int xerrno;
|
|
1639 Lisp_Object proc;
|
|
1640 EMACS_TIME timeout, end_time, garbage;
|
|
1641 SELECT_TYPE Atemp;
|
|
1642 int wait_channel = 0;
|
|
1643 struct Lisp_Process *wait_proc = 0;
|
|
1644 int got_some_input = 0;
|
|
1645
|
|
1646 FD_ZERO (&Available);
|
|
1647
|
650
|
1648 /* If read_kbd is a process to watch, set wait_proc and wait_channel
|
|
1649 accordingly. */
|
|
1650 if (XTYPE (read_kbd) == Lisp_Process)
|
578
|
1651 {
|
650
|
1652 wait_proc = XPROCESS (read_kbd);
|
578
|
1653 wait_channel = XFASTINT (wait_proc->infd);
|
650
|
1654 XFASTINT (read_kbd) = 0;
|
578
|
1655 }
|
|
1656
|
650
|
1657 waiting_for_user_input_p = XINT (read_kbd);
|
578
|
1658
|
|
1659 /* Since we may need to wait several times,
|
|
1660 compute the absolute time to return at. */
|
|
1661 if (time_limit || microsecs)
|
|
1662 {
|
|
1663 EMACS_GET_TIME (end_time);
|
|
1664 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
|
|
1665 EMACS_ADD_TIME (end_time, end_time, timeout);
|
|
1666 }
|
|
1667
|
|
1668 while (1)
|
|
1669 {
|
|
1670 /* If calling from keyboard input, do not quit
|
|
1671 since we want to return C-g as an input character.
|
|
1672 Otherwise, do pending quit if requested. */
|
650
|
1673 if (XINT (read_kbd) >= 0)
|
578
|
1674 QUIT;
|
|
1675
|
|
1676 /* If status of something has changed, and no input is available,
|
|
1677 notify the user of the change right away */
|
|
1678 if (update_tick != process_tick && do_display)
|
|
1679 {
|
|
1680 Atemp = input_wait_mask;
|
|
1681 EMACS_SET_SECS_USECS (timeout, 0, 0);
|
|
1682 if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0)
|
|
1683 status_notify ();
|
|
1684 }
|
|
1685
|
|
1686 /* Don't wait for output from a non-running process. */
|
|
1687 if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
|
|
1688 update_status (wait_proc);
|
|
1689 if (wait_proc != 0
|
|
1690 && ! EQ (wait_proc->status, Qrun))
|
|
1691 break;
|
|
1692
|
|
1693 /* Compute time from now till when time limit is up */
|
|
1694 /* Exit if already run out */
|
|
1695 if (time_limit == -1)
|
|
1696 {
|
|
1697 /* -1 specified for timeout means
|
|
1698 gobble output available now
|
|
1699 but don't wait at all. */
|
|
1700
|
|
1701 EMACS_SET_SECS_USECS (timeout, 0, 0);
|
|
1702 }
|
|
1703 else if (time_limit || microsecs)
|
|
1704 {
|
|
1705 EMACS_GET_TIME (timeout);
|
|
1706 EMACS_SUB_TIME (timeout, end_time, timeout);
|
|
1707 if (EMACS_TIME_NEG_P (timeout))
|
|
1708 break;
|
|
1709 }
|
|
1710 else
|
|
1711 {
|
|
1712 EMACS_SET_SECS_USECS (timeout, 100000, 0);
|
|
1713 }
|
|
1714
|
|
1715 /* Cause C-g and alarm signals to take immediate action,
|
|
1716 and cause input available signals to zero out timeout */
|
650
|
1717 if (XINT (read_kbd) < 0)
|
578
|
1718 set_waiting_for_input (&timeout);
|
|
1719
|
|
1720 /* Wait till there is something to do */
|
|
1721
|
|
1722 Available = input_wait_mask;
|
650
|
1723 if (! XINT (read_kbd))
|
578
|
1724 FD_CLR (0, &Available);
|
|
1725
|
765
|
1726 /* If frame size has changed or the window is newly mapped,
|
648
|
1727 redisplay now, before we start to wait. There is a race
|
|
1728 condition here; if a SIGIO arrives between now and the select
|
765
|
1729 and indicates that a frame is trashed, we lose. */
|
|
1730 if (frame_garbaged)
|
648
|
1731 redisplay_preserve_echo_area ();
|
|
1732
|
650
|
1733 if (XINT (read_kbd) && detect_input_pending ())
|
578
|
1734 nfds = 0;
|
|
1735 else
|
|
1736 nfds = select (MAXDESC, &Available, 0, 0, &timeout);
|
588
|
1737
|
578
|
1738 xerrno = errno;
|
|
1739
|
|
1740 /* Make C-g and alarm signals set flags again */
|
|
1741 clear_waiting_for_input ();
|
|
1742
|
|
1743 /* If we woke up due to SIGWINCH, actually change size now. */
|
|
1744 do_pending_window_change ();
|
|
1745
|
648
|
1746 if (time_limit && nfds == 0) /* timeout elapsed */
|
578
|
1747 break;
|
|
1748 if (nfds < 0)
|
|
1749 {
|
|
1750 if (xerrno == EINTR)
|
|
1751 FD_ZERO (&Available);
|
|
1752 #ifdef ALLIANT
|
|
1753 /* This happens for no known reason on ALLIANT.
|
|
1754 I am guessing that this is the right response. -- RMS. */
|
|
1755 else if (xerrno == EFAULT)
|
|
1756 FD_ZERO (&Available);
|
|
1757 #endif
|
|
1758 else if (xerrno == EBADF)
|
|
1759 {
|
|
1760 #ifdef AIX
|
|
1761 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
|
|
1762 the child's closure of the pts gives the parent a SIGHUP, and
|
|
1763 the ptc file descriptor is automatically closed,
|
|
1764 yielding EBADF here or at select() call above.
|
|
1765 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
|
|
1766 in m-ibmrt-aix.h), and here we just ignore the select error.
|
|
1767 Cleanup occurs c/o status_notify after SIGCLD. */
|
648
|
1768 FD_ZERO (&Available); /* Cannot depend on values returned */
|
578
|
1769 #else
|
|
1770 abort ();
|
|
1771 #endif
|
|
1772 }
|
|
1773 else
|
|
1774 error("select error: %s", sys_errlist[xerrno]);
|
|
1775 }
|
|
1776 #ifdef sun
|
|
1777 else if (nfds > 0 && FD_ISSET (0, &Available) && interrupt_input)
|
|
1778 /* System sometimes fails to deliver SIGIO. */
|
|
1779 kill (getpid (), SIGIO);
|
|
1780 #endif
|
|
1781
|
|
1782 /* Check for keyboard input */
|
|
1783 /* If there is any, return immediately
|
|
1784 to give it higher priority than subprocesses */
|
|
1785
|
650
|
1786 if (XINT (read_kbd) && detect_input_pending ())
|
578
|
1787 break;
|
|
1788
|
621
|
1789 #ifdef SIGIO
|
578
|
1790 /* If we think we have keyboard input waiting, but didn't get SIGIO
|
|
1791 go read it. This can happen with X on BSD after logging out.
|
|
1792 In that case, there really is no input and no SIGIO,
|
|
1793 but select says there is input. */
|
|
1794
|
|
1795 /*
|
650
|
1796 if (XINT (read_kbd) && interrupt_input && (Available & fileno (stdin)))
|
648
|
1797 */
|
650
|
1798 if (XINT (read_kbd) && interrupt_input && (FD_ISSET (fileno (stdin), &Available)))
|
578
|
1799 kill (0, SIGIO);
|
621
|
1800 #endif
|
578
|
1801
|
|
1802 #ifdef vipc
|
|
1803 /* Check for connection from other process */
|
|
1804
|
|
1805 if (Available & ChannelMask (comm_server))
|
|
1806 {
|
|
1807 Available &= ~(ChannelMask (comm_server));
|
|
1808 create_commchan ();
|
|
1809 }
|
|
1810 #endif vipc
|
|
1811
|
|
1812 if (! wait_proc)
|
|
1813 got_some_input |= nfds > 0;
|
|
1814
|
624
|
1815 /* If checking input just got us a size-change event from X,
|
|
1816 obey it now if we should. */
|
650
|
1817 if (XINT (read_kbd))
|
624
|
1818 do_pending_window_change ();
|
|
1819
|
578
|
1820 /* Check for data from a process or a command channel */
|
|
1821 for (channel = FIRST_PROC_DESC; channel < MAXDESC; channel++)
|
|
1822 {
|
|
1823 if (FD_ISSET (channel, &Available))
|
|
1824 {
|
|
1825 int nread;
|
|
1826
|
|
1827 /* If waiting for this channel, arrange to return as
|
|
1828 soon as no more input to be processed. No more
|
|
1829 waiting. */
|
|
1830 if (wait_channel == channel)
|
|
1831 {
|
|
1832 wait_channel = 0;
|
|
1833 time_limit = -1;
|
|
1834 got_some_input = 1;
|
|
1835 }
|
|
1836 proc = chan_process[channel];
|
|
1837 if (NILP (proc))
|
|
1838 continue;
|
|
1839
|
|
1840 #ifdef vipc
|
|
1841 /* It's a command channel */
|
|
1842 if (!NILP (XPROCESS (proc)->command_channel_p))
|
|
1843 {
|
|
1844 ProcessCommChan (channel, proc);
|
|
1845 if (NILP (XPROCESS (proc)->command_channel_p))
|
|
1846 {
|
|
1847 /* It has ceased to be a command channel! */
|
|
1848 int bytes_available;
|
|
1849 if (ioctl (channel, FIONREAD, &bytes_available) < 0)
|
|
1850 bytes_available = 0;
|
|
1851 if (bytes_available)
|
|
1852 FD_SET (channel, &Available);
|
|
1853 }
|
|
1854 continue;
|
|
1855 }
|
648
|
1856 #endif /* vipc */
|
578
|
1857
|
|
1858 /* Read data from the process, starting with our
|
|
1859 buffered-ahead character if we have one. */
|
|
1860
|
|
1861 nread = read_process_output (proc, channel);
|
|
1862 if (nread > 0)
|
|
1863 {
|
|
1864 /* Since read_process_output can run a filter,
|
|
1865 which can call accept-process-output,
|
|
1866 don't try to read from any other processes
|
|
1867 before doing the select again. */
|
|
1868 FD_ZERO (&Available);
|
|
1869
|
|
1870 if (do_display)
|
|
1871 redisplay_preserve_echo_area ();
|
|
1872 }
|
|
1873 #ifdef EWOULDBLOCK
|
|
1874 else if (nread == -1 && errno == EWOULDBLOCK)
|
|
1875 ;
|
|
1876 #else
|
|
1877 #ifdef O_NONBLOCK
|
|
1878 else if (nread == -1 && errno == EAGAIN)
|
|
1879 ;
|
|
1880 #else
|
|
1881 #ifdef O_NDELAY
|
|
1882 else if (nread == -1 && errno == EAGAIN)
|
|
1883 ;
|
|
1884 /* Note that we cannot distinguish between no input
|
|
1885 available now and a closed pipe.
|
|
1886 With luck, a closed pipe will be accompanied by
|
|
1887 subprocess termination and SIGCHLD. */
|
|
1888 else if (nread == 0 && !NETCONN_P (proc))
|
|
1889 ;
|
648
|
1890 #endif /* O_NDELAY */
|
|
1891 #endif /* O_NONBLOCK */
|
|
1892 #endif /* EWOULDBLOCK */
|
578
|
1893 #ifdef HAVE_PTYS
|
|
1894 /* On some OSs with ptys, when the process on one end of
|
|
1895 a pty exits, the other end gets an error reading with
|
|
1896 errno = EIO instead of getting an EOF (0 bytes read).
|
|
1897 Therefore, if we get an error reading and errno =
|
|
1898 EIO, just continue, because the child process has
|
|
1899 exited and should clean itself up soon (e.g. when we
|
|
1900 get a SIGCHLD). */
|
|
1901 else if (nread == -1 && errno == EIO)
|
|
1902 ;
|
648
|
1903 #endif /* HAVE_PTYS */
|
|
1904 /* If we can detect process termination, don't consider the process
|
|
1905 gone just because its pipe is closed. */
|
578
|
1906 #ifdef SIGCHLD
|
|
1907 else if (nread == 0 && !NETCONN_P (proc))
|
|
1908 ;
|
|
1909 #endif
|
|
1910 else
|
|
1911 {
|
|
1912 /* Preserve status of processes already terminated. */
|
|
1913 XSETINT (XPROCESS (proc)->tick, ++process_tick);
|
|
1914 deactivate_process (proc);
|
|
1915 if (!NILP (XPROCESS (proc)->raw_status_low))
|
|
1916 update_status (XPROCESS (proc));
|
|
1917 if (EQ (XPROCESS (proc)->status, Qrun))
|
|
1918 XPROCESS (proc)->status
|
|
1919 = Fcons (Qexit, Fcons (make_number (256), Qnil));
|
|
1920 }
|
|
1921 }
|
648
|
1922 } /* end for each file descriptor */
|
|
1923 } /* end while exit conditions not met */
|
|
1924
|
|
1925 /* If calling from keyboard input, do not quit
|
|
1926 since we want to return C-g as an input character.
|
|
1927 Otherwise, do pending quit if requested. */
|
650
|
1928 if (XINT (read_kbd) >= 0)
|
648
|
1929 {
|
|
1930 /* Prevent input_pending from remaining set if we quit. */
|
|
1931 clear_input_pending ();
|
|
1932 QUIT;
|
|
1933 }
|
578
|
1934
|
|
1935 return got_some_input;
|
|
1936 }
|
|
1937
|
|
1938 /* Read pending output from the process channel,
|
|
1939 starting with our buffered-ahead character if we have one.
|
|
1940 Yield number of characters read.
|
|
1941
|
|
1942 This function reads at most 1024 characters.
|
|
1943 If you want to read all available subprocess output,
|
|
1944 you must call it repeatedly until it returns zero. */
|
|
1945
|
|
1946 read_process_output (proc, channel)
|
|
1947 Lisp_Object proc;
|
|
1948 register int channel;
|
|
1949 {
|
|
1950 register int nchars;
|
|
1951 #ifdef VMS
|
|
1952 char *chars;
|
|
1953 #else
|
|
1954 char chars[1024];
|
|
1955 #endif
|
|
1956 register Lisp_Object outstream;
|
|
1957 register struct buffer *old = current_buffer;
|
|
1958 register struct Lisp_Process *p = XPROCESS (proc);
|
|
1959 register int opoint;
|
|
1960
|
|
1961 #ifdef VMS
|
|
1962 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
|
|
1963
|
|
1964 vs = get_vms_process_pointer (p->pid);
|
|
1965 if (vs)
|
|
1966 {
|
|
1967 if (!vs->iosb[0])
|
|
1968 return(0); /* Really weird if it does this */
|
|
1969 if (!(vs->iosb[0] & 1))
|
|
1970 return -1; /* I/O error */
|
|
1971 }
|
|
1972 else
|
|
1973 error ("Could not get VMS process pointer");
|
|
1974 chars = vs->inputBuffer;
|
|
1975 nchars = clean_vms_buffer (chars, vs->iosb[1]);
|
|
1976 if (nchars <= 0)
|
|
1977 {
|
|
1978 start_vms_process_read (vs); /* Crank up the next read on the process */
|
|
1979 return 1; /* Nothing worth printing, say we got 1 */
|
|
1980 }
|
|
1981 #else /* not VMS */
|
|
1982
|
|
1983 if (proc_buffered_char[channel] < 0)
|
|
1984 nchars = read (channel, chars, sizeof chars);
|
|
1985 else
|
|
1986 {
|
|
1987 chars[0] = proc_buffered_char[channel];
|
|
1988 proc_buffered_char[channel] = -1;
|
|
1989 nchars = read (channel, chars + 1, sizeof chars - 1);
|
|
1990 if (nchars < 0)
|
|
1991 nchars = 1;
|
|
1992 else
|
|
1993 nchars = nchars + 1;
|
|
1994 }
|
|
1995 #endif /* not VMS */
|
|
1996
|
|
1997 if (nchars <= 0) return nchars;
|
|
1998
|
|
1999 outstream = p->filter;
|
|
2000 if (!NILP (outstream))
|
|
2001 {
|
|
2002 /* We inhibit quit here instead of just catching it so that
|
|
2003 hitting ^G when a filter happens to be running won't screw
|
|
2004 it up. */
|
|
2005 int count = specpdl_ptr - specpdl;
|
|
2006 specbind (Qinhibit_quit, Qt);
|
|
2007 call2 (outstream, proc, make_string (chars, nchars));
|
|
2008
|
|
2009 #ifdef VMS
|
|
2010 start_vms_process_read (vs);
|
|
2011 #endif
|
|
2012 unbind_to (count);
|
|
2013 return nchars;
|
|
2014 }
|
|
2015
|
|
2016 /* If no filter, write into buffer if it isn't dead. */
|
|
2017 if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
|
|
2018 {
|
|
2019 Lisp_Object tem;
|
|
2020
|
|
2021 Fset_buffer (p->buffer);
|
|
2022 opoint = point;
|
|
2023
|
|
2024 /* Insert new output into buffer
|
|
2025 at the current end-of-output marker,
|
|
2026 thus preserving logical ordering of input and output. */
|
|
2027 if (XMARKER (p->mark)->buffer)
|
|
2028 SET_PT (marker_position (p->mark));
|
|
2029 else
|
|
2030 SET_PT (ZV);
|
|
2031 if (point <= opoint)
|
|
2032 opoint += nchars;
|
|
2033
|
|
2034 tem = current_buffer->read_only;
|
|
2035 current_buffer->read_only = Qnil;
|
|
2036 /* Insert before markers in case we are inserting where
|
|
2037 the buffer's mark is, and the user's next command is Meta-y. */
|
|
2038 insert_before_markers (chars, nchars);
|
|
2039 current_buffer->read_only = tem;
|
|
2040 Fset_marker (p->mark, make_number (point), p->buffer);
|
|
2041 update_mode_lines++;
|
|
2042
|
|
2043 SET_PT (opoint);
|
|
2044 set_buffer_internal (old);
|
|
2045 }
|
|
2046 #ifdef VMS
|
|
2047 start_vms_process_read (vs);
|
|
2048 #endif
|
|
2049 return nchars;
|
|
2050 }
|
|
2051
|
|
2052 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
|
|
2053 0, 0, 0,
|
|
2054 "Returns non-NIL if emacs is waiting for input from the user.\n\
|
|
2055 This is intended for use by asynchronous process output filters and sentinels.")
|
|
2056 ()
|
|
2057 {
|
|
2058 return ((waiting_for_user_input_p) ? Qt : Qnil);
|
|
2059 }
|
|
2060
|
|
2061 /* Sending data to subprocess */
|
|
2062
|
|
2063 jmp_buf send_process_frame;
|
|
2064
|
|
2065 SIGTYPE
|
|
2066 send_process_trap ()
|
|
2067 {
|
|
2068 #ifdef BSD4_1
|
|
2069 sigrelse (SIGPIPE);
|
|
2070 sigrelse (SIGALRM);
|
|
2071 #endif /* BSD4_1 */
|
|
2072 longjmp (send_process_frame, 1);
|
|
2073 }
|
|
2074
|
|
2075 send_process (proc, buf, len)
|
|
2076 Lisp_Object proc;
|
|
2077 char *buf;
|
|
2078 int len;
|
|
2079 {
|
|
2080 /* Don't use register vars; longjmp can lose them. */
|
|
2081 int rv;
|
|
2082 unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
|
|
2083
|
|
2084
|
|
2085 #ifdef VMS
|
|
2086 struct Lisp_Process *p = XPROCESS (proc);
|
|
2087 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
|
|
2088 #endif /* VMS */
|
|
2089
|
|
2090 if (! NILP (XPROCESS (proc)->raw_status_low))
|
|
2091 update_status (XPROCESS (proc));
|
|
2092 if (! EQ (XPROCESS (proc)->status, Qrun))
|
|
2093 error ("Process %s not running", procname);
|
|
2094
|
|
2095 #ifdef VMS
|
|
2096 vs = get_vms_process_pointer (p->pid);
|
|
2097 if (vs == 0)
|
|
2098 error ("Could not find this process: %x", p->pid);
|
|
2099 else if (write_to_vms_process (vs, buf, len))
|
|
2100 ;
|
|
2101 #else
|
|
2102 if (!setjmp (send_process_frame))
|
|
2103 while (len > 0)
|
|
2104 {
|
|
2105 int this = len;
|
621
|
2106 SIGTYPE (*old_sigpipe)();
|
|
2107
|
578
|
2108 /* Don't send more than 500 bytes at a time. */
|
|
2109 if (this > 500)
|
|
2110 this = 500;
|
692
|
2111 old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
|
578
|
2112 rv = write (XFASTINT (XPROCESS (proc)->outfd), buf, this);
|
621
|
2113 signal (SIGPIPE, old_sigpipe);
|
578
|
2114 if (rv < 0)
|
|
2115 {
|
|
2116 if (0
|
|
2117 #ifdef EWOULDBLOCK
|
|
2118 || errno == EWOULDBLOCK
|
|
2119 #endif
|
|
2120 #ifdef EAGAIN
|
|
2121 || errno == EAGAIN
|
|
2122 #endif
|
|
2123 )
|
|
2124 {
|
|
2125 /* It would be nice to accept process output here,
|
|
2126 but that is difficult. For example, it could
|
|
2127 garbage what we are sending if that is from a buffer. */
|
|
2128 immediate_quit = 1;
|
|
2129 QUIT;
|
|
2130 sleep (1);
|
|
2131 immediate_quit = 0;
|
|
2132 continue;
|
|
2133 }
|
|
2134 report_file_error ("writing to process", Fcons (proc, Qnil));
|
|
2135 }
|
|
2136 buf += rv;
|
|
2137 len -= rv;
|
|
2138 /* Allow input from processes between bursts of sending.
|
|
2139 Otherwise things may get stopped up. */
|
|
2140 if (len > 0)
|
650
|
2141 {
|
|
2142 Lisp_Object zero;
|
|
2143
|
|
2144 XFASTINT (zero) = 0;
|
|
2145 wait_reading_process_input (-1, 0, zero, 0);
|
|
2146 }
|
578
|
2147 }
|
|
2148 #endif
|
|
2149 else
|
|
2150 {
|
|
2151 XPROCESS (proc)->raw_status_low = Qnil;
|
|
2152 XPROCESS (proc)->raw_status_high = Qnil;
|
|
2153 XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
|
|
2154 XSETINT (XPROCESS (proc)->tick, ++process_tick);
|
|
2155 deactivate_process (proc);
|
|
2156 #ifdef VMS
|
|
2157 error ("Error writing to process %s; closed it", procname);
|
|
2158 #else
|
|
2159 error ("SIGPIPE raised on process %s; closed it", procname);
|
|
2160 #endif
|
|
2161 }
|
|
2162 }
|
|
2163
|
|
2164 DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
|
|
2165 3, 3, 0,
|
|
2166 "Send current contents of region as input to PROCESS.\n\
|
|
2167 PROCESS may be a process name or an actual process.\n\
|
|
2168 Called from program, takes three arguments, PROCESS, START and END.\n\
|
|
2169 If the region is more than 500 characters long,\n\
|
|
2170 it is sent in several bunches. This may happen even for shorter regions.\n\
|
|
2171 Output from processes can arrive in between bunches.")
|
|
2172 (process, start, end)
|
|
2173 Lisp_Object process, start, end;
|
|
2174 {
|
|
2175 Lisp_Object proc;
|
|
2176 int start1;
|
|
2177
|
|
2178 proc = get_process (process);
|
|
2179 validate_region (&start, &end);
|
|
2180
|
|
2181 if (XINT (start) < GPT && XINT (end) > GPT)
|
|
2182 move_gap (start);
|
|
2183
|
|
2184 start1 = XINT (start);
|
|
2185 send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start));
|
|
2186
|
|
2187 return Qnil;
|
|
2188 }
|
|
2189
|
|
2190 DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
|
|
2191 2, 2, 0,
|
|
2192 "Send PROCESS the contents of STRING as input.\n\
|
|
2193 PROCESS may be a process name or an actual process.\n\
|
|
2194 If STRING is more than 500 characters long,\n\
|
|
2195 it is sent in several bunches. This may happen even for shorter strings.\n\
|
|
2196 Output from processes can arrive in between bunches.")
|
|
2197 (process, string)
|
|
2198 Lisp_Object process, string;
|
|
2199 {
|
|
2200 Lisp_Object proc;
|
|
2201 CHECK_STRING (string, 1);
|
|
2202 proc = get_process (process);
|
|
2203 send_process (proc, XSTRING (string)->data, XSTRING (string)->size);
|
|
2204 return Qnil;
|
|
2205 }
|
|
2206
|
|
2207 /* send a signal number SIGNO to PROCESS.
|
|
2208 CURRENT_GROUP means send to the process group that currently owns
|
|
2209 the terminal being used to communicate with PROCESS.
|
|
2210 This is used for various commands in shell mode.
|
|
2211 If NOMSG is zero, insert signal-announcements into process's buffers
|
|
2212 right away. */
|
|
2213
|
|
2214 process_send_signal (process, signo, current_group, nomsg)
|
|
2215 Lisp_Object process;
|
|
2216 int signo;
|
|
2217 Lisp_Object current_group;
|
|
2218 int nomsg;
|
|
2219 {
|
|
2220 Lisp_Object proc;
|
|
2221 register struct Lisp_Process *p;
|
|
2222 int gid;
|
|
2223 int no_pgrp = 0;
|
|
2224
|
|
2225 proc = get_process (process);
|
|
2226 p = XPROCESS (proc);
|
|
2227
|
|
2228 if (!EQ (p->childp, Qt))
|
|
2229 error ("Process %s is not a subprocess",
|
|
2230 XSTRING (p->name)->data);
|
|
2231 if (!XFASTINT (p->infd))
|
|
2232 error ("Process %s is not active",
|
|
2233 XSTRING (p->name)->data);
|
|
2234
|
|
2235 if (NILP (p->pty_flag))
|
|
2236 current_group = Qnil;
|
|
2237
|
|
2238 #ifdef TIOCGPGRP /* Not sure about this! (fnf) */
|
|
2239 /* If we are using pgrps, get a pgrp number and make it negative. */
|
|
2240 if (!NILP (current_group))
|
|
2241 {
|
|
2242 /* If possible, send signals to the entire pgrp
|
|
2243 by sending an input character to it. */
|
|
2244 #if defined (TIOCGLTC) && defined (TIOCGETC)
|
|
2245 struct tchars c;
|
|
2246 struct ltchars lc;
|
|
2247
|
|
2248 switch (signo)
|
|
2249 {
|
|
2250 case SIGINT:
|
|
2251 ioctl (XFASTINT (p->infd), TIOCGETC, &c);
|
|
2252 send_process (proc, &c.t_intrc, 1);
|
|
2253 return Qnil;
|
|
2254 case SIGQUIT:
|
|
2255 ioctl (XFASTINT (p->infd), TIOCGETC, &c);
|
|
2256 send_process (proc, &c.t_quitc, 1);
|
|
2257 return Qnil;
|
|
2258 case SIGTSTP:
|
|
2259 ioctl (XFASTINT (p->infd), TIOCGLTC, &lc);
|
|
2260 send_process (proc, &lc.t_suspc, 1);
|
|
2261 return Qnil;
|
|
2262 }
|
|
2263 #endif /* have TIOCGLTC and have TIOCGETC */
|
|
2264 /* It is possible that the following code would work
|
|
2265 on other kinds of USG systems, not just on the IRIS.
|
|
2266 This should be tried in Emacs 19. */
|
|
2267 #if defined (IRIS) && defined (HAVE_SETSID) /* Check for Irix, not older
|
|
2268 systems. */
|
|
2269 struct termio t;
|
|
2270 switch (signo)
|
|
2271 {
|
|
2272 case SIGINT:
|
|
2273 ioctl (XFASTINT (p->infd), TCGETA, &t);
|
|
2274 send_process (proc, &t.c_cc[VINTR], 1);
|
|
2275 return Qnil;
|
|
2276 case SIGQUIT:
|
|
2277 ioctl (XFASTINT (p->infd), TCGETA, &t);
|
|
2278 send_process (proc, &t.c_cc[VQUIT], 1);
|
|
2279 return Qnil;
|
|
2280 case SIGTSTP:
|
|
2281 ioctl (XFASTINT (p->infd), TCGETA, &t);
|
|
2282 send_process (proc, &t.c_cc[VSWTCH], 1);
|
|
2283 return Qnil;
|
|
2284 }
|
|
2285 #endif /* IRIS and HAVE_SETSID */
|
|
2286
|
|
2287 /* Get the pgrp using the tty itself, if we have that.
|
|
2288 Otherwise, use the pty to get the pgrp.
|
|
2289 On pfa systems, saka@pfu.fujitsu.co.JP writes:
|
|
2290 "TICGPGRP symbol defined in sys/ioctl.h at E50.
|
|
2291 But, TIOCGPGRP donot work on E50 ;-P work fine on E60"
|
|
2292 His patch indicates that if TIOCGPGRP returns an error, then
|
|
2293 we should just assume that p->pid is also the process group id. */
|
|
2294 {
|
|
2295 int err;
|
|
2296
|
|
2297 if (!NILP (p->subtty))
|
|
2298 err = ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
|
|
2299 else
|
|
2300 err = ioctl (XFASTINT (p->infd), TIOCGPGRP, &gid);
|
|
2301
|
|
2302 #ifdef pfa
|
|
2303 if (err == -1)
|
|
2304 gid = - XFASTINT (p->pid);
|
|
2305 #endif
|
|
2306 }
|
|
2307 if (gid == -1)
|
|
2308 no_pgrp = 1;
|
|
2309 else
|
|
2310 gid = - gid;
|
|
2311 }
|
|
2312 else
|
|
2313 gid = - XFASTINT (p->pid);
|
|
2314 #else /* not using pgrps */
|
|
2315 /* Can't select pgrps on this system, so we know that
|
|
2316 the child itself heads the pgrp. */
|
|
2317 gid = - XFASTINT (p->pid);
|
|
2318 #endif /* not using pgrps */
|
|
2319
|
|
2320 switch (signo)
|
|
2321 {
|
|
2322 #ifdef SIGCONT
|
|
2323 case SIGCONT:
|
|
2324 p->raw_status_low = Qnil;
|
|
2325 p->raw_status_high = Qnil;
|
|
2326 p->status = Qrun;
|
|
2327 XSETINT (p->tick, ++process_tick);
|
|
2328 if (!nomsg)
|
|
2329 status_notify ();
|
|
2330 break;
|
|
2331 #endif
|
|
2332 case SIGINT:
|
|
2333 #ifdef VMS
|
|
2334 send_process (proc, "\003", 1); /* ^C */
|
|
2335 goto whoosh;
|
|
2336 #endif
|
|
2337 case SIGQUIT:
|
|
2338 #ifdef VMS
|
|
2339 send_process (proc, "\031", 1); /* ^Y */
|
|
2340 goto whoosh;
|
|
2341 #endif
|
|
2342 case SIGKILL:
|
|
2343 #ifdef VMS
|
|
2344 sys$forcex (&(XFASTINT (p->pid)), 0, 1);
|
|
2345 whoosh:
|
|
2346 #endif
|
|
2347 flush_pending_output (XFASTINT (p->infd));
|
|
2348 break;
|
|
2349 }
|
|
2350
|
|
2351 /* If we don't have process groups, send the signal to the immediate
|
|
2352 subprocess. That isn't really right, but it's better than any
|
|
2353 obvious alternative. */
|
|
2354 if (no_pgrp)
|
|
2355 {
|
|
2356 kill (XFASTINT (p->pid), signo);
|
|
2357 return;
|
|
2358 }
|
|
2359
|
|
2360 /* gid may be a pid, or minus a pgrp's number */
|
|
2361 #ifdef TIOCSIGSEND
|
|
2362 if (!NILP (current_group))
|
|
2363 ioctl (XFASTINT (p->infd), TIOCSIGSEND, signo);
|
|
2364 else
|
|
2365 {
|
|
2366 gid = - XFASTINT (p->pid);
|
|
2367 kill (gid, signo);
|
|
2368 }
|
|
2369 #else /* no TIOCSIGSEND */
|
|
2370 EMACS_KILLPG (-gid, signo);
|
|
2371 #endif
|
|
2372 }
|
|
2373
|
|
2374 DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
|
|
2375 "Interrupt process PROCESS. May be process or name of one.\n\
|
|
2376 Nil or no arg means current buffer's process.\n\
|
|
2377 Second arg CURRENT-GROUP non-nil means send signal to\n\
|
|
2378 the current process-group of the process's controlling terminal\n\
|
|
2379 rather than to the process's own process group.\n\
|
|
2380 If the process is a shell, this means interrupt current subjob\n\
|
|
2381 rather than the shell.")
|
|
2382 (process, current_group)
|
|
2383 Lisp_Object process, current_group;
|
|
2384 {
|
|
2385 process_send_signal (process, SIGINT, current_group, 0);
|
|
2386 return process;
|
|
2387 }
|
|
2388
|
|
2389 DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
|
|
2390 "Kill process PROCESS. May be process or name of one.\n\
|
|
2391 See function `interrupt-process' for more details on usage.")
|
|
2392 (process, current_group)
|
|
2393 Lisp_Object process, current_group;
|
|
2394 {
|
|
2395 process_send_signal (process, SIGKILL, current_group, 0);
|
|
2396 return process;
|
|
2397 }
|
|
2398
|
|
2399 DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
|
|
2400 "Send QUIT signal to process PROCESS. May be process or name of one.\n\
|
|
2401 See function `interrupt-process' for more details on usage.")
|
|
2402 (process, current_group)
|
|
2403 Lisp_Object process, current_group;
|
|
2404 {
|
|
2405 process_send_signal (process, SIGQUIT, current_group, 0);
|
|
2406 return process;
|
|
2407 }
|
|
2408
|
|
2409 DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
|
|
2410 "Stop process PROCESS. May be process or name of one.\n\
|
|
2411 See function `interrupt-process' for more details on usage.")
|
|
2412 (process, current_group)
|
|
2413 Lisp_Object process, current_group;
|
|
2414 {
|
|
2415 #ifndef SIGTSTP
|
|
2416 error ("no SIGTSTP support");
|
|
2417 #else
|
|
2418 process_send_signal (process, SIGTSTP, current_group, 0);
|
|
2419 #endif
|
|
2420 return process;
|
|
2421 }
|
|
2422
|
|
2423 DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
|
|
2424 "Continue process PROCESS. May be process or name of one.\n\
|
|
2425 See function `interrupt-process' for more details on usage.")
|
|
2426 (process, current_group)
|
|
2427 Lisp_Object process, current_group;
|
|
2428 {
|
|
2429 #ifdef SIGCONT
|
|
2430 process_send_signal (process, SIGCONT, current_group, 0);
|
|
2431 #else
|
|
2432 error ("no SIGCONT support");
|
|
2433 #endif
|
|
2434 return process;
|
|
2435 }
|
|
2436
|
|
2437 DEFUN ("signal-process", Fsignal_process, Ssignal_process,
|
|
2438 2, 2, "nProcess number: \nnSignal code: ",
|
|
2439 "Send the process with number PID the signal with code CODE.\n\
|
|
2440 Both PID and CODE are integers.")
|
|
2441 (pid, sig)
|
|
2442 Lisp_Object pid, sig;
|
|
2443 {
|
|
2444 CHECK_NUMBER (pid, 0);
|
|
2445 CHECK_NUMBER (sig, 1);
|
|
2446 return make_number (kill (XINT (pid), XINT (sig)));
|
|
2447 }
|
|
2448
|
|
2449 DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
|
|
2450 "Make PROCESS see end-of-file in its input.\n\
|
|
2451 Eof comes after any text already sent to it.\n\
|
|
2452 nil or no arg means current buffer's process.")
|
|
2453 (process)
|
|
2454 Lisp_Object process;
|
|
2455 {
|
|
2456 Lisp_Object proc;
|
|
2457
|
|
2458 proc = get_process (process);
|
|
2459 /* Sending a zero-length record is supposed to mean eof
|
|
2460 when TIOCREMOTE is turned on. */
|
|
2461 #ifdef DID_REMOTE
|
|
2462 {
|
|
2463 char buf[1];
|
|
2464 write (XFASTINT (XPROCESS (proc)->outfd), buf, 0);
|
|
2465 }
|
|
2466 #else /* did not do TOICREMOTE */
|
|
2467 #ifdef VMS
|
|
2468 send_process (proc, "\032", 1); /* ^z */
|
|
2469 #else
|
|
2470 if (!NILP (XPROCESS (proc)->pty_flag))
|
|
2471 send_process (proc, "\004", 1);
|
|
2472 else
|
|
2473 {
|
|
2474 close (XPROCESS (proc)->outfd);
|
|
2475 XFASTINT (XPROCESS (proc)->outfd) = open ("/dev/null", O_WRONLY);
|
|
2476 }
|
|
2477 #endif /* VMS */
|
|
2478 #endif /* did not do TOICREMOTE */
|
|
2479 return process;
|
|
2480 }
|
|
2481
|
|
2482 /* Kill all processes associated with `buffer'.
|
|
2483 If `buffer' is nil, kill all processes */
|
|
2484
|
|
2485 kill_buffer_processes (buffer)
|
|
2486 Lisp_Object buffer;
|
|
2487 {
|
|
2488 Lisp_Object tail, proc;
|
|
2489
|
|
2490 for (tail = Vprocess_alist; XGCTYPE (tail) == Lisp_Cons;
|
|
2491 tail = XCONS (tail)->cdr)
|
|
2492 {
|
|
2493 proc = XCONS (XCONS (tail)->car)->cdr;
|
|
2494 if (XGCTYPE (proc) == Lisp_Process
|
|
2495 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
|
|
2496 {
|
|
2497 if (NETCONN_P (proc))
|
|
2498 deactivate_process (proc);
|
|
2499 else if (XFASTINT (XPROCESS (proc)->infd))
|
|
2500 process_send_signal (proc, SIGHUP, Qnil, 1);
|
|
2501 }
|
|
2502 }
|
|
2503 }
|
|
2504
|
|
2505 /* On receipt of a signal that a child status has changed,
|
|
2506 loop asking about children with changed statuses until
|
|
2507 the system says there are no more.
|
|
2508 All we do is change the status;
|
|
2509 we do not run sentinels or print notifications.
|
|
2510 That is saved for the next time keyboard input is done,
|
|
2511 in order to avoid timing errors. */
|
|
2512
|
|
2513 /** WARNING: this can be called during garbage collection.
|
|
2514 Therefore, it must not be fooled by the presence of mark bits in
|
|
2515 Lisp objects. */
|
|
2516
|
|
2517 /** USG WARNING: Although it is not obvious from the documentation
|
|
2518 in signal(2), on a USG system the SIGCLD handler MUST NOT call
|
|
2519 signal() before executing at least one wait(), otherwise the handler
|
|
2520 will be called again, resulting in an infinite loop. The relevant
|
|
2521 portion of the documentation reads "SIGCLD signals will be queued
|
|
2522 and the signal-catching function will be continually reentered until
|
|
2523 the queue is empty". Invoking signal() causes the kernel to reexamine
|
|
2524 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
|
|
2525
|
|
2526 SIGTYPE
|
|
2527 sigchld_handler (signo)
|
|
2528 int signo;
|
|
2529 {
|
|
2530 int old_errno = errno;
|
|
2531 Lisp_Object proc;
|
|
2532 register struct Lisp_Process *p;
|
|
2533
|
|
2534 #ifdef BSD4_1
|
|
2535 extern int sigheld;
|
|
2536 sigheld |= sigbit (SIGCHLD);
|
|
2537 #endif
|
|
2538
|
|
2539 while (1)
|
|
2540 {
|
|
2541 register int pid;
|
|
2542 WAITTYPE w;
|
|
2543 Lisp_Object tail;
|
|
2544
|
|
2545 #ifdef WNOHANG
|
|
2546 #ifndef WUNTRACED
|
|
2547 #define WUNTRACED 0
|
|
2548 #endif /* no WUNTRACED */
|
|
2549 /* Keep trying to get a status until we get a definitive result. */
|
|
2550 do
|
|
2551 {
|
|
2552 errno = 0;
|
|
2553 pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
|
|
2554 }
|
|
2555 while (pid <= 0 && errno == EINTR);
|
|
2556
|
|
2557 if (pid <= 0)
|
|
2558 {
|
|
2559 /* A real failure. We have done all our job, so return. */
|
|
2560
|
|
2561 /* USG systems forget handlers when they are used;
|
|
2562 must reestablish each time */
|
|
2563 #ifdef USG
|
|
2564 signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
|
|
2565 #endif
|
|
2566 #ifdef BSD4_1
|
|
2567 sigheld &= ~sigbit (SIGCHLD);
|
|
2568 sigrelse (SIGCHLD);
|
|
2569 #endif
|
|
2570 errno = old_errno;
|
|
2571 return;
|
|
2572 }
|
|
2573 #else
|
|
2574 pid = wait (&w);
|
|
2575 #endif /* no WNOHANG */
|
|
2576
|
|
2577 /* Find the process that signaled us, and record its status. */
|
|
2578
|
|
2579 p = 0;
|
|
2580 for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
|
|
2581 {
|
|
2582 proc = XCONS (XCONS (tail)->car)->cdr;
|
|
2583 p = XPROCESS (proc);
|
|
2584 if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
|
|
2585 break;
|
|
2586 p = 0;
|
|
2587 }
|
|
2588
|
|
2589 /* Look for an asynchronous process whose pid hasn't been filled
|
|
2590 in yet. */
|
|
2591 if (p == 0)
|
|
2592 for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
|
|
2593 {
|
|
2594 proc = XCONS (XCONS (tail)->car)->cdr;
|
|
2595 p = XPROCESS (proc);
|
|
2596 if (XTYPE (p->pid) == Lisp_Int && XINT (p->pid) == -1)
|
|
2597 break;
|
|
2598 p = 0;
|
|
2599 }
|
|
2600
|
|
2601 /* Change the status of the process that was found. */
|
|
2602 if (p != 0)
|
|
2603 {
|
|
2604 union { int i; WAITTYPE wt; } u;
|
|
2605
|
|
2606 XSETINT (p->tick, ++process_tick);
|
|
2607 u.wt = w;
|
|
2608 XFASTINT (p->raw_status_low) = u.i & 0xffff;
|
|
2609 XFASTINT (p->raw_status_high) = u.i >> 16;
|
|
2610
|
|
2611 /* If process has terminated, stop waiting for its output. */
|
|
2612 if (WIFSIGNALED (w) || WIFEXITED (w))
|
|
2613 if (p->infd)
|
|
2614 FD_CLR (p->infd, &input_wait_mask);
|
|
2615 }
|
|
2616
|
|
2617 /* There was no asynchronous process found for that id. Check
|
|
2618 if we have a synchronous process. */
|
|
2619 else
|
|
2620 {
|
|
2621 synch_process_alive = 0;
|
|
2622
|
|
2623 /* Report the status of the synchronous process. */
|
|
2624 if (WIFEXITED (w))
|
|
2625 synch_process_retcode = WRETCODE (w);
|
|
2626 else if (WIFSIGNALED (w))
|
|
2627 synch_process_death = sys_siglist[WTERMSIG (w)];
|
|
2628 }
|
|
2629
|
|
2630 /* On some systems, we must return right away.
|
|
2631 If any more processes want to signal us, we will
|
|
2632 get another signal.
|
|
2633 Otherwise (on systems that have WNOHANG), loop around
|
|
2634 to use up all the processes that have something to tell us. */
|
|
2635 #if defined (USG) && ! (defined (HPUX) && defined (WNOHANG))
|
|
2636 #ifdef USG
|
|
2637 signal (signo, sigchld_handler);
|
|
2638 #endif
|
|
2639 errno = old_errno;
|
|
2640 return;
|
|
2641 #endif /* USG, but not HPUX with WNOHANG */
|
|
2642 }
|
|
2643 }
|
|
2644
|
|
2645
|
|
2646 static Lisp_Object
|
|
2647 exec_sentinel_unwind (data)
|
|
2648 Lisp_Object data;
|
|
2649 {
|
|
2650 XPROCESS (XCONS (data)->car)->sentinel = XCONS (data)->cdr;
|
|
2651 return Qnil;
|
|
2652 }
|
|
2653
|
|
2654 static void
|
|
2655 exec_sentinel (proc, reason)
|
|
2656 Lisp_Object proc, reason;
|
|
2657 {
|
|
2658 Lisp_Object sentinel;
|
|
2659 register struct Lisp_Process *p = XPROCESS (proc);
|
|
2660 int count = specpdl_ptr - specpdl;
|
|
2661
|
|
2662 sentinel = p->sentinel;
|
|
2663 if (NILP (sentinel))
|
|
2664 return;
|
|
2665
|
|
2666 /* Zilch the sentinel while it's running, to avoid recursive invocations;
|
|
2667 assure that it gets restored no matter how the sentinel exits. */
|
|
2668 p->sentinel = Qnil;
|
|
2669 record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
|
|
2670 /* Inhibit quit so that random quits don't screw up a running filter. */
|
|
2671 specbind (Qinhibit_quit, Qt);
|
|
2672 call2 (sentinel, proc, reason);
|
|
2673 unbind_to (count);
|
|
2674 }
|
|
2675
|
|
2676 /* Report all recent events of a change in process status
|
|
2677 (either run the sentinel or output a message).
|
|
2678 This is done while Emacs is waiting for keyboard input. */
|
|
2679
|
|
2680 status_notify ()
|
|
2681 {
|
|
2682 register Lisp_Object proc, buffer;
|
|
2683 Lisp_Object tail = Qnil;
|
|
2684 Lisp_Object msg = Qnil;
|
|
2685 struct gcpro gcpro1, gcpro2;
|
|
2686
|
|
2687 /* We need to gcpro tail; if read_process_output calls a filter
|
|
2688 which deletes a process and removes the cons to which tail points
|
|
2689 from Vprocess_alist, and then causes a GC, tail is an unprotected
|
|
2690 reference. */
|
|
2691 GCPRO2 (tail, msg);
|
|
2692
|
|
2693 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
|
|
2694 {
|
|
2695 Lisp_Object symbol;
|
|
2696 register struct Lisp_Process *p;
|
|
2697
|
|
2698 proc = Fcdr (Fcar (tail));
|
|
2699 p = XPROCESS (proc);
|
|
2700
|
|
2701 if (XINT (p->tick) != XINT (p->update_tick))
|
|
2702 {
|
|
2703 XSETINT (p->update_tick, XINT (p->tick));
|
|
2704
|
|
2705 /* If process is still active, read any output that remains. */
|
|
2706 if (XFASTINT (p->infd))
|
|
2707 while (read_process_output (proc, XFASTINT (p->infd)) > 0);
|
|
2708
|
|
2709 buffer = p->buffer;
|
|
2710
|
|
2711 /* Get the text to use for the message. */
|
|
2712 if (!NILP (p->raw_status_low))
|
|
2713 update_status (p);
|
|
2714 msg = status_message (p->status);
|
|
2715
|
|
2716 /* If process is terminated, deactivate it or delete it. */
|
|
2717 symbol = p->status;
|
|
2718 if (XTYPE (p->status) == Lisp_Cons)
|
|
2719 symbol = XCONS (p->status)->car;
|
|
2720
|
|
2721 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
|
|
2722 || EQ (symbol, Qclosed))
|
|
2723 {
|
|
2724 if (delete_exited_processes)
|
|
2725 remove_process (proc);
|
|
2726 else
|
|
2727 deactivate_process (proc);
|
|
2728 }
|
|
2729
|
|
2730 /* Now output the message suitably. */
|
|
2731 if (!NILP (p->sentinel))
|
|
2732 exec_sentinel (proc, msg);
|
|
2733 /* Don't bother with a message in the buffer
|
|
2734 when a process becomes runnable. */
|
|
2735 else if (!EQ (symbol, Qrun) && !NILP (buffer))
|
|
2736 {
|
|
2737 Lisp_Object ro = XBUFFER (buffer)->read_only;
|
|
2738 Lisp_Object tem;
|
|
2739 struct buffer *old = current_buffer;
|
|
2740 int opoint;
|
|
2741
|
|
2742 /* Avoid error if buffer is deleted
|
|
2743 (probably that's why the process is dead, too) */
|
|
2744 if (NILP (XBUFFER (buffer)->name))
|
|
2745 continue;
|
|
2746 Fset_buffer (buffer);
|
|
2747 opoint = point;
|
|
2748 /* Insert new output into buffer
|
|
2749 at the current end-of-output marker,
|
|
2750 thus preserving logical ordering of input and output. */
|
|
2751 if (XMARKER (p->mark)->buffer)
|
|
2752 SET_PT (marker_position (p->mark));
|
|
2753 else
|
|
2754 SET_PT (ZV);
|
|
2755 if (point <= opoint)
|
|
2756 opoint += XSTRING (msg)->size + XSTRING (p->name)->size + 10;
|
|
2757
|
|
2758 tem = current_buffer->read_only;
|
|
2759 current_buffer->read_only = Qnil;
|
|
2760 insert_string ("\nProcess ");
|
|
2761 Finsert (1, &p->name);
|
|
2762 insert_string (" ");
|
|
2763 Finsert (1, &msg);
|
|
2764 current_buffer->read_only = tem;
|
|
2765 Fset_marker (p->mark, make_number (point), p->buffer);
|
|
2766
|
|
2767 SET_PT (opoint);
|
|
2768 set_buffer_internal (old);
|
|
2769 }
|
|
2770 }
|
|
2771 } /* end for */
|
|
2772
|
|
2773 update_mode_lines++; /* in case buffers use %s in mode-line-format */
|
|
2774 redisplay_preserve_echo_area ();
|
|
2775
|
|
2776 update_tick = process_tick;
|
|
2777
|
|
2778 UNGCPRO;
|
|
2779 }
|
|
2780
|
|
2781 init_process ()
|
|
2782 {
|
|
2783 register int i;
|
|
2784
|
|
2785 #ifdef SIGCHLD
|
|
2786 #ifndef CANNOT_DUMP
|
|
2787 if (! noninteractive || initialized)
|
|
2788 #endif
|
|
2789 signal (SIGCHLD, sigchld_handler);
|
|
2790 #endif
|
|
2791
|
|
2792 FD_ZERO (&input_wait_mask);
|
|
2793 FD_SET (0, &input_wait_mask);
|
|
2794 Vprocess_alist = Qnil;
|
|
2795 for (i = 0; i < MAXDESC; i++)
|
|
2796 {
|
|
2797 chan_process[i] = Qnil;
|
|
2798 proc_buffered_char[i] = -1;
|
|
2799 }
|
|
2800 }
|
604
|
2801 #if 0
|
578
|
2802 DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 0, 1, 0,
|
|
2803 "Return the connection type of `PROCESS'. This can be nil (pipe),\n\
|
|
2804 t or pty (pty) or stream (socket connection).")
|
|
2805 (process)
|
|
2806 Lisp_Object process;
|
|
2807 {
|
|
2808 return XPROCESS (process)->type;
|
|
2809 }
|
|
2810 #endif
|
|
2811 syms_of_process ()
|
|
2812 {
|
|
2813 #ifdef HAVE_PTYS
|
|
2814 pty_process = intern ("pty");
|
|
2815 #endif
|
|
2816 #ifdef HAVE_SOCKETS
|
|
2817 stream_process = intern ("stream");
|
|
2818 #endif
|
|
2819 Qprocessp = intern ("processp");
|
|
2820 staticpro (&Qprocessp);
|
|
2821 Qrun = intern ("run");
|
|
2822 staticpro (&Qrun);
|
|
2823 Qstop = intern ("stop");
|
|
2824 staticpro (&Qstop);
|
|
2825 Qsignal = intern ("signal");
|
|
2826 staticpro (&Qsignal);
|
|
2827
|
|
2828 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
|
|
2829 here again.
|
|
2830
|
|
2831 Qexit = intern ("exit");
|
|
2832 staticpro (&Qexit); */
|
|
2833
|
|
2834 Qopen = intern ("open");
|
|
2835 staticpro (&Qopen);
|
|
2836 Qclosed = intern ("closed");
|
|
2837 staticpro (&Qclosed);
|
|
2838
|
|
2839 staticpro (&Vprocess_alist);
|
|
2840
|
|
2841 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
|
|
2842 "*Non-nil means delete processes immediately when they exit.\n\
|
|
2843 nil means don't delete them until `list-processes' is run.");
|
|
2844
|
|
2845 delete_exited_processes = 1;
|
|
2846
|
|
2847 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
|
|
2848 "Control type of device used to communicate with subprocesses.\n\
|
|
2849 Values are nil to use a pipe, and t or 'pty for a pty. Note that if\n\
|
|
2850 pty's are not available, this variable will be ignored. The value takes\n\
|
|
2851 effect when `start-process' is called.");
|
|
2852 Vprocess_connection_type = Qt;
|
|
2853
|
|
2854 defsubr (&Sprocessp);
|
|
2855 defsubr (&Sget_process);
|
|
2856 defsubr (&Sget_buffer_process);
|
|
2857 defsubr (&Sdelete_process);
|
|
2858 defsubr (&Sprocess_status);
|
|
2859 defsubr (&Sprocess_exit_status);
|
|
2860 defsubr (&Sprocess_id);
|
|
2861 defsubr (&Sprocess_name);
|
|
2862 defsubr (&Sprocess_command);
|
|
2863 defsubr (&Sset_process_buffer);
|
|
2864 defsubr (&Sprocess_buffer);
|
|
2865 defsubr (&Sprocess_mark);
|
|
2866 defsubr (&Sset_process_filter);
|
|
2867 defsubr (&Sprocess_filter);
|
|
2868 defsubr (&Sset_process_sentinel);
|
|
2869 defsubr (&Sprocess_sentinel);
|
|
2870 defsubr (&Sprocess_kill_without_query);
|
|
2871 defsubr (&Slist_processes);
|
|
2872 defsubr (&Sprocess_list);
|
|
2873 defsubr (&Sstart_process);
|
|
2874 #ifdef HAVE_SOCKETS
|
|
2875 defsubr (&Sopen_network_stream);
|
|
2876 #endif /* HAVE_SOCKETS */
|
|
2877 defsubr (&Saccept_process_output);
|
|
2878 defsubr (&Sprocess_send_region);
|
|
2879 defsubr (&Sprocess_send_string);
|
|
2880 defsubr (&Sinterrupt_process);
|
|
2881 defsubr (&Skill_process);
|
|
2882 defsubr (&Squit_process);
|
|
2883 defsubr (&Sstop_process);
|
|
2884 defsubr (&Scontinue_process);
|
|
2885 defsubr (&Sprocess_send_eof);
|
|
2886 defsubr (&Ssignal_process);
|
|
2887 defsubr (&Swaiting_for_user_input_p);
|
|
2888 /* defsubr (&Sprocess_connection); */
|
|
2889 }
|
|
2890
|
588
|
2891
|
|
2892 #else /* not subprocesses */
|
|
2893
|
|
2894 #include <sys/types.h>
|
|
2895 #include <errno.h>
|
|
2896
|
|
2897 #include "lisp.h"
|
|
2898 #include "systime.h"
|
|
2899 #include "termopts.h"
|
|
2900
|
765
|
2901 extern int frame_garbaged;
|
588
|
2902
|
|
2903
|
|
2904 /* As described above, except assuming that there are no subprocesses:
|
|
2905
|
|
2906 Wait for timeout to elapse and/or keyboard input to be available.
|
|
2907
|
|
2908 time_limit is:
|
|
2909 timeout in seconds, or
|
|
2910 zero for no limit, or
|
|
2911 -1 means gobble data immediately available but don't wait for any.
|
|
2912
|
650
|
2913 read_kbd is a Lisp_Object:
|
588
|
2914 0 to ignore keyboard input, or
|
|
2915 1 to return when input is available, or
|
|
2916 -1 means caller will actually read the input, so don't throw to
|
|
2917 the quit handler.
|
|
2918 We know that read_kbd will never be a Lisp_Process, since
|
|
2919 `subprocesses' isn't defined.
|
|
2920
|
|
2921 do_display != 0 means redisplay should be done to show subprocess
|
|
2922 output that arrives. This version of the function ignores it.
|
|
2923
|
650
|
2924 Return true iff we recieved input from any process. */
|
588
|
2925
|
|
2926 int
|
|
2927 wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
|
650
|
2928 int time_limit, microsecs;
|
|
2929 Lisp_Object read_kbd;
|
|
2930 int do_display;
|
588
|
2931 {
|
|
2932 EMACS_TIME end_time, timeout, *timeout_p;
|
|
2933 int waitchannels;
|
|
2934
|
|
2935 /* What does time_limit really mean? */
|
|
2936 if (time_limit || microsecs)
|
|
2937 {
|
|
2938 /* It's not infinite. */
|
|
2939 timeout_p = &timeout;
|
|
2940
|
|
2941 if (time_limit == -1)
|
|
2942 /* In fact, it's zero. */
|
|
2943 EMACS_SET_SECS_USECS (timeout, 0, 0);
|
|
2944 else
|
|
2945 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
|
|
2946
|
|
2947 /* How far in the future is that? */
|
|
2948 EMACS_GET_TIME (end_time);
|
|
2949 EMACS_ADD_TIME (end_time, end_time, timeout);
|
|
2950 }
|
|
2951 else
|
|
2952 /* It's infinite. */
|
|
2953 timeout_p = 0;
|
|
2954
|
|
2955 /* Turn off periodic alarms (in case they are in use)
|
|
2956 because the select emulator uses alarms. */
|
|
2957 stop_polling ();
|
|
2958
|
|
2959 for (;;)
|
|
2960 {
|
|
2961 int nfds;
|
|
2962
|
650
|
2963 waitchannels = XINT (read_kbd) ? 1 : 0;
|
588
|
2964
|
|
2965 /* If calling from keyboard input, do not quit
|
|
2966 since we want to return C-g as an input character.
|
|
2967 Otherwise, do pending quit if requested. */
|
650
|
2968 if (XINT (read_kbd) >= 0)
|
588
|
2969 QUIT;
|
|
2970
|
|
2971 if (timeout_p)
|
|
2972 {
|
|
2973 EMACS_GET_TIME (*timeout_p);
|
|
2974 EMACS_SUB_TIME (*timeout_p, end_time, *timeout_p);
|
|
2975 if (EMACS_TIME_NEG_P (*timeout_p))
|
|
2976 break;
|
|
2977 }
|
|
2978
|
|
2979 /* Cause C-g and alarm signals to take immediate action,
|
|
2980 and cause input available signals to zero out timeout. */
|
650
|
2981 if (XINT (read_kbd) < 0)
|
588
|
2982 set_waiting_for_input (&timeout);
|
|
2983
|
765
|
2984 /* If a frame has been newly mapped and needs updating,
|
588
|
2985 reprocess its display stuff. */
|
765
|
2986 if (frame_garbaged)
|
588
|
2987 redisplay_preserve_echo_area ();
|
|
2988
|
650
|
2989 if (XINT (read_kbd) && detect_input_pending ())
|
588
|
2990 nfds = 0;
|
|
2991 else
|
|
2992 nfds = select (1, &waitchannels, 0, 0, timeout_p);
|
|
2993
|
|
2994 /* Make C-g and alarm signals set flags again */
|
|
2995 clear_waiting_for_input ();
|
|
2996
|
|
2997 /* If we woke up due to SIGWINCH, actually change size now. */
|
|
2998 do_pending_window_change ();
|
|
2999
|
|
3000 if (nfds == -1)
|
|
3001 {
|
|
3002 /* If the system call was interrupted, then go around the
|
|
3003 loop again. */
|
|
3004 if (errno == EINTR)
|
|
3005 waitchannels = 0;
|
|
3006 }
|
|
3007 #ifdef sun
|
|
3008 else if (nfds > 0 && (waitchannels & 1) && interrupt_input)
|
|
3009 /* System sometimes fails to deliver SIGIO. */
|
|
3010 kill (getpid (), SIGIO);
|
|
3011 #endif
|
650
|
3012 if (XINT (read_kbd) && interrupt_input && (waitchannels & 1))
|
588
|
3013 kill (0, SIGIO);
|
|
3014
|
|
3015 /* If we have timed out (nfds == 0) or found some input (nfds > 0),
|
|
3016 we should exit. */
|
|
3017 if (nfds >= 0)
|
|
3018 break;
|
|
3019 }
|
|
3020
|
|
3021 return 0;
|
|
3022 }
|
|
3023
|
|
3024
|
|
3025 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
|
|
3026 "Return the (or, a) process associated with BUFFER.\n\
|
|
3027 This copy of Emacs has not been built to support subprocesses, so this\n\
|
|
3028 function always returns nil.")
|
|
3029 (name)
|
|
3030 register Lisp_Object name;
|
|
3031 {
|
|
3032 return Qnil;
|
|
3033 }
|
|
3034
|
|
3035 /* Kill all processes associated with `buffer'.
|
|
3036 If `buffer' is nil, kill all processes.
|
|
3037 Since we have no subprocesses, this does nothing. */
|
|
3038
|
|
3039 kill_buffer_processes (buffer)
|
|
3040 Lisp_Object buffer;
|
|
3041 {
|
|
3042 }
|
|
3043
|
|
3044 init_process ()
|
|
3045 {
|
|
3046 }
|
|
3047
|
|
3048 syms_of_process ()
|
|
3049 {
|
|
3050 defsubr (&Sget_buffer_process);
|
|
3051 }
|
|
3052
|
|
3053
|
|
3054 #endif /* not subprocesses */
|