![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to process.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src|
Return to process.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src |
1.1 root 1: #define BSD 44
2: /* Asynchronous subprocess control for GNU Emacs.
3: Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
4:
5: This file is part of GNU Emacs.
6:
7: GNU Emacs is distributed in the hope that it will be useful,
8: but WITHOUT ANY WARRANTY. No author or distributor
9: accepts responsibility to anyone for the consequences of using it
10: or for whether it serves any particular purpose or works at all,
11: unless he says so in writing. Refer to the GNU Emacs General Public
12: License for full details.
13:
14: Everyone is granted permission to copy, modify and redistribute
15: GNU Emacs, but only under the conditions described in the
16: GNU Emacs General Public License. A copy of this license is
17: supposed to have been given to you along with GNU Emacs so you
18: can know your rights and responsibilities. It should be in a
19: file named COPYING. Among other things, the copyright notice
20: and this notice must be preserved on all copies. */
21:
22:
23: #include <signal.h>
24: #include "config.h"
25: #include <sys/param.h>
26:
27: #ifdef subprocesses
28: /* The entire file is within this conditional */
29:
30: #include <stdio.h>
31: #include <errno.h>
32: #include <setjmp.h>
33: #include <sys/types.h> /* some typedefs are used in sys/file.h */
34: #include <sys/file.h>
35: #include <sys/stat.h>
36:
37: #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
38: #include <sys/socket.h>
39: #include <netdb.h>
40: #include <netinet/in.h>
41: #endif /* HAVE_SOCKETS */
42:
43: #if defined(BSD) || defined(STRIDE)
44: #include <sys/ioctl.h>
45: #if !defined (O_NDELAY) && defined (HAVE_PTYS)
46: #include <fcntl.h>
47: #endif /* HAVE_PTYS and no O_NDELAY */
48: #endif /* BSD or STRIDE */
49: #ifdef USG
50: #include <termio.h>
51: #include <fcntl.h>
52: #endif /* USG */
53:
54: #ifdef NEED_BSDTTY
55: #include <sys/bsdtty.h>
56: #endif
57:
58: #ifdef IRIS
59: #include <sys/sysmacros.h> /* for "minor" */
60: #include <sys/time.h>
61: #else
62: #ifdef UNIPLUS
63: #include <sys/time.h>
64:
65: #else /* not IRIS, not UNIPLUS */
66: #ifdef HAVE_TIMEVAL
67: #if defined(USG) && !defined(IBMRTAIX)
68: #include <time.h>
69: #else /* IBMRTAIX or not USG */
70: #include <sys/time.h>
71: #endif /* IBMRTAIX or not USG */
72: #endif /* HAVE_TIMEVAL */
73:
74: #endif /* not UNIPLUS */
75: #endif /* not IRIS */
76:
77: #if defined (HPUX) && defined (HAVE_PTYS)
78: #include <sys/ptyio.h>
79: #endif
80:
81: #ifdef SYSV_PTYS
82: #include <sys/tty.h>
83: #include <sys/pty.h>
84: #endif
85:
86: #undef NULL
87: /* #include "config.h" */
88: #include "lisp.h"
89: #include "window.h"
90: #include "buffer.h"
91: #include "process.h"
92: #include "termhooks.h"
93: #include "termopts.h"
94: #include "commands.h"
95:
96: /* a process object is a network connection when its childp field is neither
97: Qt nor Qnil but is instead a string (name of foreign host we
98: are connected to + name of port we are connected to) */
99:
100: #ifdef HAVE_SOCKETS
101: #define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String)
102: #else
103: #define NETCONN_P(p) 0
104: #endif /* HAVE_SOCKETS */
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: /* Define the structure that the wait system call stores.
114: On many systems, there is a structure defined for this.
115: But on vanilla-ish USG systems there is not. */
116:
117: #ifndef WAITTYPE
118: #if !defined (BSD) && !defined (UNIPLUS) && !defined (STRIDE) && !(defined (HPUX) && !defined (NOMULTIPLEJOBS))
119: #define WAITTYPE int
120: #define WIFSTOPPED(w) ((w&0377) == 0177)
121: #define WIFSIGNALED(w) ((w&0377) != 0177 && (w&~0377) == 0)
122: #define WIFEXITED(w) ((w&0377) == 0)
123: #define WRETCODE(w) (w >> 8)
124: #define WSTOPSIG(w) (w >> 8)
125: #define WCOREDUMP(w) ((w&0200) != 0)
126: #define WTERMSIG(w) (w & 0377)
127: #else
128: #ifdef BSD4_1
129: #include <wait.h>
130: #else
131: #include <sys/wait.h>
132: #endif /* not BSD 4.1 */
133: #if !defined(BSD4_4)
134: #define WAITTYPE union wait
135: #define WRETCODE(w) w.w_retcode
136: #define WCOREDUMP(w) w.w_coredump
137: #ifndef WTERMSIG
138: #define WTERMSIG(w) w.w_termsig
139: #endif
140: #ifndef WSTOPSIG
141: #define WSTOPSIG(w) w.w_stopsig
142: #endif
143: #else
144: #define WAITTYPE int
145: #define WRETCODE WEXITSTATUS
146: #endif
147: #endif /* BSD or UNIPLUS or STRIDE */
148: #endif /* no WAITTYPE */
149:
150: extern errno;
151: extern sys_nerr;
152: extern char *sys_errlist[];
153:
154: #ifndef BSD4_1
155: extern char *sys_siglist[];
156: #else
157: char *sys_siglist[] =
158: {
159: "bum signal!!",
160: "hangup",
161: "interrupt",
162: "quit",
163: "illegal instruction",
164: "trace trap",
165: "iot instruction",
166: "emt instruction",
167: "floating point exception",
168: "kill",
169: "bus error",
170: "segmentation violation",
171: "bad argument to system call",
172: "write on a pipe with no one to read it",
173: "alarm clock",
174: "software termination signal from kill",
175: "status signal",
176: "sendable stop signal not from tty",
177: "stop signal from tty",
178: "continue a stopped process",
179: "child status has changed",
180: "background read attempted from control tty",
181: "background write attempted from control tty",
182: "input record available at control tty",
183: "exceeded CPU time limit",
184: "exceeded file size limit"
185: };
186: #endif
187:
188: #ifdef vipc
189:
190: #include "vipc.h"
191: extern int comm_server;
192: extern int net_listen_address;
193: #endif /* vipc */
194:
195: /* t means use pty, nil means use a pipe,
196: maybe other values to come. */
197: Lisp_Object Vprocess_connection_type;
198:
199: #ifdef SKTPAIR
200: #ifndef HAVE_SOCKETS
201: #include <sys/socket.h>
202: #endif
203: #endif /* SKTPAIR */
204:
205: int child_changed; /* Flag when a child process has ceased
206: to be */
207: /* Mask of bits indicating the descriptors that we wait for input on */
208:
209: int input_wait_mask;
210:
211: int delete_exited_processes;
212:
213: #define MAXDESC 32
214:
215: /* Indexed by descriptor, gives the process (if any) for that descriptor */
216: Lisp_Object chan_process[MAXDESC];
217:
218: /* Alist of elements (NAME . PROCESS) */
219: Lisp_Object Vprocess_alist;
220:
221: Lisp_Object Qprocessp;
222:
223: Lisp_Object get_process ();
224:
225: /* Buffered-ahead input char from process, indexed by channel.
226: -1 means empty (no char is buffered).
227: Used on sys V where the only way to tell if there is any
228: output from the process is to read at least one char.
229: Always -1 on systems that support FIONREAD. */
230:
231: int proc_buffered_char[MAXDESC];
232:
233: #ifdef HAVE_PTYS
234:
235: /* Open an available pty, putting descriptor in *ptyv,
236: and return the file name of the pty. Return 0 if none available. */
237:
238: char ptyname[24];
239:
240: char *
241: pty (ptyv)
242: int *ptyv;
243: {
244: struct stat stb;
245: register c, i;
246:
247: #ifdef PTY_ITERATION
248: PTY_ITERATION
249: #else
250: for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
251: for (i = 0; i < 16; i++)
252: #endif
253: {
254: #ifdef PTY_NAME_SPRINTF
255: PTY_NAME_SPRINTF
256: #else
257: #ifdef HPUX
258: sprintf (ptyname, "/dev/ptym/pty%c%x", c, i);
259: #else
260: #ifdef RTU
261: sprintf (ptyname, "/dev/pty%x", i);
262: #else
263: sprintf (ptyname, "/dev/pty%c%x", c, i);
264: #endif /* not RTU */
265: #endif /* not HPUX */
266: #endif /* no PTY_NAME_SPRINTF */
267:
268: #ifndef IRIS
269: if (stat (ptyname, &stb) < 0)
270: return 0;
271: *ptyv = open (ptyname, O_RDWR | O_NDELAY, 0);
272: #else /* Unusual IRIS code */
273: *ptyv = open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
274: if (*ptyv < 0)
275: return 0;
276: if (fstat (*ptyv, &stb) < 0)
277: return 0;
278: #endif /* IRIS */
279:
280: if (*ptyv >= 0)
281: {
282: /* check to make certain that both sides are available
283: this avoids a nasty yet stupid bug in rlogins */
284: #ifdef PTY_TTY_NAME_SPRINTF
285: PTY_TTY_NAME_SPRINTF
286: #else
287: /* In version 19, make these special cases use the macro above. */
288: #ifdef HPUX
289: sprintf (ptyname, "/dev/pty/tty%c%x", c, i);
290: #else
291: #ifdef RTU
292: sprintf (ptyname, "/dev/ttyp%x", i);
293: #else
294: #ifdef IRIS
295: sprintf (ptyname, "/dev/ttyq%d", minor (stb.st_rdev));
296: #else
297: sprintf (ptyname, "/dev/tty%c%x", c, i);
298: #endif /* not IRIS */
299: #endif /* not RTU */
300: #endif /* not HPUX */
301: #endif /* no PTY_TTY_NAME_SPRINTF */
302: #ifndef UNIPLUS
303: if (access (ptyname, 6) != 0)
304: {
305: close (*ptyv);
306: #ifndef IRIS
307: continue;
308: #else
309: return (0);
310: #endif /* IRIS */
311: }
312: #endif /* not UNIPLUS */
313: /*
314: * If the following statement is included,
315: * then a 0 length record is EOT, but no other
316: * control characters can be sent down the pty
317: * (e.g., ^S/^Q, ^O, etc.). If it is not
318: * included, then sending ^D down the pty-pipe
319: * makes a pretty good EOF.
320: */
321: /* I'm told that TOICREMOTE does not mean control chars
322: "can't be sent" but rather that they don't have
323: input-editing or signaling effects.
324: That should be good, because we have other ways
325: to do those things in Emacs.
326: However, telnet mode seems not to work on 4.2.
327: So TIOCREMOTE is turned off now. */
328:
329: /* Under hp-ux, if TIOCREMOTE is turned on, some calls
330: will hang. In particular, the "timeout" feature (which
331: causes a read to return if there is no data available)
332: does this. Also it is known that telnet mode will hang
333: in such a way that Emacs must be stopped (perhaps this
334: is the same problem).
335:
336: If TIOCREMOTE is turned off, then there is a bug in
337: hp-ux which sometimes loses data. Apparently the
338: code which blocks the master process when the internal
339: buffer fills up does not work. Other than this,
340: though, everything else seems to work fine.
341:
342: Since the latter lossage is more benign, we may as well
343: lose that way. -- cph */
344: #ifdef HPUX
345: #if 0
346: #define DID_REMOTE
347: ioctl (*ptyv, TIOCREMOTE, 1);
348: /* Yes, HPUX has an incompatible interface for this.
349: Also, using it makes telnet.el fail (Emacs hangs sending text to
350: it). */
351: #endif
352: #else /* not HPUX */
353: #if 0
354: #ifdef TIOCREMOTE
355: {
356: int on = 1;
357: ioctl (*ptyv, TIOCREMOTE, &on);
358: }
359: #endif
360: #endif
361: #endif /* not HPUX */
362: /* this is said to be unecessary, and to be harmful in 4.3. */
363: /* ioctl (*ptyv, FIONBIO, &on); */
364: #ifdef FIONBIO
365: #ifdef SYSV_PTYS
366: {
367: int on = 1;
368: ioctl (*ptyv, FIONBIO, &on);
369: }
370: #endif
371: #endif
372: #ifdef IBMRTAIX
373: /* On AIX, the parent gets SIGHUP when a pty attached child dies. So, we */
374: /* ignore SIGHUP once we've started a child on a pty. Note that this may */
375: /* cause EMACS not to die when it should, i.e., when its own controlling */
376: /* tty goes away. I've complained to the AIX developers, and they may */
377: /* change this behavior, but I'm not going to hold my breath. */
378: signal (SIGHUP, SIG_IGN);
379: #endif
380: return ptyname;
381: }
382: }
383: return 0;
384: }
385:
386: #endif /* HAVE_PTYS */
387:
388: Lisp_Object
389: make_process (name)
390: Lisp_Object name;
391: {
392: register Lisp_Object val, tem, name1;
393: register struct Lisp_Process *p;
394: char suffix[10];
395: register int i;
396:
397: /* size of process structure includes the vector header,
398: so deduct for that. But struct Lisp_Vector includes the first
399: element, thus deducts too much, so add it back. */
400: val = Fmake_vector (make_number ((sizeof (struct Lisp_Process)
401: - sizeof (struct Lisp_Vector)
402: + sizeof (Lisp_Object))
403: / sizeof (Lisp_Object)),
404: Qnil);
405: XSETTYPE (val, Lisp_Process);
406:
407: p = XPROCESS (val);
408: XFASTINT (p->infd) = 0;
409: XFASTINT (p->outfd) = 0;
410: XFASTINT (p->pid) = 0;
411: XFASTINT (p->flags) = 0;
412: XFASTINT (p->reason) = 0;
413: p->mark = Fmake_marker ();
414:
415: /* If name is already in use, modify it until it is unused. */
416:
417: name1 = name;
418: for (i = 1; ; i++)
419: {
420: tem = Fget_process (name1);
421: if (NULL (tem)) break;
422: sprintf (suffix, "<%d>", i);
423: name1 = concat2 (name, build_string (suffix));
424: }
425: name = name1;
426: p->name = name;
427: Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
428: return val;
429: }
430:
431: remove_process (proc)
432: register Lisp_Object proc;
433: {
434: register Lisp_Object pair;
435:
436: pair = Frassq (proc, Vprocess_alist);
437: Vprocess_alist = Fdelq (pair, Vprocess_alist);
438: Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil);
439:
440: deactivate_process (proc);
441: }
442:
443: DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
444: "Return t if OBJECT is a process.")
445: (obj)
446: Lisp_Object obj;
447: {
448: return XTYPE (obj) == Lisp_Process ? Qt : Qnil;
449: }
450:
451: DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
452: "Return the process named NAME, or nil if there is none.")
453: (name)
454: register Lisp_Object name;
455: {
456: if (XTYPE (name) == Lisp_Process)
457: return name;
458: CHECK_STRING (name, 0);
459: return Fcdr (Fassoc (name, Vprocess_alist));
460: }
461:
462: DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
463: "Return the (or, a) process associated with BUFFER.\n\
464: BUFFER may be a buffer or the name of one.")
465: (name)
466: register Lisp_Object name;
467: {
468: register Lisp_Object buf, tail, proc;
469:
470: if (NULL (name)) return Qnil;
471: buf = Fget_buffer (name);
472: if (NULL (buf)) return Qnil;
473:
474: for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
475: {
476: proc = Fcdr (Fcar (tail));
477: if (XTYPE (proc) == Lisp_Process && EQ (XPROCESS (proc)->buffer, buf))
478: return proc;
479: }
480: return Qnil;
481: }
482:
483: /* This is how commands for the user decode process arguments */
484:
485: Lisp_Object
486: get_process (name)
487: register Lisp_Object name;
488: {
489: register Lisp_Object proc;
490: if (NULL (name))
491: proc = Fget_buffer_process (Fcurrent_buffer ());
492: else
493: {
494: proc = Fget_process (name);
495: if (NULL (proc))
496: proc = Fget_buffer_process (Fget_buffer (name));
497: }
498:
499: if (!NULL (proc))
500: return proc;
501:
502: if (NULL (name))
503: error ("Current buffer has no process");
504: else
505: error ("Process %s does not exist", XSTRING (name)->data);
506: /* NOTREACHED */
507: }
508:
509: DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
510: "Delete PROCESS: kill it and forget about it immediately.\n\
511: PROCESS may be a process or the name of one, or a buffer name.")
512: (proc)
513: register Lisp_Object proc;
514: {
515: proc = get_process (proc);
516: if (NETCONN_P (proc))
517: XFASTINT (XPROCESS (proc)->flags) = EXITED | CHANGED;
518: else if (XFASTINT (XPROCESS (proc)->infd))
519: {
520: Fkill_process (proc, Qnil);
521: /* Do this now, since remove_process will make child_sig do nothing. */
522: XFASTINT (XPROCESS (proc)->flags) = SIGNALED | CHANGED;
523: change_msgs ();
524: }
525: remove_process (proc);
526: return Qnil;
527: }
528:
529: DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
530: "Return the status of PROCESS: a symbol, one of these:\n\
531: run -- for a process that is running.\n\
532: stop -- for a process stopped but continuable.\n\
533: exit -- for a process that has exited.\n\
534: signal -- for a process that has got a fatal signal.\n\
535: open -- for a network stream connection that is open.\n\
536: closed -- for a network stream connection that is closed.\n\
537: nil -- if arg is a process name and no such process exists.")
538: /* command -- for a command channel opened to Emacs by another process.\n\
539: external -- for an i/o channel opened to Emacs by another process.\n\ */
540: (proc)
541: register Lisp_Object proc;
542: {
543: register struct Lisp_Process *p;
544: proc = Fget_process (proc);
545: if (NULL (proc))
546: return proc;
547: p = XPROCESS (proc);
548:
549: switch (XFASTINT (p->flags) & PROC_STATUS)
550: {
551: case RUNNING:
552: if (NETCONN_P (proc))
553: return intern ("open");
554: else if (!NULL (p->childp))
555: return intern ("run");
556: else if (!NULL (p->command_channel_p))
557: return intern ("command");
558: return intern ("external");
559:
560: case EXITED:
561: if (NETCONN_P (proc))
562: return intern ("closed");
563: return intern ("exit");
564:
565: case SIGNALED:
566: return intern ("signal");
567:
568: case STOPPED:
569: return intern ("stop");
570: }
571:
572: /* NOTREACHED */
573: }
574:
575: DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
576: 1, 1, 0,
577: "Return the exit status of PROCESS or the signal number that killed it.\n\
578: If PROCESS has not yet exited or died, return 0.")
579: (proc)
580: register Lisp_Object proc;
581: {
582: CHECK_PROCESS (proc, 0);
583: return XPROCESS (proc)->reason;
584: }
585:
586: DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
587: "Return the process id of PROCESS.\n\
588: This is the pid of the Unix process which PROCESS uses or talks to.\n\
589: For a network connection, this value is nil.")
590: (proc)
591: register Lisp_Object proc;
592: {
593: CHECK_PROCESS (proc, 0);
594: return XPROCESS (proc)->pid;
595: }
596:
597: DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
598: "Return the name of PROCESS, as a string.\n\
599: This is the name of the program invoked in PROCESS,\n\
600: possibly modified to make it unique among process names.")
601: (proc)
602: register Lisp_Object proc;
603: {
604: CHECK_PROCESS (proc, 0);
605: return XPROCESS (proc)->name;
606: }
607:
608: DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
609: "Return the command that was executed to start PROCESS.\n\
610: This is a list of strings, the first string being the program executed\n\
611: and the rest of the strings being the arguments given to it.\n\
612: For a non-child channel, this is nil.")
613: (proc)
614: register Lisp_Object proc;
615: {
616: CHECK_PROCESS (proc, 0);
617: return XPROCESS (proc)->command;
618: }
619:
620: DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
621: 2, 2, 0,
622: "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
623: (proc, buffer)
624: register Lisp_Object proc, buffer;
625: {
626: CHECK_PROCESS (proc, 0);
627: if (!NULL (buffer))
628: CHECK_BUFFER (buffer, 1);
629: XPROCESS (proc)->buffer = buffer;
630: return buffer;
631: }
632:
633: DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
634: 1, 1, 0,
635: "Return the buffer PROCESS is associated with.\n\
636: Output from PROCESS is inserted in this buffer\n\
637: unless PROCESS has a filter.")
638: (proc)
639: register Lisp_Object proc;
640: {
641: CHECK_PROCESS (proc, 0);
642: return XPROCESS (proc)->buffer;
643: }
644:
645: DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
646: 1, 1, 0,
647: "Return the marker for the end of the last output from PROCESS.")
648: (proc)
649: register Lisp_Object proc;
650: {
651: CHECK_PROCESS (proc, 0);
652: return XPROCESS (proc)->mark;
653: }
654:
655: DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
656: 2, 2, 0,
657: "Give PROCESS the filter function FILTER; nil means no filter.\n\
658: When a process has a filter, each time it does output\n\
659: the entire string of output is passed to the filter.\n\
660: The filter gets two arguments: the process and the string of output.\n\
661: If the process has a filter, its buffer is not used for output.")
662: (proc, filter)
663: register Lisp_Object proc, filter;
664: {
665: CHECK_PROCESS (proc, 0);
666: XPROCESS (proc)->filter = filter;
667: return filter;
668: }
669:
670: DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
671: 1, 1, 0,
672: "Returns the filter function of PROCESS; nil if none.\n\
673: See set-process-filter for more info on filter functions.")
674: (proc)
675: register Lisp_Object proc;
676: {
677: CHECK_PROCESS (proc, 0);
678: return XPROCESS (proc)->filter;
679: }
680:
681: DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
682: 2, 2, 0,
683: "Give PROCESS the sentinel SENTINEL; nil for none.\n\
684: The sentinel is called as a function when the process changes state.\n\
685: It gets two arguments: the process, and a string describing the change.")
686: (proc, sentinel)
687: register Lisp_Object proc, sentinel;
688: {
689: CHECK_PROCESS (proc, 0);
690: XPROCESS (proc)->sentinel = sentinel;
691: return sentinel;
692: }
693:
694: DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
695: 1, 1, 0,
696: "Return the sentinel of PROCESS; nil if none.\n\
697: See set-process-sentinel for more info on sentinels.")
698: (proc)
699: register Lisp_Object proc;
700: {
701: CHECK_PROCESS (proc, 0);
702: return XPROCESS (proc)->sentinel;
703: }
704:
705: DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
706: Sprocess_kill_without_query, 1, 1, 0,
707: "Say no query needed if this process is running when Emacs is exited.")
708: (proc)
709: register Lisp_Object proc;
710: {
711: CHECK_PROCESS (proc, 0);
712: XPROCESS (proc)->kill_without_query = Qt;
713: return Qt;
714: }
715:
716: Lisp_Object
717: list_processes_1 ()
718: {
719: register Lisp_Object tail, tem;
720: Lisp_Object proc, minspace, tem1;
721: register struct buffer *old = bf_cur;
722: register struct Lisp_Process *p;
723: register int state;
724: char tembuf[80];
725:
726: XFASTINT (minspace) = 1;
727:
728: SetBfp (XBUFFER (Vstandard_output));
729: Fbuffer_flush_undo (Vstandard_output);
730:
731: bf_cur->truncate_lines = Qt;
732:
733: write_string ("\
734: Proc Status Buffer Command\n\
735: ---- ------ ------ -------\n", -1);
736:
737: for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
738: {
739: proc = Fcdr (Fcar (tail));
740: p = XPROCESS (proc);
741: if (NULL (p->childp))
742: continue;
743:
744: Finsert (1, &p->name);
745: Findent_to (make_number (13), minspace);
746:
747: state = XFASTINT (p->flags) & PROC_STATUS;
748: switch (state)
749: {
750: case RUNNING:
751: if (NETCONN_P (proc))
752: write_string ("Open", -1);
753: else
754: write_string ("Run", -1);
755: break;
756:
757: case STOPPED:
758: write_string ("Stop", -1);
759: break;
760:
761: case EXITED:
762: if (NETCONN_P (proc))
763: write_string ("Closed", -1);
764: else
765: write_string ("Exit", -1);
766: if (XFASTINT (p->reason))
767: {
768: sprintf (tembuf, " %d", XFASTINT (p->reason));
769: write_string (tembuf, -1);
770: }
771: remove_process (proc);
772: break;
773:
774: case SIGNALED:
775: if (XFASTINT (p->reason) < NSIG)
776: write_string (sys_siglist [XFASTINT (p->reason)], -1);
777: else
778: write_string ("Signal", -1);
779: remove_process (proc);
780: }
781:
782: Findent_to (make_number (22), minspace);
783: if (NULL (p->buffer))
784: InsStr ("(none)");
785: else if (NULL (XBUFFER (p->buffer)->name))
786: InsStr ("(Killed)");
787: else
788: Finsert (1, &XBUFFER (p->buffer)->name);
789:
790: Findent_to (make_number (37), minspace);
791:
792: if (NETCONN_P (proc))
793: {
794: sprintf (tembuf, "(network stream connection to %s)\n",
795: XSTRING (p->childp)->data);
796: InsStr (tembuf);
797: }
798: else
799: {
800: tem = p->command;
801: while (1)
802: {
803: tem1 = Fcar (tem);
804: Finsert (1, &tem1);
805: tem = Fcdr (tem);
806: if (NULL (tem))
807: break;
808: InsStr (" ");
809: }
810: InsStr ("\n");
811: }
812: }
813:
814: SetBfp (old);
815: return Qnil;
816: }
817:
818: DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",
819: "Display a list of all processes.\n\
820: \(Any processes listed as Exited or Signaled are actually eliminated\n\
821: after the listing is made.)")
822: ()
823: {
824: internal_with_output_to_temp_buffer ("*Process List*",
825: list_processes_1, Qnil);
826: return Qnil;
827: }
828:
829: DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
830: "Return a list of all processes.")
831: ()
832: {
833: return Fmapcar (Qcdr, Vprocess_alist);
834: }
835:
836: DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
837: "Start a program in a subprocess. Return the process object for it.\n\
838: Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
839: NAME is name for process. It is modified if necessary to make it unique.\n\
840: BUFFER is the buffer or (buffer-name) to associate with the process.\n\
841: Process output goes at end of that buffer, unless you specify\n\
842: an output stream or filter function to handle the output.\n\
843: BUFFER may be also nil, meaning that this process is not associated\n\
844: with any buffer\n\
845: Third arg is program file name. It is searched for as in the shell.\n\
846: Remaining arguments are strings to give program as arguments.")
847: (nargs, args)
848: int nargs;
849: register Lisp_Object *args;
850: {
851: Lisp_Object buffer, name, program, proc, tem;
852: register unsigned char **new_argv;
853: register int i;
854:
855: name = args[0];
856: CHECK_STRING (name, 0);
857:
858: buffer = args[1];
859: program = args[2];
860:
861: CHECK_STRING (program, 2);
862:
863: new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
864:
865: for (i = 3; i < nargs; i++)
866: {
867: tem = args[i];
868: CHECK_STRING (tem, i);
869: new_argv[i - 2] = XSTRING (tem)->data;
870: }
871: new_argv[i - 2] = 0;
872: new_argv[0] = XSTRING (program)->data;
873:
874: /* If program file name is not absolute, search our path for it */
875: if (new_argv[0][0] != '/')
876: {
877: tem = Qnil;
878: openp (Vexec_path, program, "", &tem, 1);
879: if (NULL (tem))
880: report_file_error ("Searching for program", Fcons (program, Qnil));
881: new_argv[0] = XSTRING (tem)->data;
882: }
883:
884: if (!NULL (buffer))
885: buffer = Fget_buffer_create (buffer);
886: proc = make_process (name);
887:
888: XPROCESS (proc)->childp = Qt;
889: XPROCESS (proc)->command_channel_p = Qnil;
890: XPROCESS (proc)->buffer = buffer;
891: XPROCESS (proc)->sentinel = Qnil;
892: XPROCESS (proc)->filter = Qnil;
893: XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
894:
895: create_process (proc, new_argv);
896:
897: return proc;
898: }
899:
900: create_process_1 (signo)
901: int signo;
902: {
903: #ifdef USG
904: /* USG systems forget handlers when they are used;
905: must reestablish each time */
906: signal (signo, create_process_1);
907: #endif /* USG */
908: }
909:
910: create_process (process, new_argv)
911: Lisp_Object process;
912: char **new_argv;
913: {
914: int pid, inchannel, outchannel, forkin, forkout;
915: int sv[2];
916: #ifdef SIGCHLD
917: int (*sigchld)();
918: #endif
919: register char *ptyname = 0;
920: char **env;
921: extern char **environ;
922:
923: #ifdef MAINTAIN_ENVIRONMENT
924: env = (char **) alloca (size_of_current_environ ());
925: get_current_environ (env);
926: #else
927: env = environ;
928: #endif /* MAINTAIN_ENVIRONMENT */
929:
930: #ifdef HAVE_PTYS
931: if (EQ (Vprocess_connection_type, Qt))
932: ptyname = pty (&inchannel);
933:
934: outchannel = inchannel;
935: if (ptyname)
936: {
937: #ifndef USG
938: /* On USG systems it does not work to open
939: the pty's tty here and then close and reopen it in the child. */
940: forkout = forkin = open (ptyname, O_RDWR, 0);
941: if (forkin < 0)
942: report_file_error ("Opening pty", Qnil);
943: #else
944: forkin = forkout = -1;
945: #endif
946: }
947: else
948: #endif /* HAVE_PTYS */
949: #ifdef SKTPAIR
950: {
951: if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0)
952: report_file_error ("Opening socketpair", Qnil);
953: outchannel = inchannel = sv[0];
954: forkout = forkin = sv[1];
955: }
956: #else /* not SKTPAIR */
957: {
958: pipe (sv);
959: inchannel = sv[0];
960: forkout = sv[1];
961: pipe (sv);
962: outchannel = sv[1];
963: forkin = sv[0];
964: }
965: #endif /* not SKTPAIR */
966:
967: #if 0
968: /* Replaced by close_process_descs */
969: set_exclusive_use (inchannel);
970: set_exclusive_use (outchannel);
971: #endif
972:
973: /* Stride people say it's a mystery why this is needed
974: as well as the O_NDELAY, but that it fails without this. */
975: #ifdef STRIDE
976: {
977: int one = 1;
978: ioctl (inchannel, FIONBIO, &one);
979: }
980: #endif
981:
982: #ifdef O_NDELAY
983: fcntl (inchannel, F_SETFL, O_NDELAY);
984: #endif
985:
986: /* Record this as an active process, with its channels.
987: As a result, child_setup will close Emacs's side of the pipes. */
988: chan_process[inchannel] = process;
989: XFASTINT (XPROCESS (process)->infd) = inchannel;
990: XFASTINT (XPROCESS (process)->outfd) = outchannel;
991: XFASTINT (XPROCESS (process)->flags) = RUNNING;
992:
993: /* Delay interrupts until we have a chance to store
994: the new fork's pid in its process structure */
995: #ifdef SIGCHLD
996: #ifdef BSD4_1
997: sighold (SIGCHLD);
998: #else /* not BSD4_1 */
999: #ifdef HPUX
1000: sigsetmask (1 << (SIGCHLD - 1));
1001: #endif /* HPUX */
1002: #if defined (BSD) || defined (UNIPLUS)
1003: sigsetmask (1 << (SIGCHLD - 1));
1004: #else /* ordinary USG */
1005: sigchld = (int (*)()) signal (SIGCHLD, SIG_DFL);
1006: #endif /* ordinary USG */
1007: #endif /* not BSD4_1 */
1008: #endif /* SIGCHLD */
1009:
1010: {
1011: /* child_setup must clobber environ on systems with true vfork.
1012: Protect it from permanent change. */
1013: char **save_environ = environ;
1014:
1015: pid = vfork ();
1016: if (pid == 0)
1017: {
1018: int xforkin = forkin;
1019: int xforkout = forkout;
1020:
1021: /* Make the pty be the controlling terminal of the process. */
1022: #ifdef HAVE_PTYS
1023: /* First, disconnect its current controlling terminal. */
1024: #ifdef USG
1025: /* It's very important to call setpgrp() here and no time
1026: afterwards. Otherwise, we lose our controlling tty which
1027: is set when we open the pty. */
1028: setpgrp ();
1029: #endif /* USG */
1030: #if defined(TIOCNOTTY) || BSD > 43
1031: /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1032: can do TIOCSPGRP only to the process's controlling tty. */
1033: if (ptyname)
1034: #if BSD <= 43
1035: {
1036: /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1037: I can't test it since I don't have 4.3. */
1038: int j = open ("/dev/tty", O_RDWR, 0);
1039: ioctl (j, TIOCNOTTY, 0);
1040: close (j);
1041: }
1042: #endif /* BSD <= 43 */
1043: #endif /* TIOCNOTTY or BSD > 43 */
1044:
1045: #if !defined (RTU) && !defined (UNIPLUS)
1046: /*** There is a suggestion that this ought to be a
1047: conditional on TIOCSPGRP. */
1048: /* Now close the pty (if we had it open) and reopen it.
1049: This makes the pty the controlling terminal of the subprocess. */
1050: if (ptyname)
1051: {
1052: /* I wonder if close (open (ptyname, ...)) would work? */
1053: if (xforkin >= 0)
1054: close (xforkin);
1055: xforkout = xforkin = open (ptyname, O_RDWR, 0);
1056:
1057: if (xforkin < 0)
1058: abort ();
1059: #if BSD > 43
1060: setsid ();
1061: ioctl (xforkout, TIOCSCTTY, 0);
1062: #endif
1063: }
1064: #endif /* not UNIPLUS and not RTU */
1065: #ifdef IBMRTAIX
1066: /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1067: Now reenable it in the child, so it will die when we want it to. */
1068: if (ptyname)
1069: signal (SIGHUP, SIG_DFL);
1070: #endif
1071: #endif /* HAVE_PTYS */
1072: child_setup_tty (xforkout);
1073: child_setup (xforkin, xforkout, xforkout, new_argv, env);
1074: }
1075: environ = save_environ;
1076: }
1077:
1078: input_wait_mask |= ChannelMask (inchannel);
1079:
1080: /* If the subfork execv fails, and it exits,
1081: this close hangs. I don't know why.
1082: So have an interrupt jar it loose. */
1083: signal (SIGALRM, create_process_1);
1084: alarm (1);
1085: if (forkin >= 0)
1086: close (forkin);
1087: alarm (0);
1088: if (forkin != forkout && forkout >= 0)
1089: close (forkout);
1090:
1091: if (pid < 0)
1092: {
1093: remove_process (process);
1094: report_file_error ("Doing vfork", Qnil);
1095: }
1096:
1097: XFASTINT (XPROCESS (process)->pid) = pid;
1098:
1099: #ifdef SIGCHLD
1100: #ifdef BSD4_1
1101: sigrelse (SIGCHLD);
1102: #else /* not BSD4_1 */
1103: #ifdef HPUX
1104: sigsetmask (0);
1105: #endif /* HPUX */
1106: #if defined (BSD) || defined (UNIPLUS)
1107: sigsetmask (0);
1108: #else /* ordinary USG */
1109: signal (SIGCHLD, sigchld);
1110: #endif /* ordinary USG */
1111: #endif /* not BSD4_1 */
1112: #endif /* SIGCHLD */
1113: }
1114:
1115: #ifdef HAVE_SOCKETS
1116:
1117: #ifdef HAVE_UNIX_DOMAIN
1118: #include <sys/un.h>
1119: #endif HAVE_UNIX_DOMAIN
1120:
1121: DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,
1122: 4, 4, 0,
1123: #ifdef HAVE_UNIX_DOMAIN
1124: "Open a TCP connection for a service to a host.\n\
1125: Returns a subprocess-object to represent the connection.\n\
1126: Input and output work as for subprocesses; `delete-process' closes it.\n\
1127: Args are NAME BUFFER HOST SERVICE.\n\
1128: If SERVICE is 0, then HOST is taken to be the name of a socket file, and a\n\
1129: Unix domain socket is opened.\n\
1130: NAME is name for process. It is modified if necessary to make it unique.\n\
1131: BUFFER is the buffer (or buffer-name) to associate with the process.\n\
1132: Process output goes at end of that buffer, unless you specify\n\
1133: an output stream or filter function to handle the output.\n\
1134: BUFFER may be also nil, meaning that this process is not associated\n\
1135: with any buffer\n\
1136: Third arg is name of the host to connect to.\n\
1137: Fourth arg SERVICE is name of the service desired, or an integer\n\
1138: specifying a port number to connect to."
1139: #else
1140: "Open a TCP connection for a service to a host.\n\
1141: Returns a subprocess-object to represent the connection.\n\
1142: Input and output work as for subprocesses; `delete-process' closes it.\n\
1143: Args are NAME BUFFER HOST SERVICE.\n\
1144: NAME is name for process. It is modified if necessary to make it unique.\n\
1145: BUFFER is the buffer (or buffer-name) to associate with the process.\n\
1146: Process output goes at end of that buffer, unless you specify\n\
1147: an output stream or filter function to handle the output.\n\
1148: BUFFER may be also nil, meaning that this process is not associated\n\
1149: with any buffer\n\
1150: Third arg is name of the host to connect to.\n\
1151: Fourth arg SERVICE is name of the service desired, or an integer\n\
1152: specifying a port number to connect to."
1153: #endif HAVE_UNIX_DOMAIN
1154: )
1155: (name, buffer, host, service)
1156: Lisp_Object name, buffer, host, service;
1157: {
1158: Lisp_Object proc;
1159: register int i;
1160: struct sockaddr_in address;
1161: #ifdef HAVE_UNIX_DOMAIN
1162: struct sockaddr_un server;
1163: int unix_domain = 0;
1164: #endif HAVE_UNIX_DOMAIN
1165: struct servent *svc_info;
1166: struct hostent *host_info;
1167: int s, outch, inch;
1168: char errstring[80];
1169: int port;
1170:
1171: CHECK_STRING (name, 0);
1172: CHECK_STRING (host, 0);
1173: if (XTYPE(service) == Lisp_Int)
1174: {
1175: #ifdef HAVE_UNIX_DOMAIN
1176: if (XINT (service) == 0)
1177: unix_domain = 1;
1178: else
1179: #endif HAVE_UNIX_DOMAIN
1180: port = htons ((unsigned short) XINT (service));
1181: }
1182: else
1183: {
1184: CHECK_STRING (service, 0);
1185: svc_info = getservbyname (XSTRING (service)->data, "tcp");
1186: if (svc_info == 0)
1187: error ("Unknown service \"%s\"", XSTRING (service)->data);
1188: port = svc_info->s_port;
1189: }
1190:
1191: #ifdef HAVE_UNIX_DOMAIN
1192: if (unix_domain)
1193: {
1194: server.sun_family = AF_UNIX;
1195: strcpy (server.sun_path, XSTRING (host)->data);
1196: }
1197: else
1198: #endif HAVE_UNIX_DOMAIN
1199: {
1200: host_info = gethostbyname (XSTRING (host)->data);
1201: if (host_info == 0)
1202: error ("Unknown host \"%s\"", XSTRING(host)->data);
1203:
1204: bzero (&address, sizeof address);
1205: bcopy (host_info->h_addr, (char *) &address.sin_addr, host_info->h_length);
1206: address.sin_family = host_info->h_addrtype;
1207: address.sin_port = port;
1208: }
1209:
1210: #ifdef HAVE_UNIX_DOMAIN
1211: if (unix_domain)
1212: s = socket (AF_UNIX, SOCK_STREAM, 0);
1213: else
1214: #endif HAVE_UNIX_DOMAIN
1215: s = socket (host_info->h_addrtype, SOCK_STREAM, 0);
1216:
1217: if (s < 0)
1218: report_file_error ("error creating socket", Fcons (name, Qnil));
1219:
1220: #ifdef HAVE_UNIX_DOMAIN
1221: if (unix_domain)
1222: {
1223: if (connect (s, &server, strlen (server.sun_path) + 2) < 0)
1224: error ("connect failed for socket: \"%s\"", XSTRING (host)->data);
1225: }
1226: else
1227: #endif HAVE_UNIX_DOMAIN
1228: {
1229: if (connect (s, &address, sizeof address) == -1)
1230: error ("Host \"%s\" not responding", XSTRING (host)->data);
1231: }
1232:
1233: inch = s;
1234: outch = dup (s);
1235: if (outch < 0)
1236: report_file_error ("error duplicating socket", Fcons (name, Qnil));
1237:
1238: if (!NULL (buffer))
1239: buffer = Fget_buffer_create (buffer);
1240: proc = make_process (name);
1241:
1242: chan_process[inch] = proc;
1243:
1244: #ifdef O_NDELAY
1245: fcntl (inch, F_SETFL, O_NDELAY);
1246: #endif
1247:
1248: XPROCESS (proc)->childp = host;
1249: XPROCESS (proc)->command_channel_p = Qnil;
1250: XPROCESS (proc)->buffer = buffer;
1251: XPROCESS (proc)->sentinel = Qnil;
1252: XPROCESS (proc)->filter = Qnil;
1253: XPROCESS (proc)->command = Qnil;
1254: XPROCESS (proc)->pid = Qnil;
1255: XPROCESS (proc)->kill_without_query = Qt;
1256: XFASTINT (XPROCESS (proc)->infd) = s;
1257: XFASTINT (XPROCESS (proc)->outfd) = outch;
1258: XFASTINT (XPROCESS (proc)->flags) = RUNNING;
1259: input_wait_mask |= ChannelMask (inch);
1260: return proc;
1261: }
1262: #endif /* HAVE_SOCKETS */
1263:
1264: deactivate_process (proc)
1265: Lisp_Object proc;
1266: {
1267: register int inchannel, outchannel;
1268: register struct Lisp_Process *p = XPROCESS (proc);
1269:
1270: inchannel = XFASTINT (p->infd);
1271: outchannel = XFASTINT (p->outfd);
1272:
1273: if (inchannel)
1274: {
1275: /* Beware SIGCHLD hereabouts. */
1276: flush_pending_output (inchannel);
1277: close (inchannel);
1278: if (outchannel && outchannel != inchannel)
1279: close (outchannel);
1280:
1281: XFASTINT (p->infd) = 0;
1282: XFASTINT (p->outfd) = 0;
1283: chan_process[inchannel] = Qnil;
1284: input_wait_mask &= ~ChannelMask (inchannel);
1285: }
1286: }
1287:
1288: /* Close all descriptors currently in use for communication
1289: with subprocess. This is used in a newly-forked subprocess
1290: to get rid of irrelevant descriptors. */
1291:
1292: close_process_descs ()
1293: {
1294: int i;
1295: for (i = 0; i < MAXDESC; i++)
1296: {
1297: Lisp_Object process;
1298: process = chan_process[i];
1299: if (!NULL (process))
1300: {
1301: int in = XFASTINT (XPROCESS (process)->infd);
1302: int out = XFASTINT (XPROCESS (process)->outfd);
1303: close (in);
1304: if (in != out)
1305: close (out);
1306: }
1307: }
1308: }
1309:
1310: DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
1311: 0, 2, 0,
1312: "Allow any pending output from subprocesses to be read by Emacs.\n\
1313: It is read into the process' buffers or given to their filter functions.\n\
1314: Non-nil arg PROCESS means do not return until some output has been received\n\
1315: from PROCESS. Non-nil arg TIMEOUT means wait for that many seconds, -1\n\
1316: return immediately.")
1317: (proc, timeout)
1318: register Lisp_Object proc, timeout;
1319: {
1320: if (NULL (proc)) {
1321: if (XTYPE(timeout) == Lisp_Int)
1322: timeout = XINT(timeout);
1323: else
1324: timeout = -1;
1325: wait_reading_process_input (timeout, 0, 0);
1326: }
1327: else
1328: {
1329: if (XTYPE(timeout) == Lisp_Int)
1330: timeout = XINT(timeout);
1331: else
1332: timeout = 0;
1333: proc = get_process (proc);
1334: wait_reading_process_input (timeout, XPROCESS (proc), 0);
1335: }
1336: return Qnil;
1337: }
1338:
1339: /* This variable is different from waiting_for_input in keyboard.c.
1340: It is used to communicate to a lisp process-filter/sentinel (via the
1341: function Fwaiting_for_user_input_p below) whether emacs was waiting
1342: for user-input when that process-filter was called.
1343: waiting_for_input cannot be used as that is by definition 0 when
1344: lisp code is being evalled */
1345: static int waiting_for_user_input_p;
1346:
1347: /* Read and dispose of subprocess output
1348: while waiting for timeout to elapse and/or keyboard input to be available.
1349:
1350: time_limit is the timeout in seconds, or zero for no limit.
1351: -1 means gobble data available immediately but don't wait for any.
1352:
1353: read_kbd is 1 to return when input is available.
1354: -1 means caller will actually read the input.
1355: A pointer to a struct Lisp_Process means wait until
1356: something arrives from that process.
1357:
1358: do_display means redisplay should be done to show
1359: subprocess output that arrives. */
1360:
1361: wait_reading_process_input (time_limit, read_kbd, do_display)
1362: int time_limit, read_kbd, do_display;
1363: {
1364: register int channel, nfds, m;
1365: int Available = 0;
1366: int Exception;
1367: int xerrno;
1368: Lisp_Object proc;
1369: #ifdef HAVE_TIMEVAL
1370: struct timeval timeout, end_time, garbage;
1371: #else
1372: long timeout, end_time, temp;
1373: #endif /* not HAVE_TIMEVAL */
1374: int Atemp;
1375: int wait_channel = 0;
1376: struct Lisp_Process *wait_proc = 0;
1377: extern kbd_count;
1378:
1379: /* Detect when read_kbd is really the address of a Lisp_Process. */
1380: if (read_kbd > 10 || read_kbd < -1)
1381: {
1382: wait_proc = (struct Lisp_Process *) read_kbd;
1383: wait_channel = XFASTINT (wait_proc->infd);
1384: read_kbd = 0;
1385: }
1386: waiting_for_user_input_p = read_kbd;
1387:
1388: /* Since we may need to wait several times,
1389: compute the absolute time to return at. */
1390: if (time_limit)
1391: {
1392: #ifdef HAVE_TIMEVAL
1393: gettimeofday (&end_time, &garbage);
1394: end_time.tv_sec += time_limit;
1395: #else /* not HAVE_TIMEVAL */
1396: time (&end_time);
1397: end_time += time_limit;
1398: #endif /* not HAVE_TIMEVAL */
1399: }
1400:
1401: while (1)
1402: {
1403: /* If calling from keyboard input, do not quit
1404: since we want to return C-g as an input character.
1405: Otherwise, do pending quit if requested. */
1406: if (read_kbd >= 0)
1407: QUIT;
1408:
1409: /* If status of something has changed, and no input is available,
1410: notify the user of the change right away */
1411: if (child_changed && do_display)
1412: {
1413: Atemp = input_wait_mask;
1414: #ifdef HAVE_TIMEVAL
1415: timeout.tv_sec=0; timeout.tv_usec=0;
1416: #else /* not HAVE_TIMEVAL */
1417: timeout = 0;
1418: #endif /* not HAVE_TIMEVAL */
1419: if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0)
1420: change_msgs();
1421: }
1422:
1423: /* Don't wait for output from a non-running process. */
1424: if (wait_proc != 0
1425: && (XFASTINT (wait_proc->flags) & PROC_STATUS) != RUNNING)
1426: break;
1427:
1428: if (fix_screen_hook)
1429: (*fix_screen_hook) ();
1430:
1431: /* Compute time from now till when time limit is up */
1432: /* Exit if already run out */
1433: if (time_limit == -1)
1434: {
1435: /* -1 specified for timeout means
1436: gobble output available now
1437: but don't wait at all. */
1438: #ifdef HAVE_TIMEVAL
1439: timeout.tv_sec = 0;
1440: timeout.tv_usec = 0;
1441: #else
1442: timeout = 0;
1443: #endif /* not HAVE_TIMEVAL */
1444: }
1445: else if (time_limit)
1446: {
1447: #ifdef HAVE_TIMEVAL
1448: gettimeofday (&timeout, &garbage);
1449: timeout.tv_sec = end_time.tv_sec - timeout.tv_sec;
1450: timeout.tv_usec = end_time.tv_usec - timeout.tv_usec;
1451: if (timeout.tv_usec < 0)
1452: timeout.tv_usec += 1000000,
1453: timeout.tv_sec--;
1454: if (timeout.tv_sec < 0)
1455: break;
1456: #else /* not HAVE_TIMEVAL */
1457: time (&temp);
1458: timeout = end_time - temp;
1459: if (timeout < 0)
1460: break;
1461: #endif /* not HAVE_TIMEVAL */
1462: }
1463: else
1464: {
1465: #ifdef HAVE_TIMEVAL
1466: /* If no real timeout, loop sleeping with a big timeout
1467: so that input interrupt can wake us up by zeroing it */
1468: timeout.tv_sec = 100;
1469: timeout.tv_usec = 0;
1470: #else /* not HAVE_TIMEVAL */
1471: timeout = 100000; /* 100000 recognized by the select emulator */
1472: #endif /* not HAVE_TIMEVAL */
1473: }
1474:
1475: /* Cause C-g and alarm signals to take immediate action,
1476: and cause input available signals to zero out timeout */
1477: if (read_kbd < 0)
1478: set_waiting_for_input (&timeout);
1479:
1480: /* Wait till there is something to do */
1481:
1482: Available = Exception = input_wait_mask;
1483: if (!read_kbd)
1484: Available &= ~1;
1485:
1486: if (read_kbd && kbd_count)
1487: nfds = 0;
1488: else
1489: #ifdef IBMRTAIX
1490: nfds = select (MAXDESC, &Available, 0, 0, &timeout);
1491: #else
1492: #ifdef HPUX
1493: nfds = select (MAXDESC, &Available, 0, 0, &timeout);
1494: #else
1495: nfds = select (MAXDESC, &Available, 0, &Exception, &timeout);
1496: #endif
1497: #endif
1498: xerrno = errno;
1499:
1500: if (fix_screen_hook)
1501: (*fix_screen_hook) ();
1502:
1503: /* Make C-g and alarm signals set flags again */
1504: clear_waiting_for_input ();
1505:
1506: if (time_limit && nfds == 0) /* timeout elapsed */
1507: break;
1508: if (nfds < 0)
1509: {
1510: if (xerrno == EINTR)
1511: Available = 0;
1512: #ifdef ALLIANT
1513: /* This happens for no known reason on ALLIANT.
1514: I am guessing that this is the right response. -- RMS. */
1515: else if (xerrno == EFAULT)
1516: Available = 0;
1517: #endif
1518: else if (xerrno == EBADF)
1519: abort ();
1520: else
1521: error("select error: %s", sys_errlist[xerrno]);
1522: }
1523: #ifdef sun
1524: else if (nfds > 0 && (Available & 1) && interrupt_input)
1525: /* System sometimes fails to deliver SIGIO. */
1526: kill (getpid (), SIGIO);
1527: #endif
1528:
1529: /* Check for keyboard input */
1530: /* If there is any, return immediately
1531: to give it higher priority than subprocesses */
1532:
1533: if (read_kbd && detect_input_pending ())
1534: break;
1535:
1536: #ifdef vipc
1537: /* Check for connection from other process */
1538:
1539: if (Available & ChannelMask (comm_server))
1540: {
1541: Available &= ~(ChannelMask (comm_server));
1542: create_commchan ();
1543: }
1544: #endif vipc
1545:
1546: /* Check for data from a process or a command channel */
1547:
1548: for (channel = 3; Available && channel < MAXDESC; channel++)
1549: {
1550: m = ChannelMask (channel);
1551: if (m & Available)
1552: {
1553: Available &= ~m;
1554: /* If waiting for this channel,
1555: arrange to return as soon as no more input
1556: to be processed. No more waiting. */
1557: if (wait_channel == channel)
1558: {
1559: wait_channel = 0;
1560: time_limit = -1;
1561: }
1562: proc = chan_process[channel];
1563: if (NULL (proc))
1564: continue;
1565:
1566: #ifdef vipc
1567: /* It's a command channel */
1568: if (!NULL (XPROCESS (proc)->command_channel_p))
1569: {
1570: ProcessCommChan (channel, proc);
1571: if (NULL (XPROCESS (proc)->command_channel_p))
1572: {
1573: /* It has ceased to be a command channel! */
1574: int bytes_available;
1575: if (ioctl (channel, FIONREAD, &bytes_available) < 0)
1576: bytes_available = 0;
1577: if (bytes_available)
1578: Available |= m;
1579: }
1580: continue;
1581: }
1582: #endif vipc
1583:
1584: /* Read data from the process, starting with our
1585: buffered-ahead character if we have one. */
1586:
1587: if (read_process_output (proc, channel) > 0)
1588: {
1589: if (do_display)
1590: DoDsp (1);
1591: }
1592: else
1593: {
1594: /* Preserve status of processes already terminated. */
1595: child_changed++;
1596: deactivate_process (proc);
1597:
1598: /*
1599: * With ptys: when the parent process of a pty exits we are notified,
1600: * just as we would be with any of our other children. After the process
1601: * exits, select() will indicate that we can read the channel. When we
1602: * do this, read() returns 0. Upon receiving this, we close the channel.
1603: *
1604: * For external channels, when the peer closes the connection, select()
1605: * will indicate that we can read the channel. When we do this, read()
1606: * returns -1 with errno = ECONNRESET. Since we never get notified of
1607: * this via wait3(), we must explictly mark the process as having exited.
1608: */
1609: if ((XFASTINT (XPROCESS (proc)->flags) & PROC_STATUS)
1610: == RUNNING)
1611: {
1612: XFASTINT (XPROCESS (proc)->flags) = EXITED | CHANGED;
1613: XFASTINT (XPROCESS (proc)->reason) = 0;
1614: }
1615: }
1616: }
1617: } /* end for */
1618: } /* end while */
1619: }
1620:
1621: /* Read pending output from the process channel,
1622: starting with our buffered-ahead character if we have one.
1623: Yield number of characters read.
1624:
1625: This function reads at most 1024 characters.
1626: If you want to read all available subprocess output,
1627: you must call it repeatedly until it returns zero. */
1628:
1629: read_process_output (proc, channel)
1630: Lisp_Object proc;
1631: register int channel;
1632: {
1633: register int nchars;
1634: char chars[1024];
1635: register Lisp_Object outstream;
1636: register struct buffer *old = bf_cur;
1637: register struct Lisp_Process *p = XPROCESS (proc);
1638: register int opoint;
1639:
1640: if (proc_buffered_char[channel] < 0)
1641: nchars = read (channel, chars, sizeof chars);
1642: else
1643: {
1644: chars[0] = proc_buffered_char[channel];
1645: proc_buffered_char[channel] = -1;
1646: nchars = read (channel, chars + 1, sizeof chars - 1);
1647: if (nchars < 0)
1648: nchars = 1;
1649: else
1650: nchars = nchars + 1;
1651: }
1652:
1653: if (nchars <= 0) return 0;
1654:
1655: outstream = p->filter;
1656: if (!NULL (outstream))
1657: {
1658: call2 (outstream, proc, make_string (chars, nchars));
1659: return nchars;
1660: }
1661:
1662: /* If no filter, write into buffer if it isn't dead. */
1663: if (!NULL (p->buffer) && !NULL (XBUFFER (p->buffer)->name))
1664: {
1665: Lisp_Object tem;
1666:
1667: Fset_buffer (p->buffer);
1668: opoint = point;
1669:
1670: /* Insert new output into buffer
1671: at the current end-of-output marker,
1672: thus preserving logical ordering of input and output. */
1673: if (XMARKER (p->mark)->buffer)
1674: SetPoint (marker_position (p->mark));
1675: else
1676: SetPoint (NumCharacters + 1);
1677: if (point <= opoint)
1678: opoint += nchars;
1679:
1680: tem = bf_cur->read_only;
1681: bf_cur->read_only = Qnil;
1682: InsCStr (chars, nchars);
1683: bf_cur->read_only = tem;
1684: Fset_marker (p->mark, make_number (point), p->buffer);
1685: RedoModes++;
1686:
1687: SetPoint (opoint);
1688: SetBfp (old);
1689: }
1690: return nchars;
1691: }
1692:
1693: DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
1694: 0, 0, 0,
1695: "Returns non-NIL if emacs is waiting for input from the user.\n\
1696: This is intended for use by asynchronous process output filters and sentinels.")
1697: ()
1698: {
1699: return ((waiting_for_user_input_p) ? Qt : Qnil);
1700: }
1701:
1702: /* Sending data to subprocess */
1703:
1704: jmp_buf send_process_frame;
1705:
1706: send_process_trap ()
1707: {
1708: #ifdef BSD4_1
1709: sigrelse (SIGPIPE);
1710: sigrelse (SIGALRM);
1711: #endif /* BSD4_1 */
1712: longjmp (send_process_frame, 1);
1713: }
1714:
1715: send_process_1 (proc, buf, len)
1716: Lisp_Object proc;
1717: char *buf;
1718: int len;
1719: {
1720: /* Don't use register vars; longjmp can lose them. */
1721: int rv;
1722: unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
1723:
1724: if ((XFASTINT (XPROCESS (proc)->flags) & PROC_STATUS) != RUNNING)
1725: error ("Process %s not running", procname);
1726:
1727:
1728: if (!setjmp (send_process_frame))
1729: while (len > 0)
1730: {
1731: signal (SIGPIPE, send_process_trap);
1732: rv = write (XFASTINT (XPROCESS (proc)->outfd), buf, len);
1733: signal (SIGPIPE, SIG_DFL);
1734: if (rv < 0)
1735: {
1736: #ifdef EWOULDBLOCK
1737: if (errno == EWOULDBLOCK)
1738: {
1739: /* It would be nice to accept process output here,
1740: but that is difficult. For example, it could
1741: garbage what we are sending if that is from a buffer. */
1742: immediate_quit = 1;
1743: QUIT;
1744: sleep (1);
1745: immediate_quit = 0;
1746: continue;
1747: }
1748: #endif
1749: report_file_error ("writing to process", Fcons (proc, Qnil));
1750: }
1751: buf += rv;
1752: len -= rv;
1753: }
1754: else
1755: {
1756: XFASTINT (XPROCESS (proc)->flags) = EXITED | CHANGED;
1757: deactivate_process (proc);
1758: error ("SIGPIPE raised on process %s; closed it", procname);
1759: }
1760: }
1761:
1762: /*** Is it really safe for this to get an error ? */
1763:
1764: send_process (proc, buf, count)
1765: Lisp_Object proc;
1766: char *buf;
1767: int count;
1768: {
1769: #ifdef vipc
1770: struct { int checkword, type, datalen; } header;
1771:
1772: if (!NULL (XPROCESS (proc)->command_channel_p))
1773: {
1774: checkword = UNIQUE_FROB;
1775: type = VIPC_MESG;
1776: datalen = count;
1777: send_process_1 (proc, &header, sizeof header);
1778: }
1779: #endif vipc
1780: send_process_1 (proc, buf, count);
1781: }
1782:
1783: DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
1784: 3, 3, 0,
1785: "Send current contents of region as input to PROCESS.\n\
1786: PROCESS may be a process name.\n\
1787: Called from program, takes three arguments, PROCESS, START and END.")
1788: (process, start, end)
1789: Lisp_Object process, start, end;
1790: {
1791: Lisp_Object proc;
1792: int start1;
1793:
1794: proc = get_process (process);
1795: validate_region (&start, &end);
1796:
1797: if (XINT (start) < bf_s1 && XINT (end) >= bf_s1)
1798: move_gap (start);
1799:
1800: start1 = XINT (start);
1801: send_process (proc, &CharAt (start1), XINT (end) - XINT (start));
1802:
1803: return Qnil;
1804: }
1805:
1806: DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
1807: 2, 2, 0,
1808: "Send PROCESS the contents of STRING as input.\n\
1809: PROCESS may be a process name.")
1810: (process, string)
1811: Lisp_Object process, string;
1812: {
1813: Lisp_Object proc;
1814: CHECK_STRING (string, 1);
1815: proc = get_process (process);
1816: send_process (proc, XSTRING (string)->data, XSTRING (string)->size);
1817: return Qnil;
1818: }
1819:
1820: /* send a signal number SIGNO to PROCESS.
1821: CURRENT_GROUP means send to the process group that currently owns
1822: the terminal being used to communicate with PROCESS.
1823: This is used for various commands in shell mode.
1824: If NOMSG is zero, insert signal-announcements into process's buffers
1825: right away. */
1826:
1827: sig_process (process, signo, current_group, nomsg)
1828: Lisp_Object process;
1829: int signo;
1830: Lisp_Object current_group;
1831: int nomsg;
1832: {
1833: Lisp_Object proc;
1834: register struct Lisp_Process *p;
1835: int gid;
1836:
1837: proc = get_process (process);
1838: p = XPROCESS (proc);
1839:
1840: if (!EQ (p->childp, Qt))
1841: error ("Process %s is not a subprocess",
1842: XSTRING (p->name)->data);
1843: if (!XFASTINT (p->infd))
1844: error ("Process %s is not active",
1845: XSTRING (p->name)->data);
1846:
1847: #ifdef TIOCGPGRP /* Not sure about this! (fnf) */
1848: /* If we are using pgrps, get a pgrp number and make it negative. */
1849: if (!NULL (current_group))
1850: {
1851: ioctl (XFASTINT (p->infd), TIOCGPGRP, &gid);
1852: gid = - gid;
1853: }
1854: else
1855: gid = - XFASTINT (p->pid);
1856: #else /* not using pgrps */
1857: /* Can't select pgrps on this system, so we know that
1858: the child itself heads the pgrp. */
1859: gid = - XFASTINT (p->pid);
1860: #endif /* not using pgrps */
1861:
1862: switch (signo)
1863: {
1864: #ifdef SIGCONT
1865: case SIGCONT:
1866: XFASTINT (p->flags) = RUNNING | CHANGED;
1867: child_changed++;
1868: break;
1869: #endif
1870: case SIGINT:
1871: case SIGQUIT:
1872: case SIGKILL:
1873: flush_pending_output (XFASTINT (p->infd));
1874: break;
1875: }
1876: /* gid may be a pid, or minus a pgrp's number */
1877: #ifdef BSD
1878: /* On bsd, [man says] kill does not accept a negative number to kill a pgrp.
1879: Must do that differently. */
1880: killpg (-gid, signo);
1881: #else /* Not BSD. */
1882: kill (gid, signo);
1883: #endif /* Not BSD. */
1884:
1885: /* Put notices in buffers now, since it is safe now.
1886: Because of this, we know that a process we have just killed
1887: will never need to use its buffer again. */
1888: if (!nomsg)
1889: change_msgs ();
1890: }
1891:
1892: DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
1893: "Interrupt process PROCESS. May be process or name of one.\n\
1894: Nil or no arg means current buffer's process.\n\
1895: Second arg CURRENT-GROUP non-nil means send signal to\n\
1896: the current process-group of the process's controlling terminal\n\
1897: rather than to the process's own process group.\n\
1898: If the process is a shell, this means interrupt current subjob\n\
1899: rather than the shell.")
1900: (process, current_group)
1901: Lisp_Object process, current_group;
1902: {
1903: sig_process (process, SIGINT, current_group, 0);
1904: return process;
1905: }
1906:
1907: DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
1908: "Kill process PROCESS. May be process or name of one.\n\
1909: See function interrupt-process for more details on usage.")
1910: (process, current_group)
1911: Lisp_Object process, current_group;
1912: {
1913: sig_process (process, SIGKILL, current_group, 0);
1914: return process;
1915: }
1916:
1917: DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
1918: "Send QUIT signal to process PROCESS. May be process or name of one.\n\
1919: See function interrupt-process for more details on usage.")
1920: (process, current_group)
1921: Lisp_Object process, current_group;
1922: {
1923: sig_process (process, SIGQUIT, current_group, 0);
1924: return process;
1925: }
1926:
1927: DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
1928: "Stop process PROCESS. May be process or name of one.\n\
1929: See function interrupt-process for more details on usage.")
1930: (process, current_group)
1931: Lisp_Object process, current_group;
1932: {
1933: #ifndef SIGTSTP
1934: error ("no SIGTSTP support");
1935: #else
1936: sig_process (process, SIGTSTP, current_group, 0);
1937: #endif
1938: return process;
1939: }
1940:
1941: DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
1942: "Continue process PROCESS. May be process or name of one.\n\
1943: See function interrupt-process for more details on usage.")
1944: (process, current_group)
1945: Lisp_Object process, current_group;
1946: {
1947: #ifdef SIGCONT
1948: sig_process (process, SIGCONT, current_group, 0);
1949: #else
1950: error ("no SIGCONT support");
1951: #endif
1952: return process;
1953: }
1954:
1955: DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
1956: "Make PROCESS see end-of-file in its input.\n\
1957: Eof comes after any text already sent to it.\n\
1958: nil or no arg means current buffer's process.")
1959: (process)
1960: Lisp_Object process;
1961: {
1962: Lisp_Object proc;
1963:
1964: proc = get_process (process);
1965: /* Sending a zero-length record is supposed to mean eof
1966: when TIOCREMOTE is turned on. */
1967: #ifdef DID_REMOTE
1968: {
1969: char buf[1];
1970: write (XFASTINT (XPROCESS (proc)->outfd), buf, 0);
1971: }
1972: #else /* did not do TOICREMOTE */
1973: send_process (proc, "\004", 1);
1974: #endif /* did not do TOICREMOTE */
1975: return process;
1976: }
1977:
1978: /* Kill all processes associated with `buffer'.
1979: If `buffer' is nil, kill all processes */
1980:
1981: kill_buffer_processes (buffer)
1982: Lisp_Object buffer;
1983: {
1984: Lisp_Object tail, proc;
1985:
1986: for (tail = Vprocess_alist; XGCTYPE (tail) == Lisp_Cons;
1987: tail = XCONS (tail)->cdr)
1988: {
1989: proc = XCONS (XCONS (tail)->car)->cdr;
1990: if (XGCTYPE (proc) == Lisp_Process
1991: && (NULL (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
1992: {
1993: if (NETCONN_P (proc))
1994: deactivate_process (proc);
1995: else if (XFASTINT (XPROCESS (proc)->infd))
1996: sig_process (proc, SIGHUP, Qnil, 1);
1997: }
1998: }
1999: }
2000:
2001: count_active_processes ()
2002: {
2003: register Lisp_Object tail, proc;
2004: register int count = 0;
2005:
2006: for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
2007: {
2008: proc = Fcdr (Fcar (tail));
2009:
2010: if ((1 << (XFASTINT (XPROCESS (proc)->flags) & PROC_STATUS)
2011: & ((1 << RUNNING) | (1 << STOPPED)))
2012: && NULL (XPROCESS (proc)->kill_without_query))
2013: count++;
2014: }
2015:
2016: return count;
2017: }
2018:
2019: /* On receipt of a signal that a child status has changed,
2020: loop asking about children with changed statuses until
2021: the system says there are no more.
2022: All we do is change the flags components;
2023: we do not run sentinels or print notifications.
2024: That is saved for the next time keyboard input is done,
2025: in order to avoid timing errors. */
2026:
2027: /** WARNING: this can be called during garbage collection.
2028: Therefore, it must not be fooled by the presence of mark bits in
2029: Lisp objects. */
2030:
2031: /** USG WARNING: Although it is not obvious from the documentation
2032: in signal(2), on a USG system the SIGCLD handler MUST NOT call
2033: signal() before executing at least one wait(), otherwise the handler
2034: will be called again, resulting in an infinite loop. The relevant
2035: portion of the documentation reads "SIGCLD signals will be queued
2036: and the signal-catching function will be continually reentered until
2037: the queue is empty". Invoking signal() causes the kernel to reexamine
2038: the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
2039:
2040: child_sig (signo)
2041: int signo;
2042: {
2043: register int pid;
2044: WAITTYPE w;
2045: Lisp_Object tail, proc;
2046: register struct Lisp_Process *p;
2047: int old_errno = errno;
2048:
2049: #ifdef BSD4_1
2050: extern int synch_process_pid;
2051: extern int sigheld;
2052: sigheld |= sigbit (SIGCHLD);
2053: #endif
2054:
2055: loop:
2056:
2057: #ifdef WNOHANG
2058: #ifndef WUNTRACED
2059: #define WUNTRACED 0
2060: #endif /* no WUNTRACED */
2061: pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
2062: if (pid <= 0)
2063: {
2064: if (errno == EINTR)
2065: {
2066: errno = 0;
2067: goto loop;
2068: }
2069: /* USG systems forget handlers when they are used;
2070: must reestablish each time */
2071: #ifdef USG
2072: signal (signo, child_sig); /* WARNING - must come after wait3() */
2073: #endif
2074: #ifdef BSD4_1
2075: sigheld &= ~sigbit (SIGCHLD);
2076: sigrelse (SIGCHLD);
2077: #endif
2078: errno = old_errno;
2079: return;
2080: }
2081: #else
2082: pid = wait (&w);
2083: #endif /* no WNOHANG */
2084:
2085: #ifdef BSD4_1
2086: if (synch_process_pid == pid)
2087: synch_process_pid = 0; /* Zero it to show process has died. */
2088: #endif
2089:
2090: for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
2091: {
2092: proc = XCONS (XCONS (tail)->car)->cdr;
2093: p = XPROCESS (proc);
2094: if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
2095: break;
2096: }
2097:
2098: if (XSYMBOL (tail) == XSYMBOL (Qnil))
2099: #if defined (USG) && ! (defined (HPUX) && defined (WNOHANG))
2100: goto ignore;
2101: #else
2102: goto loop; /* We don't know who this is */
2103: #endif
2104:
2105: child_changed++;
2106: if (WIFSTOPPED (w))
2107: {
2108: XFASTINT (p->flags) = STOPPED | CHANGED;
2109: XFASTINT (p->reason) = WSTOPSIG (w);
2110: }
2111: else if (WIFEXITED (w))
2112: {
2113: XFASTINT (p->flags) = EXITED | CHANGED;
2114: if (WCOREDUMP (w))
2115: XFASTINT (p->flags) |= COREDUMPED;
2116: XFASTINT (p->reason) = WRETCODE (w);
2117: }
2118: else if (WIFSIGNALED (w))
2119: {
2120: XFASTINT (p->flags) = SIGNALED | CHANGED;
2121: if (WCOREDUMP (w))
2122: XFASTINT (p->flags) |= COREDUMPED;
2123: XFASTINT (p->reason) = WTERMSIG (w);
2124: }
2125: #if !defined (USG) || (defined (HPUX) && defined (WNOHANG))
2126: goto loop;
2127: #else
2128: ignore:
2129: #ifdef USG
2130: signal (signo, child_sig);
2131: #endif
2132: errno = old_errno;
2133: #endif /* not USG, or HPUX with WNOHANG */
2134: }
2135:
2136: /* Find all process marked as "changed"
2137: and notify the user in a suitable fashion
2138: (either run the sentinel or output a message).
2139: This is done while Emacs is waiting for keyboard input */
2140:
2141: change_msgs()
2142: {
2143: register Lisp_Object tail, proc, buffer;
2144: register struct Lisp_Process *p;
2145: char line[50];
2146:
2147: child_changed = 0;
2148:
2149: for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
2150: {
2151: proc = Fcdr (Fcar (tail));
2152: p = XPROCESS (proc);
2153:
2154: if (!(XFASTINT (p->flags) & CHANGED))
2155: continue;
2156:
2157: /* If process is still active, read any output that remains. */
2158: if (XFASTINT (p->infd))
2159: while (read_process_output (proc, XFASTINT (p->infd)) > 0);
2160:
2161: XFASTINT (p->flags) &= ~CHANGED;
2162:
2163: line[0] = 0;
2164: buffer = p->buffer;
2165:
2166: if ((XFASTINT (p->flags) & PROC_STATUS) == SIGNALED
2167: || (XFASTINT (p->flags) & PROC_STATUS) == STOPPED)
2168: {
2169: sprintf (line, "%s%s\n",
2170: XFASTINT (p->reason) < NSIG
2171: ? sys_siglist[XFASTINT (p->reason)] : "unknown",
2172: XFASTINT (p->flags) & COREDUMPED ? " (core dumped)" : "");
2173: line[0] = DOWNCASE (line[0]);
2174:
2175: if ((XFASTINT (p->flags) & PROC_STATUS) == SIGNALED)
2176: if (delete_exited_processes)
2177: remove_process (proc);
2178: else
2179: deactivate_process (proc);
2180: }
2181: else if ((XFASTINT (p->flags) & PROC_STATUS) == EXITED)
2182: {
2183: if (XFASTINT (p->reason))
2184: sprintf (line, "exited abnormally with code %d\n",
2185: XFASTINT (p->reason));
2186: else
2187: sprintf (line, "finished\n");
2188:
2189: if (delete_exited_processes)
2190: remove_process (proc);
2191: else
2192: deactivate_process (proc);
2193: }
2194:
2195: if (!NULL (p->sentinel))
2196: exec_sentinel (proc, build_string (line));
2197: else if (line[0] && !NULL (buffer))
2198: {
2199: Lisp_Object ro = XBUFFER (buffer)->read_only;
2200: struct buffer *old = bf_cur;
2201: int opoint;
2202:
2203: /* Avoid error if buffer is deleted
2204: (probably that's why the process is dead, too) */
2205: if (NULL (XBUFFER (buffer)->name))
2206: continue;
2207: Fset_buffer (buffer);
2208: opoint = point;
2209: SetPoint (NumCharacters + 1);
2210: if (point == opoint)
2211: opoint = -1;
2212: bf_cur->read_only = Qnil;
2213: InsStr ("\nProcess ");
2214: Finsert (1, &p->name);
2215: InsStr (" ");
2216: InsStr (line);
2217: bf_cur->read_only = ro;
2218: if (opoint > 0)
2219: SetPoint (opoint);
2220: SetBfp (old);
2221: }
2222: } /* end for */
2223:
2224: RedoModes++; /* in case buffers use %s in mode-line-format */
2225: DoDsp (1);
2226: }
2227:
2228: exec_sentinel (proc, reason)
2229: Lisp_Object proc, reason;
2230: {
2231: Lisp_Object sentinel;
2232: register struct Lisp_Process *p = XPROCESS (proc);
2233:
2234: sentinel = p->sentinel;
2235: if (NULL (sentinel))
2236: return;
2237:
2238: p->sentinel = Qnil;
2239: call2 (sentinel, proc, reason);
2240: p->sentinel = sentinel;
2241: }
2242:
2243: init_process ()
2244: {
2245: register int i;
2246:
2247: #ifdef SIGCHLD
2248: #ifndef CANNOT_DUMP
2249: if (! noninteractive || initialized)
2250: #endif
2251: signal (SIGCHLD, child_sig);
2252: #endif
2253:
2254: input_wait_mask = ChannelMask(0);
2255: Vprocess_alist = Qnil;
2256: for (i = 0; i < MAXDESC; i++)
2257: {
2258: chan_process[i] = Qnil;
2259: proc_buffered_char[i] = -1;
2260: }
2261: }
2262:
2263: syms_of_process ()
2264: {
2265: Qprocessp = intern ("processp");
2266: staticpro (&Qprocessp);
2267:
2268: staticpro (&Vprocess_alist);
2269:
2270: DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
2271: "*Non-nil means delete processes immediately when they exit.\n\
2272: nil means don't delete them until `list-processes' is run.");
2273:
2274: delete_exited_processes = 1;
2275:
2276: DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
2277: "Control type of device used to communicate with subprocesses.\n\
2278: Values are nil to use a pipe, t for a pty (or pipe if ptys not supported).\n\
2279: Value takes effect when `start-process' is called.");
2280: Vprocess_connection_type = Qt;
2281:
2282: defsubr (&Sprocessp);
2283: defsubr (&Sget_process);
2284: defsubr (&Sget_buffer_process);
2285: defsubr (&Sdelete_process);
2286: defsubr (&Sprocess_status);
2287: defsubr (&Sprocess_exit_status);
2288: defsubr (&Sprocess_id);
2289: defsubr (&Sprocess_name);
2290: defsubr (&Sprocess_command);
2291: defsubr (&Sset_process_buffer);
2292: defsubr (&Sprocess_buffer);
2293: defsubr (&Sprocess_mark);
2294: defsubr (&Sset_process_filter);
2295: defsubr (&Sprocess_filter);
2296: defsubr (&Sset_process_sentinel);
2297: defsubr (&Sprocess_sentinel);
2298: defsubr (&Sprocess_kill_without_query);
2299: defsubr (&Slist_processes);
2300: defsubr (&Sprocess_list);
2301: defsubr (&Sstart_process);
2302: #ifdef HAVE_SOCKETS
2303: defsubr (&Sopen_network_stream);
2304: #endif /* HAVE_SOCKETS */
2305: defsubr (&Saccept_process_output);
2306: defsubr (&Sprocess_send_region);
2307: defsubr (&Sprocess_send_string);
2308: defsubr (&Sinterrupt_process);
2309: defsubr (&Skill_process);
2310: defsubr (&Squit_process);
2311: defsubr (&Sstop_process);
2312: defsubr (&Scontinue_process);
2313: defsubr (&Sprocess_send_eof);
2314: defsubr (&Swaiting_for_user_input_p);
2315: }
2316:
2317: #endif subprocesses
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.