![[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] / 43BSD / contrib / emacs / src|
Return to process.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src |
1.1 root 1: /* Asynchronous subprocess control for GNU Emacs.
2: Copyright (C) 1985 Richard M. Stallman.
3:
4: This file is part of GNU Emacs.
5:
6: GNU Emacs is distributed in the hope that it will be useful,
7: but WITHOUT ANY WARRANTY. No author or distributor
8: accepts responsibility to anyone for the consequences of using it
9: or for whether it serves any particular purpose or works at all,
10: unless he says so in writing. Refer to the GNU Emacs General Public
11: License for full details.
12:
13: Everyone is granted permission to copy, modify and redistribute
14: GNU Emacs, but only under the conditions described in the
15: GNU Emacs General Public License. A copy of this license is
16: supposed to have been given to you along with GNU Emacs so you
17: can know your rights and responsibilities. It should be in a
18: file named COPYING. Among other things, the copyright notice
19: and this notice must be preserved on all copies. */
20:
21:
22: #include <signal.h>
23:
24: #include "config.h"
25:
26: #ifdef subprocesses
27: /* The entire file is within this conditional */
28:
29: #include <stdio.h>
30: #include <errno.h>
31: #include <setjmp.h>
32: #include <sys/types.h> /* some typedefs are used in sys/file.h */
33: #include <sys/file.h>
34: #include <sys/stat.h>
35: #ifdef BSD
36: #include <sys/ioctl.h>
37: #endif /* BSD */
38: #ifdef USG
39: #include <termio.h>
40: #include <fcntl.h>
41: #endif /* USG */
42:
43: #ifdef HAVE_TIMEVAL
44: #if defined (USG) && !defined (UNIPLUS)
45: #include <time.h>
46: #else
47: #include <sys/time.h>
48: #endif
49: #endif /* HAVE_TIMEVAL */
50:
51: #if defined (HPUX) && defined (HAVE_PTYS)
52: #include <sys/ptyio.h>
53: #endif
54:
55: #undef NULL
56: #include "lisp.h"
57: #include "window.h"
58: #include "buffer.h"
59: #include "process.h"
60: #include "termhooks.h"
61:
62: /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
63: testing SIGCHLD. */
64:
65: #if !defined (SIGCHLD) && defined (SIGCLD)
66: #define SIGCHLD SIGCLD
67: #endif /* SIGCLD */
68:
69: /* Define the structure that the wait system call stores.
70: On many systems, there is a structure defined for this.
71: But on vanilla-ish USG systems there is not. */
72:
73: #if !defined (BSD) && !defined (UNIPLUS) && !defined (STRIDE)
74: #define WAITTYPE int
75: #define WIFSTOPPED(w) ((w&0377) == 0177)
76: #define WIFSIGNALED(w) ((w&0377) != 0177 && (w&~0377) == 0)
77: #define WIFEXITED(w) ((w&0377) == 0)
78: #define WRETCODE(w) (w >> 8)
79: #define WSTOPSIG(w) (w >> 8)
80: #define WCOREDUMP(w) ((w&0200) != 0)
81: #define WTERMSIG(w) (w & 0377)
82: #else
83: #ifdef BSD4_1
84: #include <wait.h>
85: #else
86: #include <sys/wait.h>
87: #endif /* not BSD 4.1 */
88: #define WAITTYPE union wait
89: #define WRETCODE(w) w.w_retcode
90: #define WSTOPSIG(w) w.w_stopsig
91: #define WCOREDUMP(w) w.w_coredump
92: #define WTERMSIG(w) w.w_termsig
93: #endif
94:
95: extern errno;
96: extern sys_nerr;
97: extern char *sys_errlist[];
98:
99: #ifndef BSD4_1
100: extern char *sys_siglist[];
101: #else
102: char *sys_siglist[] =
103: {
104: "bum signal!!",
105: "hangup",
106: "interrupt",
107: "quit",
108: "illegal instruction",
109: "trace trap",
110: "iot instruction",
111: "emt instruction",
112: "floating point exception",
113: "kill",
114: "bus error",
115: "segmentation violation",
116: "bad argument to system call",
117: "write on a pipe with no one to read it",
118: "alarm clock",
119: "software termination signal from kill",
120: "status signal",
121: "sendable stop signal not from tty",
122: "stop signal from tty",
123: "continue a stopped process",
124: "child status has changed",
125: "background read attempted from control tty",
126: "background write attempted from control tty",
127: "input record available at control tty",
128: "exceeded CPU time limit",
129: "exceeded file size limit"
130: };
131: #endif
132:
133: #ifdef vipc
134:
135: #include "vipc.h"
136: extern int comm_server;
137: extern int net_listen_address;
138: #endif vipc
139:
140:
141: #ifdef SKTPAIR
142: #include <sys/socket.h>
143: #endif /* SKTPAIR */
144:
145: int child_changed; /* Flag when a child process has ceased
146: to be */
147:
148: /* Mask of bits indicating the descriptors that we wait for input on */
149:
150: int input_wait_mask;
151:
152: int delete_exited_processes;
153:
154: #define MAXDESC 32
155:
156: /* Indexed by descriptor, gives the process (if any) for that descriptor */
157: Lisp_Object chan_process[MAXDESC];
158:
159: /* Alist of elements (NAME . PROCESS) */
160: Lisp_Object Vprocess_alist;
161:
162: Lisp_Object Qprocessp;
163:
164: Lisp_Object get_process ();
165:
166: /* Buffered-ahead input char from process, indexed by channel.
167: -1 means empty (no char is buffered).
168: Used on sys V where the only way to tell if there is any
169: output from the process is to read at least one char.
170: Always -1 on systems that support FIONREAD. */
171:
172: int proc_buffered_char[MAXDESC];
173:
174: #ifdef HAVE_PTYS
175:
176: /* Open an available pty, putting descriptor in *ptyv,
177: and return the file name of the pty. Return 0 if none available. */
178:
179: char ptyname[24];
180:
181: char *
182: pty (ptyv)
183: int *ptyv;
184: {
185: struct stat stb;
186: register c, i;
187:
188: for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
189: for (i = 0; i < 16; i++)
190: {
191: #ifdef HPUX
192: sprintf (ptyname, "/dev/ptym/pty%c%x", c, i);
193: #else
194: sprintf (ptyname, "/dev/pty%c%x", c, i);
195: #endif /* not HPUX */
196: if (stat (ptyname, &stb) < 0)
197: return 0;
198:
199: *ptyv = open (ptyname, O_RDWR | O_NDELAY, 0);
200: if (*ptyv >= 0)
201: {
202: /* check to make certain that both sides are available
203: this avoids a nasty yet stupid bug in rlogins */
204: int x;
205: #ifdef HPUX
206: sprintf (ptyname, "/dev/pty/tty%c%x", c, i);
207: #else
208: sprintf (ptyname, "/dev/tty%c%x", c, i);
209: #endif /* not HPUX */
210: #ifndef UNIPLUS
211: x = open (ptyname, O_RDWR | O_NDELAY, 0);
212: if (x < 0)
213: {
214: close (*ptyv);
215: continue;
216: }
217: close(x);
218: #endif /* not UNIPLUS */
219: /*
220: * If the following statement is included,
221: * then a 0 length record is EOT, but no other
222: * control characters can be sent down the pty
223: * (e.g., ^S/^Q, ^O, etc.). If it is not
224: * included, then sending ^D down the pty-pipe
225: * makes a pretty good EOF.
226: */
227: /* ioctl( *ptyv, TIOCREMOTE, &on ); /* for EOT */
228: /* this is said to be unecessary, and to be harmful in 4.3. */
229: /* ioctl (*ptyv, FIONBIO, &on); */
230: return ptyname;
231: }
232: }
233: return 0;
234: }
235:
236: #endif /* HAVE_PTYS */
237:
238: Lisp_Object
239: make_process (name)
240: Lisp_Object name;
241: {
242: Lisp_Object val, tem, name1;
243: register struct Lisp_Process *p;
244: char suffix[10];
245: register int i;
246:
247: val = Fmake_vector (make_number ((sizeof (struct Lisp_Process)
248: - sizeof (int) - sizeof (struct Lisp_Vector *))
249: / sizeof (Lisp_Object)),
250: Qnil);
251: XSETTYPE (val, Lisp_Process);
252:
253: p = XPROCESS (val);
254: XFASTINT (p->infd) = 0;
255: XFASTINT (p->outfd) = 0;
256: XFASTINT (p->pid) = 0;
257: XFASTINT (p->flags) = 0;
258: XFASTINT (p->reason) = 0;
259: p->mark = Fmake_marker ();
260:
261: /* If name is already in use, modify it until it is unused. */
262:
263: name1 = name;
264: for (i = 1; ; i++)
265: {
266: tem = Fget_process (name1);
267: if (NULL (tem)) break;
268: sprintf (suffix, "<%d>", i);
269: name1 = concat2 (name, build_string (suffix));
270: }
271: name = name1;
272: p->name = name;
273: Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
274: return val;
275: }
276:
277: remove_process (proc)
278: Lisp_Object proc;
279: {
280: Lisp_Object pair;
281:
282: pair = Frassq (proc, Vprocess_alist);
283: Vprocess_alist = Fdelq (pair, Vprocess_alist);
284: Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil);
285:
286: deactivate_process (proc);
287: }
288:
289: DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
290: "Return t if OBJECT is a process.")
291: (obj)
292: Lisp_Object obj;
293: {
294: return XTYPE (obj) == Lisp_Process ? Qt : Qnil;
295: }
296:
297: DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
298: "Return the process named NAME, or nil if there is none.")
299: (name)
300: Lisp_Object name;
301: {
302: if (XTYPE (name) == Lisp_Process)
303: return name;
304: CHECK_STRING (name, 0);
305: return Fcdr (Fassoc (name, Vprocess_alist));
306: }
307:
308: DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
309: "Return the (or, a) process associated with BUFFER.\n\
310: BUFFER may be a buffer or the name of one.")
311: (name)
312: Lisp_Object name;
313: {
314: Lisp_Object buf, tail, proc;
315:
316: if (NULL (name)) return Qnil;
317: buf = Fget_buffer (name);
318: if (NULL (buf)) return Qnil;
319:
320: for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
321: {
322: proc = Fcdr (Fcar (tail));
323: if (XTYPE (proc) == Lisp_Process && EQ (XPROCESS (proc)->buffer, buf))
324: return proc;
325: }
326: return Qnil;
327: }
328:
329: /* This is how commands for the user decode process arguments */
330:
331: Lisp_Object
332: get_process (name)
333: Lisp_Object name;
334: {
335: Lisp_Object proc;
336: if (NULL (name))
337: proc = Fget_buffer_process (Fcurrent_buffer ());
338: else
339: {
340: proc = Fget_process (name);
341: if (NULL (proc))
342: proc = Fget_buffer_process (Fget_buffer (name));
343: }
344:
345: if (!NULL (proc))
346: return proc;
347:
348: if (NULL (name))
349: error ("Current buffer has no process");
350: else
351: error ("Process %s does not exist", XSTRING (name)->data);
352: /* NOTREACHED */
353: }
354:
355: DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
356: "Delete PROCESS: kill it and forget about it immediately.\n\
357: PROCESS may be a process or the name of one, or a buffer name.")
358: (proc)
359: Lisp_Object proc;
360: {
361: proc = get_process (proc);
362: if (XFASTINT (XPROCESS (proc)->infd))
363: Fkill_process (proc, Qnil);
364: remove_process (proc);
365: return Qnil;
366: }
367:
368: DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
369: "Return the status of PROCESS: a symbol, one of these:\n\
370: run -- for a process that is running.\n\
371: stop -- for a process stopped but continuable.\n\
372: exit -- for a process that has exited.\n\
373: signal -- for a process that has got a fatal signal.\n\
374: command -- for a command channel opened to Emacs by another process.\n\
375: external -- for an i/o channel opened to Emacs by another process.\n\
376: nil -- if arg is a process name and no such process exists.")
377: (proc)
378: Lisp_Object proc;
379: {
380: register struct Lisp_Process *p;
381: proc = Fget_process (proc);
382: if (NULL (proc))
383: return proc;
384: p = XPROCESS (proc);
385:
386: switch (XFASTINT (p->flags) & PROC_STATUS)
387: {
388: case RUNNING:
389: if (!NULL (p->childp))
390: return intern ("run");
391: else if (!NULL (p->command_channel_p))
392: return intern ("command");
393: return intern ("external");
394:
395: case EXITED:
396: return intern ("exit");
397:
398: case SIGNALED:
399: return intern ("signal");
400:
401: case STOPPED:
402: return intern ("stop");
403: }
404:
405: /* NOTREACHED */
406: }
407:
408: DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
409: "Return the process id of PROCESS.\n\
410: This is the pid of the Unix process which PROCESS uses or talks to.")
411: (proc)
412: Lisp_Object proc;
413: {
414: CHECK_PROCESS (proc, 0);
415: return XPROCESS (proc)->pid;
416: }
417:
418: DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
419: "Return the name of PROCESS, as a string.\n\
420: This is the name of the program invoked in PROCESS,\n\
421: possibly modified to make it unique among process names.")
422: (proc)
423: Lisp_Object proc;
424: {
425: CHECK_PROCESS (proc, 0);
426: return XPROCESS (proc)->name;
427: }
428:
429: DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
430: "Return the command that was executed to start PROCESS.\n\
431: This is a list of strings, the first string being the program executed\n\
432: and the rest of the strings being the arguments given to it.\n\
433: For a non-child channel, this is nil.")
434: (proc)
435: Lisp_Object proc;
436: {
437: CHECK_PROCESS (proc, 0);
438: return XPROCESS (proc)->command;
439: }
440:
441: DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
442: 2, 2, 0,
443: "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
444: (proc, buffer)
445: Lisp_Object proc, buffer;
446: {
447: CHECK_PROCESS (proc, 0);
448: if (!NULL (buffer))
449: CHECK_BUFFER (buffer, 1);
450: XPROCESS (proc)->buffer = buffer;
451: return buffer;
452: }
453:
454: DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
455: 1, 1, 0,
456: "Return the buffer PROCESS is associated with.\n\
457: Output from PROCESS is inserted in this buffer\n\
458: unless PROCESS has a filter.")
459: (proc)
460: Lisp_Object proc;
461: {
462: CHECK_PROCESS (proc, 0);
463: return XPROCESS (proc)->buffer;
464: }
465:
466: DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
467: 1, 1, 0,
468: "Return the marker for the end of the last output from PROCESS.")
469: (proc)
470: Lisp_Object proc;
471: {
472: CHECK_PROCESS (proc, 0);
473: return XPROCESS (proc)->mark;
474: }
475:
476: DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
477: 2, 2, 0,
478: "Give PROCESS the filter function FILTER; nil means no filter.\n\
479: When a process has a filter, each time it does output\n\
480: the entire string of output is passed to the filter.\n\
481: The filter gets two arguments: the process and the string of output.\n\
482: If the process has a filter, its buffer is not used for output.")
483: (proc, filter)
484: Lisp_Object proc, filter;
485: {
486: CHECK_PROCESS (proc, 0);
487: XPROCESS (proc)->filter = filter;
488: return filter;
489: }
490:
491: DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
492: 1, 1, 0,
493: "Returns the filter function of PROCESS; nil if none.\n\
494: See set-process-filter for more info on filter functions.")
495: (proc)
496: Lisp_Object proc;
497: {
498: CHECK_PROCESS (proc, 0);
499: return XPROCESS (proc)->filter;
500: }
501:
502: DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
503: 2, 2, 0,
504: "Give PROCESS the sentinel SENTINEL; nil for none.\n\
505: The sentinel is called as a function when the process changes state.\n\
506: It gets two arguments: the process, and a string describing the change.")
507: (proc, sentinel)
508: Lisp_Object proc, sentinel;
509: {
510: CHECK_PROCESS (proc, 0);
511: XPROCESS (proc)->sentinel = sentinel;
512: return sentinel;
513: }
514:
515: DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
516: 1, 1, 0,
517: "Return the sentinel of PROCESS; nil if none.\n\
518: See set-process-sentinel for more info on sentinels.")
519: (proc)
520: Lisp_Object proc;
521: {
522: CHECK_PROCESS (proc, 0);
523: return XPROCESS (proc)->sentinel;
524: }
525:
526: DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
527: Sprocess_kill_without_query, 1, 1, 0,
528: "Say no query needed if this process is running when Emacs is exited.")
529: (proc)
530: Lisp_Object proc;
531: {
532: CHECK_PROCESS (proc, 0);
533: XPROCESS (proc)->kill_without_query = Qt;
534: return Qt;
535: }
536:
537: Lisp_Object
538: list_processes_1 ()
539: {
540: Lisp_Object tail, proc, minspace, tem, tem1;
541: register struct buffer *old = bf_cur;
542: register struct Lisp_Process *p;
543: register int state;
544: char tembuf[10];
545:
546: XFASTINT (minspace) = 1;
547:
548: SetBfp (XBUFFER (Vstandard_output));
549: Fbuffer_flush_undo (Vstandard_output);
550:
551: bf_cur->truncate_lines = Qt;
552:
553: write_string ("\
554: Proc Status Buffer Command\n\
555: ---- ------ ------ -------\n", -1);
556:
557: for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
558: {
559: proc = Fcdr (Fcar (tail));
560: p = XPROCESS (proc);
561: if (NULL (p->childp))
562: continue;
563:
564: Finsert (1, &p->name);
565: Findent_to (make_number (13), minspace);
566:
567: state = XFASTINT (p->flags) & PROC_STATUS;
568: switch (state)
569: {
570: case RUNNING:
571: write_string ("Run", -1);
572: break;
573:
574: case STOPPED:
575: write_string ("Stop", -1);
576: break;
577:
578: case EXITED:
579: write_string ("Exit", -1);
580: if (XFASTINT (p->reason))
581: {
582: sprintf (tembuf, " %d", XFASTINT (p->reason));
583: write_string (tembuf, -1);
584: }
585: remove_process (proc);
586: break;
587:
588: case SIGNALED:
589: if (XFASTINT (p->reason) < NSIG)
590: write_string (sys_siglist [XFASTINT (p->reason)], -1);
591: else
592: write_string ("Signal", -1);
593: remove_process (proc);
594: }
595:
596: Findent_to (make_number (22), minspace);
597: if (NULL (p->buffer))
598: InsStr ("(none)");
599: else if (NULL (XBUFFER (p->buffer)->name))
600: InsStr ("(Killed)");
601: else
602: Finsert (1, &XBUFFER (p->buffer)->name);
603:
604: Findent_to (make_number (37), minspace);
605:
606: tem = p->command;
607: while (1)
608: {
609: tem1 = Fcar (tem);
610: Finsert (1, &tem1);
611: tem = Fcdr (tem);
612: if (NULL (tem))
613: break;
614: InsStr (" ");
615: }
616:
617: InsStr ("\n");
618: }
619:
620: SetBfp (old);
621: return Qnil;
622: }
623:
624: DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",
625: "Display a list of all processes.\n\
626: \(Any processes listed as Exited or Signaled are actually eliminated\n\
627: after the listing is made.)")
628: ()
629: {
630: internal_with_output_to_temp_buffer ("*Process List*",
631: list_processes_1, Qnil);
632: return Qnil;
633: }
634:
635: DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
636: "Start a program in a subprocess. Return the process object for it.\n\
637: First arg is name for process. It is modified if nec to make it unique.\n\
638: Second arg is buffer to associate with the process (or buffer name).\n\
639: Process output goes at end of that buffer, unless you specify\n\
640: an output stream or filter function to handle the output.\n\
641: Third arg is program file name. It is searched for as in the shell.\n\
642: Remaining arguments are strings to give program as arguments.")
643: (nargs, args)
644: int nargs;
645: Lisp_Object *args;
646: {
647: Lisp_Object buffer, name, program, proc, tem;
648: register unsigned char **new_argv;
649: register int i;
650:
651: name = args[0];
652: CHECK_STRING (name, 0);
653:
654: buffer = args[1];
655: program = args[2];
656:
657: CHECK_STRING (program, 2);
658:
659: new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
660:
661: for (i = 3; i < nargs; i++)
662: {
663: tem = args[i];
664: CHECK_STRING (tem, i);
665: new_argv[i - 2] = XSTRING (tem)->data;
666: }
667: new_argv[i - 2] = 0;
668: new_argv[0] = XSTRING (program)->data;
669:
670: /* If program file name is not absolute, search our path for it */
671: if (new_argv[0][0] != '/')
672: {
673: tem = Qnil;
674: openp (Vexec_path, program, "", &tem, 1);
675: if (NULL (tem))
676: report_file_error ("Searching for program", Fcons (program, Qnil));
677: new_argv[0] = XSTRING (tem)->data;
678: }
679:
680: if (!NULL (buffer))
681: buffer = Fget_buffer_create (buffer);
682: proc = make_process (name);
683:
684: XPROCESS (proc)->childp = Qt;
685: XPROCESS (proc)->command_channel_p = Qnil;
686: XPROCESS (proc)->buffer = buffer;
687: XPROCESS (proc)->sentinel = Qnil;
688: XPROCESS (proc)->filter = Qnil;
689: XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
690:
691: create_process (proc, new_argv);
692:
693: return proc;
694: }
695:
696: create_process_1 (signo)
697: int signo;
698: {
699: #ifdef USG
700: /* USG systems forget handlers when they are used;
701: must reestablish each time */
702: signal (signo, create_process_1);
703: #endif /* USG */
704: }
705:
706: create_process (process, new_argv)
707: Lisp_Object process;
708: char **new_argv;
709: {
710: int pid, inchannel, outchannel, forkin, forkout;
711: int sv[2];
712: int (*sigchld)();
713:
714: #ifdef HAVE_PTYS
715: char *ptyname;
716:
717: ptyname = pty (&inchannel);
718: outchannel = inchannel;
719: if (ptyname)
720: {
721: forkout = forkin = open (ptyname, O_RDWR, 0);
722: if (forkin < 0)
723: report_file_error ("Opening pty", Qnil);
724: }
725: else
726: #endif /* HAVE_PTYS */
727: #ifdef SKTPAIR
728: {
729: if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0)
730: report_file_error ("Opening socketpair", Qnil);
731: outchannel = inchannel = sv[0];
732: forkout = forkin = sv[1];
733: }
734: #else /* not SKTPAIR */
735: {
736: pipe (sv);
737: inchannel = sv[0];
738: forkout = sv[1];
739: pipe (sv);
740: outchannel = sv[1];
741: forkin = sv[0];
742: }
743: #endif /* not SKTPAIR */
744:
745: #ifdef FIOCLEX
746: ioctl (inchannel, FIOCLEX, 0);
747: ioctl (outchannel, FIOCLEX, 0);
748: #endif
749:
750: /* Stride people say it's a mystery why this is needed
751: as well as the O_NDELAY, but that it fails without this. */
752: #ifdef STRIDE
753: {
754: int one = 1;
755: ioctl (inchannel, FIONBIO, &one);
756: }
757: #endif
758:
759: #ifdef O_NDELAY
760: fcntl (inchannel, F_SETFL, O_NDELAY);
761: #endif
762:
763: chan_process[inchannel] = process;
764: XFASTINT (XPROCESS (process)->infd) = inchannel;
765: XFASTINT (XPROCESS (process)->outfd) = outchannel;
766: XFASTINT (XPROCESS (process)->flags) = RUNNING;
767:
768: input_wait_mask |= ChannelMask (inchannel);
769:
770: /* Delay interrupts until we have a chance to store
771: the new fork's pid in its process structure */
772: #ifdef SIGCHLD
773: #ifdef BSD4_1
774: sighold (SIGCHLD);
775: #else /* not BSD4_1 */
776: #if defined (BSD) || defined (UNIPLUS)
777: sigsetmask (1 << (SIGCHLD - 1));
778: #else /* ordinary USG */
779: sigchld = signal (SIGCHLD, SIG_DFL);
780: #endif /* ordinary USG */
781: #endif /* not BSD4_1 */
782: #endif /* SIGCHLD */
783:
784: pid = vfork ();
785: if (pid == 0)
786: {
787: int xforkin = forkin;
788: int xforkout = forkout;
789: #ifdef HAVE_PTYS
790: #ifdef TIOCNOTTY
791: /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
792: can do TIOCSPGRP only to the process's controlling tty.
793: We must make the pty terminal the controlling tty of the child. */
794: if (ptyname)
795: {
796: /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
797: I can't test it since I don't have 4.3. */
798: int j = open ("/dev/tty", O_RDWR, 0);
799: ioctl (j, TIOCNOTTY, 0);
800: close (j);
801:
802: #ifndef UNIPLUS
803: /* I wonder if close (open (ptyname, ...)) would work? */
804: close (xforkin);
805: xforkout = xforkin = open (ptyname, O_RDWR, 0);
806:
807: if (xforkin < 0)
808: abort ();
809: #endif /* not UNIPLUS */
810: }
811: #endif /* TIOCNOTTY */
812: #endif /* HAVE_PTYS */
813: child_setup (xforkin, xforkout, xforkout, new_argv);
814: }
815:
816: /* If the subfork execv fails, and it exits,
817: this close hangs. I don't know why.
818: So have an interrupt jar it loose. */
819: signal (SIGALRM, create_process_1);
820: alarm (1);
821: close (forkin);
822: alarm (0);
823: if (forkin != forkout)
824: close (forkout);
825:
826: if (pid < 0)
827: {
828: remove_process (process);
829: report_file_error ("Doing vfork", Qnil);
830: }
831:
832: XFASTINT (XPROCESS (process)->pid) = pid;
833:
834: #ifdef SIGCHLD
835: #ifdef BSD4_1
836: sigrelse (SIGCHLD);
837: #else /* not BSD4_1 */
838: #if defined (BSD) || defined (UNIPLUS)
839: sigsetmask (0);
840: #else /* ordinary USG */
841: signal (SIGCHLD, sigchld);
842: #endif /* ordinary USG */
843: #endif /* not BSD4_1 */
844: #endif /* SIGCHLD */
845: }
846:
847: deactivate_process (proc)
848: Lisp_Object proc;
849: {
850: register int inchannel, outchannel;
851: register struct Lisp_Process *p = XPROCESS (proc);
852:
853: inchannel = XFASTINT (p->infd);
854: outchannel = XFASTINT (p->outfd);
855:
856: if (inchannel)
857: {
858: /* Beware SIGCHLD hereabouts. */
859: flush_pending_output (inchannel);
860: close (inchannel);
861: if (outchannel && outchannel != inchannel)
862: close (outchannel);
863:
864: XFASTINT (p->infd) = 0;
865: XFASTINT (p->outfd) = 0;
866: chan_process[inchannel] = Qnil;
867: input_wait_mask &= ~ChannelMask (inchannel);
868: }
869: }
870:
871: DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
872: 0, 1, 0,
873: "Allow any pending output from subprocesses to be read by Emacs.\n\
874: It is read into the processs' buffers or given to their filter functions.\n\
875: Non-nil arg PROCESS means do not return until some output has been received\n\
876: from PROCESS.")
877: (proc)
878: Lisp_Object proc;
879: {
880: if (NULL (proc))
881: wait_reading_process_input (-1, 0, 0);
882: else
883: {
884: proc = get_process (proc);
885: wait_reading_process_input (0, 10 + XFASTINT (XPROCESS (proc)->infd),
886: 0);
887: }
888: return Qnil;
889: }
890:
891: /* Read and dispose of subprocess output
892: while waiting for timeout to elapse and/or keyboard input to be available.
893:
894: time_limit is the timeout in seconds, or zero for no limit.
895: -1 means gobble data available immediately but don't wait for any.
896:
897: read_kbd is 1 to return when input is available.
898: Negative means caller will actually read the input.
899: 10 + I means wait until input received from channel I.
900:
901: do_display means redisplay should be done to show
902: subprocess output that arrives. */
903:
904: wait_reading_process_input (time_limit, read_kbd, do_display)
905: int time_limit, read_kbd, do_display;
906: {
907: register int channel, nfds, m;
908: int Available = 0;
909: int Exception;
910: Lisp_Object proc;
911: #ifdef HAVE_TIMEVAL
912: struct timeval timeout, end_time, garbage;
913: #else
914: long timeout, end_time, temp;
915: #endif /* not HAVE_TIMEVAL */
916: int Atemp;
917: int wait_channel = 0;
918: extern kbd_count;
919:
920: if (read_kbd > 10)
921: {
922: wait_channel = read_kbd - 10;
923: read_kbd = 0;
924: }
925:
926: /* Since we may need to wait several times,
927: compute the absolute time to return at. */
928: if (time_limit)
929: {
930: #ifdef HAVE_TIMEVAL
931: gettimeofday (&end_time, &garbage);
932: end_time.tv_sec += time_limit;
933: #else /* not HAVE_TIMEVAL */
934: time (&end_time);
935: end_time += time_limit;
936: #endif /* not HAVE_TIMEVAL */
937: }
938:
939: while (1)
940: {
941: /* If calling from keyboard input, do not quit
942: since we want to return C-g as an input character.
943: Otherwise, do pending quit if requested. */
944: if (read_kbd >= 0)
945: QUIT;
946:
947: /* If status of something has changed, and no input is available,
948: notify the user of the change right away */
949: if (child_changed && do_display)
950: {
951: Atemp = input_wait_mask;
952: #ifdef HAVE_TIMEVAL
953: timeout.tv_sec=0; timeout.tv_usec=0;
954: #else /* not HAVE_TIMEVAL */
955: timeout = 0;
956: #endif /* not HAVE_TIMEVAL */
957: if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0)
958: change_msgs();
959: }
960:
961: if (fix_screen_hook)
962: (*fix_screen_hook) ();
963:
964: /* Compute time from now till when time limit is up */
965: /* Exit if already run out */
966: if (time_limit == -1)
967: {
968: /* -1 specified for timeout means
969: gobble output available now
970: but don't wait at all. */
971: time_limit = -2;
972: #ifdef HAVE_TIMEVAL
973: timeout.tv_sec = 0;
974: timeout.tv_usec = 0;
975: #else
976: timeout = 0;
977: #endif /* not HAVE_TIMEVAL */
978: }
979: else if (time_limit)
980: {
981: #ifdef HAVE_TIMEVAL
982: gettimeofday (&timeout, &garbage);
983: timeout.tv_sec = end_time.tv_sec - timeout.tv_sec;
984: timeout.tv_usec = end_time.tv_usec - timeout.tv_usec;
985: if (timeout.tv_usec < 0)
986: timeout.tv_usec += 1000000,
987: timeout.tv_sec--;
988: if (timeout.tv_sec < 0)
989: break;
990: #else /* not HAVE_TIMEVAL */
991: time (&temp);
992: timeout = end_time - temp;
993: if (timeout < 0)
994: break;
995: #endif /* not HAVE_TIMEVAL */
996: }
997: else
998: {
999: #ifdef HAVE_TIMEVAL
1000: /* If no real timeout, loop sleeping with a big timeout
1001: so that input interrupt can wake us up by zeroing it */
1002: timeout.tv_sec = 100;
1003: timeout.tv_usec = 0;
1004: #else /* not HAVE_TIMEVAL */
1005: timeout = 100000; /* 100000 recognized by the select emulator */
1006: #endif /* not HAVE_TIMEVAL */
1007: }
1008:
1009: /* Cause C-g and alarm signals to take immediate action,
1010: and cause input available signals to zero out timeout */
1011: if (read_kbd < 0)
1012: set_waiting_for_input (&timeout);
1013:
1014: /* Wait till there is something to do */
1015:
1016: Available = Exception = input_wait_mask;
1017: if (!read_kbd)
1018: Available &= ~1;
1019:
1020: if (read_kbd && kbd_count)
1021: nfds = 0;
1022: else
1023: nfds = select (MAXDESC, &Available, 0, &Exception, &timeout);
1024:
1025: if (fix_screen_hook)
1026: (*fix_screen_hook) ();
1027:
1028: /* Make C-g and alarm signals set flags again */
1029: clear_waiting_for_input ();
1030:
1031: if (time_limit && nfds == 0) /* timeout elapsed */
1032: break;
1033: if (nfds < 0)
1034: {
1035: if (errno == EINTR)
1036: Available = 0;
1037: else if (errno == EBADF)
1038: abort ();
1039: else
1040: error("select error: %s", sys_errlist[errno]);
1041: }
1042:
1043: /* Check for keyboard input */
1044: /* If there is any, return immediately
1045: to give it higher priority than subprocesses */
1046:
1047: if (read_kbd && (kbd_count || !NULL (Vquit_flag)))
1048: break;
1049:
1050: if (read_kbd && (Available & ChannelMask (0)))
1051: break;
1052:
1053: #ifdef vipc
1054: /* Check for connection from other process */
1055:
1056: if (Available & ChannelMask (comm_server))
1057: {
1058: Available &= ~(ChannelMask (comm_server));
1059: create_commchan ();
1060: }
1061: #endif vipc
1062:
1063: /* Check for data from a process or a command channel */
1064:
1065: for (channel = 3; Available && channel < MAXDESC; channel++)
1066: {
1067: m = ChannelMask (channel);
1068: if (m & Available)
1069: {
1070: Available &= ~m;
1071: /* If waiting for this channel,
1072: arrange to return as soon as no more input
1073: to be processed. No more waiting. */
1074: if (wait_channel == channel)
1075: {
1076: wait_channel = 0;
1077: time_limit = -1;
1078: }
1079: proc = chan_process[channel];
1080: if (NULL (proc))
1081: continue;
1082:
1083: #ifdef vipc
1084: /* It's a command channel */
1085: if (!NULL (XPROCESS (proc)->command_channel_p))
1086: {
1087: ProcessCommChan (channel, proc);
1088: if (NULL (XPROCESS (proc)->command_channel_p))
1089: {
1090: /* It has ceased to be a command channel! */
1091: int bytes_available;
1092: if (ioctl (channel, FIONREAD, &bytes_available) < 0)
1093: bytes_available = 0;
1094: if (bytes_available)
1095: Available |= m;
1096: }
1097: continue;
1098: }
1099: #endif vipc
1100:
1101: /* Read data from the process, starting with our
1102: buffered-ahead character if we have one. */
1103:
1104: if (read_process_output (proc, channel) > 0)
1105: {
1106: if (do_display)
1107: DoDsp (1);
1108: }
1109: else
1110: {
1111: /* Preserve status of processes already terminated. */
1112: child_changed++;
1113: deactivate_process (proc);
1114:
1115: /*
1116: * With pty:s, when the parent process of a pty exits we are notified,
1117: * just as we would be with any of our other children. After the process
1118: * exits, select() will indicate that we can read the channel. When we
1119: * do this, read() returns 0. Upon receiving this, we close the channel.
1120: *
1121: * For external channels, when the peer closes the connection, select()
1122: * will indicate that we can read the channel. When we do this, read()
1123: * returns -1 with errno = ECONNRESET. Since we never get notified of
1124: * this via wait3(), we must explictly mark the process as having exited.
1125: */
1126: if ((XFASTINT (XPROCESS (proc)->flags) & PROC_STATUS)
1127: == RUNNING)
1128: {
1129: XFASTINT (XPROCESS (proc)->flags) = EXITED | CHANGED;
1130: XFASTINT (XPROCESS (proc)->reason) = 0;
1131: }
1132: }
1133: }
1134: } /* end for */
1135: } /* end while */
1136: }
1137:
1138: /* Read pending output from the process channel,
1139: starting with our buffered-ahead character if we have one.
1140: Yield number of characters read. */
1141:
1142: read_process_output (proc, channel)
1143: Lisp_Object proc;
1144: register int channel;
1145: {
1146: register int count;
1147: register int total = 0;
1148: char buf[1024];
1149:
1150: while (1)
1151: {
1152: if (proc_buffered_char[channel] < 0)
1153: count = read (channel, buf, sizeof buf);
1154: else
1155: {
1156: buf[0] = proc_buffered_char[channel];
1157: proc_buffered_char[channel] = -1;
1158: count = read (channel, buf + 1, sizeof buf - 1) + 1;
1159: }
1160:
1161: if (count <= 0)
1162: break;
1163:
1164: total += count;
1165: handle_process_output (proc, buf, count);
1166: }
1167: return total;
1168: }
1169:
1170: /*
1171: * Output has been received from a process on "chan" and should be stuffed in
1172: * the correct buffer.
1173: */
1174: handle_process_output (proc, chars, nchars)
1175: Lisp_Object proc;
1176: char *chars;
1177: int nchars;
1178: {
1179: Lisp_Object outstream;
1180: register struct buffer *old = bf_cur;
1181: register struct Lisp_Process *p = XPROCESS (proc);
1182: register int opoint;
1183:
1184: outstream = p->filter;
1185: if (!NULL (outstream))
1186: {
1187: call2 (outstream, proc, make_string (chars, nchars));
1188: return 1;
1189: }
1190:
1191: /* If no filter, write into buffer if it isn't dead. */
1192: if (!NULL (p->buffer) && !NULL (XBUFFER (p->buffer)->name))
1193: {
1194: Fset_buffer (p->buffer);
1195: opoint = point;
1196:
1197: /* Insert new output into buffer
1198: at the current end-of-output marker,
1199: thus preserving logical ordering of input and output. */
1200: if (XMARKER (p->mark)->buffer)
1201: SetPoint (marker_position (p->mark));
1202: else
1203: SetPoint (NumCharacters + 1);
1204: if (point <= opoint)
1205: opoint += nchars;
1206:
1207: InsCStr (chars, nchars);
1208: Fset_marker (p->mark, make_number (point), p->buffer);
1209: RedoModes++;
1210:
1211: SetPoint (opoint);
1212: SetBfp (old);
1213: }
1214: else return 0;
1215:
1216: /* Old feature was, delete early chars in chunks if
1217: buffer gets bigger that ProcessBufferSize.
1218: This feature is flushed */
1219:
1220: return 1;
1221: }
1222:
1223: /* Sending data to subprocess */
1224:
1225: jmp_buf send_process_frame;
1226:
1227: send_process_trap ()
1228: {
1229: #ifdef BSD4_1
1230: sigrelse (SIGPIPE);
1231: sigrelse (SIGALRM);
1232: #endif /* BSD4_1 */
1233: longjmp (send_process_frame, 1);
1234: }
1235:
1236: send_process_1 (proc, buf, len)
1237: Lisp_Object proc;
1238: char *buf;
1239: int len;
1240: {
1241: /* Don't use register vars; longjmp can lose them. */
1242: int rv;
1243: unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
1244:
1245: if ((XFASTINT (XPROCESS (proc)->flags) & PROC_STATUS) != RUNNING)
1246: error ("Process %s not running", procname);
1247:
1248: signal (SIGPIPE, send_process_trap);
1249:
1250: if (!setjmp (send_process_frame))
1251: while (len > 0)
1252: {
1253: rv = write (XFASTINT (XPROCESS (proc)->outfd), buf, len);
1254: if (rv < 0)
1255: break;
1256: buf += rv;
1257: len -= rv;
1258: }
1259: else
1260: {
1261: signal (SIGPIPE, SIG_DFL);
1262: XFASTINT (XPROCESS (proc)->flags) = EXITED | CHANGED;
1263: deactivate_process (proc);
1264: error ("SIGPIPE raised on process %s; closed it", procname);
1265: }
1266:
1267: signal (SIGPIPE, SIG_DFL);
1268:
1269: if (rv < 0)
1270: report_file_error ("writing to process", Fcons (proc, Qnil));
1271: }
1272:
1273: /*** Is it really safe for this to get an error ? */
1274:
1275: send_process (proc, buf, count)
1276: Lisp_Object proc;
1277: char *buf;
1278: int count;
1279: {
1280: #ifdef vipc
1281: struct { int checkword, type, datalen; } header;
1282:
1283: if (!NULL (XPROCESS (proc)->command_channel_p))
1284: {
1285: checkword = UNIQUE_FROB;
1286: type = VIPC_MESG;
1287: datalen = count;
1288: send_process_1 (proc, &header, sizeof header);
1289: }
1290: #endif vipc
1291: send_process_1 (proc, buf, count);
1292: }
1293:
1294: DEFUN ("send-region", Fsend_region, Ssend_region, 3, 3, 0,
1295: "Send current contents of region as input to PROCESS.\n\
1296: PROCESS may be a process name.\n\
1297: Called from program, takes three arguments, PROCESS, START and END.")
1298: (process, start, end)
1299: Lisp_Object process, start, end;
1300: {
1301: Lisp_Object proc;
1302: proc = get_process (process);
1303: validate_region (&start, &end);
1304:
1305: if (XINT (start) < bf_s1 && XINT (end) >= bf_s1)
1306: GapTo (start);
1307:
1308: send_process (proc, &CharAt (XINT (start)), XINT (end) - XINT (start));
1309:
1310: return Qnil;
1311: }
1312:
1313: DEFUN ("send-string", Fsend_string, Ssend_string, 2, 2, 0,
1314: "Send PROCESS the contents of STRING as input.\n\
1315: PROCESS may be a process name.")
1316: (process, string)
1317: Lisp_Object process, string;
1318: {
1319: Lisp_Object proc;
1320: CHECK_STRING (string, 1);
1321: proc = get_process (process);
1322: send_process (proc, XSTRING (string)->data, XSTRING (string)->size);
1323: return Qnil;
1324: }
1325:
1326: /* send a signal number SIGNO to PROCESS.
1327: CURRENT_GROUP means send to the process group that currently owns
1328: the terminal being used to communicate with PROCESS.
1329: This is used for various commands in shell mode.
1330: If NOMSG is zero, insert signal-announcements into process's buffers
1331: right away. */
1332:
1333: sig_process (process, signo, current_group, nomsg)
1334: Lisp_Object process;
1335: int signo;
1336: Lisp_Object current_group;
1337: int nomsg;
1338: {
1339: Lisp_Object proc;
1340: register struct Lisp_Process *p;
1341: int gid;
1342:
1343: proc = get_process (process);
1344: p = XPROCESS (proc);
1345:
1346: if (NULL (p->childp))
1347: error ("Process %s is not a subprocess",
1348: XSTRING (p->name)->data);
1349: if (!XFASTINT (p->infd))
1350: error ("Process %s is not active",
1351: XSTRING (p->name)->data);
1352:
1353: #ifdef TIOCGPGRP /* Not sure about this! (fnf) */
1354: /* If we are using pgrps, get a pgrp number and make it negative. */
1355: if (!NULL (current_group))
1356: {
1357: ioctl (XFASTINT (p->infd), TIOCGPGRP, &gid);
1358: gid = - gid;
1359: }
1360: else
1361: gid = - XFASTINT (p->pid);
1362: #else /* not using pgrps */
1363: /* Can't select pgrps on this system, so we know that
1364: the child itself heads the pgrp. */
1365: gid = - XFASTINT (p->pid);
1366: #endif /* not using pgrps */
1367:
1368: switch (signo)
1369: {
1370: #ifdef SIGCONT
1371: case SIGCONT:
1372: XFASTINT (p->flags) = RUNNING | CHANGED;
1373: child_changed++;
1374: break;
1375: #endif
1376: case SIGINT:
1377: case SIGQUIT:
1378: case SIGKILL:
1379: flush_pending_output (XFASTINT (p->infd));
1380: break;
1381: }
1382: /* gid may be a pid, or minus a pgrp's number */
1383: #ifdef BSD
1384: /* On bsd, [man says] kill does not accept a negative number to kill a pgrp.
1385: Must do that differently. */
1386: killpg (-gid, signo);
1387: #else /* Not BSD. */
1388: kill (gid, signo);
1389: #endif /* Not BSD. */
1390:
1391: /* Put notices in buffers now, since it is safe now.
1392: Because of this, we know that a process we have just killed
1393: will never need to use its buffer again. */
1394: if (!nomsg)
1395: change_msgs ();
1396: }
1397:
1398: DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
1399: "Interrupt process PROCESS. May be process or name of one.\n\
1400: Nil or no arg means current buffer's process.\n\
1401: Second arg CURRENT-GROUP non-nil means send signal to\n\
1402: the current process-group of the process's controlling terminal\n\
1403: rather than to the process's own process group.\n\
1404: If the process is a shell, this means interrupt current subjob\n\
1405: rather than the shell.")
1406: (process, current_group)
1407: Lisp_Object process, current_group;
1408: {
1409: sig_process (process, SIGINT, current_group, 0);
1410: return process;
1411: }
1412:
1413: DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
1414: "Kill process PROCESS. May be process or name of one.\n\
1415: See function interrupt-process for more details on usage.")
1416: (process, current_group)
1417: Lisp_Object process, current_group;
1418: {
1419: sig_process (process, SIGKILL, current_group, 0);
1420: return process;
1421: }
1422:
1423: DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
1424: "Send QUIT signal to process PROCESS. May be process or name of one.\n\
1425: See function interrupt-process for more details on usage.")
1426: (process, current_group)
1427: Lisp_Object process, current_group;
1428: {
1429: sig_process (process, SIGQUIT, current_group, 0);
1430: return process;
1431: }
1432:
1433: DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
1434: "Stop process PROCESS. May be process or name of one.\n\
1435: See function interrupt-process for more details on usage.")
1436: (process, current_group)
1437: Lisp_Object process, current_group;
1438: {
1439: #ifndef SIGTSTP
1440: error ("no SIGTSTP support");
1441: #else
1442: sig_process (process, SIGTSTP, current_group, 0);
1443: #endif
1444: return process;
1445: }
1446:
1447: DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
1448: "Continue process PROCESS. May be process or name of one.\n\
1449: See function interrupt-process for more details on usage.")
1450: (process, current_group)
1451: Lisp_Object process, current_group;
1452: {
1453: #ifdef SIGCONT
1454: sig_process (process, SIGCONT, current_group, 0);
1455: #else
1456: error ("no SIGCONT support");
1457: #endif
1458: return process;
1459: }
1460:
1461: DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
1462: "Make PROCESS see end-of-file in its input.\n\
1463: Eof comes after any text already sent to it.\n\
1464: Nil or no arg means current buffer's process.")
1465: (process)
1466: Lisp_Object process;
1467: {
1468: Lisp_Object proc;
1469:
1470: proc = get_process (process);
1471: send_process (proc, "\004", 1);
1472: return process;
1473: }
1474:
1475: /* Kill all processes associated with `buffer'.
1476: If `buffer' is nil, kill all processes */
1477:
1478: kill_buffer_processes (buffer)
1479: Lisp_Object buffer;
1480: {
1481: Lisp_Object tail, proc;
1482:
1483: for (tail = Vprocess_alist; XGCTYPE (tail) == Lisp_Cons;
1484: tail = XCONS (tail)->cdr)
1485: {
1486: proc = XCONS (XCONS (tail)->car)->cdr;
1487: if (XGCTYPE (proc) == Lisp_Process
1488: && (NULL (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
1489: if (XFASTINT (XPROCESS (proc)->infd))
1490: sig_process (proc, SIGKILL, Qnil, 1);
1491: }
1492: }
1493:
1494: count_active_processes ()
1495: {
1496: register Lisp_Object tail, proc;
1497: register int count = 0;
1498:
1499: for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
1500: {
1501: proc = Fcdr (Fcar (tail));
1502:
1503: if ((1 << (XFASTINT (XPROCESS (proc)->flags) & PROC_STATUS)
1504: & ((1 << RUNNING) | (1 << STOPPED)))
1505: && NULL (XPROCESS (proc)->kill_without_query))
1506: count++;
1507: }
1508:
1509: return count;
1510: }
1511:
1512: /* On receipt of a signal that a child status has changed,
1513: loop asking about children with changed statuses until
1514: the system says there are no more.
1515: All we do is change the flags components;
1516: we do not run sentinels or print notifications.
1517: That is saved for the next time keyboard input is done,
1518: in order to avoid timing errors. */
1519:
1520: /** WARNING: this can be called during garbage collection.
1521: Therefore, it must not be fooled by the presence of mark bits in
1522: Lisp objects. */
1523:
1524: /** USG WARNING: Although it is not obvious from the documentation
1525: in signal(2), on a USG system the SIGCLD handler MUST NOT call
1526: signal() before executing at least one wait(), otherwise the handler
1527: will be called again, resulting in an infinite loop. The relevant
1528: portion of the documentation reads "SIGCLD signals will be queued
1529: and the signal-catching function will be continually reentered until
1530: the queue is empty". Invoking signal() causes the kernel to reexamine
1531: the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
1532:
1533: child_sig (signo)
1534: int signo;
1535: {
1536: register int pid;
1537: WAITTYPE w;
1538: Lisp_Object tail, proc;
1539: register struct Lisp_Process *p;
1540:
1541: #ifdef BSD4_1
1542: extern int synch_process_pid;
1543: extern int sigheld;
1544: sigheld |= sigbit (SIGCHLD);
1545: #endif
1546:
1547: loop:
1548:
1549: #ifdef WNOHANG
1550: #ifndef WUNTRACED
1551: #define WUNTRACED 0
1552: #endif /* no WUNTRACED */
1553: pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
1554: if (pid <= 0)
1555: {
1556: if (errno == EINTR)
1557: {
1558: errno = 0;
1559: goto loop;
1560: }
1561: /* USG systems forget handlers when they are used;
1562: must reestablish each time */
1563: #ifdef USG
1564: signal (signo, child_sig); /* WARNING - must come after wait3() */
1565: #endif
1566: #ifdef BSD4_1
1567: sigheld &= ~sigbit (SIGCHLD);
1568: sigrelse (SIGCHLD);
1569: #endif
1570: return;
1571: }
1572: #else
1573: pid = wait (&w);
1574: #endif /* no WNOHANG */
1575:
1576: #ifdef BSD4_1
1577: if (synch_process_pid == pid)
1578: synch_process_pid = 0; /* Zero it to show process has died. */
1579: #endif
1580:
1581: for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
1582: {
1583: proc = XCONS (XCONS (tail)->car)->cdr;
1584: p = XPROCESS (proc);
1585: if (!NULL (p->childp) && XFASTINT (p->pid) == pid)
1586: break;
1587: }
1588:
1589: if (XSYMBOL (tail) == XSYMBOL (Qnil))
1590: #ifdef USG
1591: goto ignore;
1592: #else
1593: goto loop; /* We don't know who this is */
1594: #endif
1595:
1596: child_changed++;
1597: if (WIFSTOPPED (w))
1598: {
1599: XFASTINT (p->flags) = STOPPED | CHANGED;
1600: XFASTINT (p->reason) = WSTOPSIG (w);
1601: }
1602: else if (WIFEXITED (w))
1603: {
1604: XFASTINT (p->flags) = EXITED | CHANGED;
1605: if (WCOREDUMP (w))
1606: XFASTINT (p->flags) |= COREDUMPED;
1607: XFASTINT (p->reason) = WRETCODE (w);
1608: }
1609: else if (WIFSIGNALED (w))
1610: {
1611: XFASTINT (p->flags) = SIGNALED | CHANGED;
1612: if (WCOREDUMP (w))
1613: XFASTINT (p->flags) |= COREDUMPED;
1614: XFASTINT (p->reason) = WTERMSIG (w);
1615: }
1616: #ifndef USG
1617: goto loop;
1618: #else
1619: ignore:
1620: signal (signo, child_sig);
1621: #endif /* not USG */
1622: }
1623:
1624: /* Find all process marked as "changed"
1625: and notify the user in a suitable fashion
1626: (either run the sentinel or output a message).
1627: This is done while Emacs is waiting for keyboard input */
1628:
1629: change_msgs()
1630: {
1631: Lisp_Object tail, proc, buffer;
1632: register struct Lisp_Process *p;
1633: register struct buffer *old = bf_cur;
1634: char line[50];
1635: int opoint;
1636:
1637: child_changed = 0;
1638:
1639: for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
1640: {
1641: proc = Fcdr (Fcar (tail));
1642: p = XPROCESS (proc);
1643:
1644: if (!(XFASTINT (p->flags) & CHANGED))
1645: continue;
1646:
1647: /* If process is still active, read any output that remains. */
1648: if (XFASTINT (p->infd))
1649: read_process_output (proc, XFASTINT (p->infd));
1650:
1651: XFASTINT (p->flags) &= ~CHANGED;
1652:
1653: line[0] = 0;
1654: buffer = p->buffer;
1655:
1656: if ((XFASTINT (p->flags) & PROC_STATUS) == SIGNALED
1657: || (XFASTINT (p->flags) & PROC_STATUS) == STOPPED)
1658: {
1659: sprintf (line, "%s%s\n",
1660: XFASTINT (p->reason) < NSIG
1661: ? sys_siglist[XFASTINT (p->reason)] : "unknown",
1662: XFASTINT (p->flags) & COREDUMPED ? " (core dumped)" : "");
1663: if (line[0] >= 'A' && line[0] <= 'Z')
1664: line[0] += 040;
1665:
1666: if ((XFASTINT (p->flags) & PROC_STATUS) == SIGNALED)
1667: if (delete_exited_processes)
1668: remove_process (proc);
1669: else
1670: deactivate_process (proc);
1671: }
1672: else if ((XFASTINT (p->flags) & PROC_STATUS) == EXITED)
1673: {
1674: if (XFASTINT (p->reason))
1675: sprintf (line, "exited abnormally with code %d\n",
1676: XFASTINT (p->reason));
1677: else
1678: sprintf (line, "finished\n");
1679:
1680: if (delete_exited_processes)
1681: remove_process (proc);
1682: else
1683: deactivate_process (proc);
1684: }
1685:
1686: if (!NULL (p->sentinel))
1687: exec_sentinel (proc, build_string (line));
1688: else if (line[0] && !NULL (buffer))
1689: {
1690: /* Avoid error if buffer is deleted
1691: (probably that's why the process is dead, too) */
1692: if (NULL (XBUFFER (buffer)->name))
1693: continue;
1694: Fset_buffer (buffer);
1695: opoint = point;
1696: SetPoint (NumCharacters + 1);
1697: if (point == opoint)
1698: opoint = -1;
1699: InsStr ("\nProcess ");
1700: Finsert (1, &p->name);
1701: InsStr (" ");
1702: InsStr (line);
1703: if (opoint > 0)
1704: SetPoint (opoint);
1705: }
1706: } /* end for */
1707:
1708: SetBfp (old);
1709:
1710: RedoModes++; /* in case buffers use %s in mode-line-format */
1711: DoDsp (1);
1712: }
1713:
1714: exec_sentinel (proc, reason)
1715: Lisp_Object proc, reason;
1716: {
1717: Lisp_Object sentinel;
1718: register struct Lisp_Process *p = XPROCESS (proc);
1719:
1720: sentinel = p->sentinel;
1721: if (NULL (sentinel))
1722: return;
1723:
1724: p->sentinel = Qnil;
1725: call2 (sentinel, proc, reason);
1726: p->sentinel = sentinel;
1727: }
1728:
1729: init_process ()
1730: {
1731: register int i;
1732:
1733: #ifdef SIGCHLD
1734: signal (SIGCHLD, child_sig);
1735: #endif
1736:
1737: input_wait_mask = ChannelMask(0);
1738: Vprocess_alist = Qnil;
1739: for (i = 0; i < MAXDESC; i++)
1740: {
1741: chan_process[i] = Qnil;
1742: proc_buffered_char[i] = -1;
1743: }
1744: }
1745:
1746: syms_of_process ()
1747: {
1748: Qprocessp = intern ("processp");
1749: staticpro (&Qprocessp);
1750:
1751: staticpro (&Vprocess_alist);
1752:
1753: DefBoolVar ("delete-exited-processes", &delete_exited_processes,
1754: "*Non-nil means delete processes immediately when they exit.\n\
1755: nil means don't delete them until list-processes is done.");
1756:
1757: delete_exited_processes = 1;
1758:
1759: defsubr (&Sprocessp);
1760: defsubr (&Sget_process);
1761: defsubr (&Sget_buffer_process);
1762: defsubr (&Sdelete_process);
1763: defsubr (&Sprocess_status);
1764: defsubr (&Sprocess_id);
1765: defsubr (&Sprocess_name);
1766: defsubr (&Sprocess_command);
1767: defsubr (&Sset_process_buffer);
1768: defsubr (&Sprocess_buffer);
1769: defsubr (&Sprocess_mark);
1770: defsubr (&Sset_process_filter);
1771: defsubr (&Sprocess_filter);
1772: defsubr (&Sset_process_sentinel);
1773: defsubr (&Sprocess_sentinel);
1774: defsubr (&Sprocess_kill_without_query);
1775: defsubr (&Slist_processes);
1776: defsubr (&Sstart_process);
1777: defsubr (&Saccept_process_output);
1778: defsubr (&Ssend_region);
1779: defsubr (&Ssend_string);
1780: defsubr (&Sinterrupt_process);
1781: defsubr (&Skill_process);
1782: defsubr (&Squit_process);
1783: defsubr (&Sstop_process);
1784: defsubr (&Scontinue_process);
1785: defsubr (&Sprocess_send_eof);
1786: }
1787:
1788: #endif subprocesses
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.