1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
25 /* This file is split into two parts by the following preprocessor
26 conditional. The 'then' clause contains all of the support for
27 asynchronous subprocesses. The 'else' clause contains stub
28 versions of some of the asynchronous subprocess routines that are
29 often called elsewhere in Emacs, so we don't have to #ifdef the
30 sections that call them. */
38 #include <sys/types.h> /* some typedefs are used in sys/file.h */
42 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
43 #include <sys/socket.h>
45 #include <netinet/in.h>
46 #include <arpa/inet.h>
47 #endif /* HAVE_SOCKETS */
49 #if defined(BSD) || defined(STRIDE)
50 #include <sys/ioctl.h>
51 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
53 #endif /* HAVE_PTYS and no O_NDELAY */
54 #endif /* BSD or STRIDE */
61 #include <sys/sysmacros.h> /* for "minor" */
71 #include "termhooks.h"
76 Lisp_Object Qrun
, Qstop
, Qsignal
, Qopen
, Qclosed
;
77 /* Qexit is declared and initialized in eval.c. */
79 /* a process object is a network connection when its childp field is neither
80 Qt nor Qnil but is instead a string (name of foreign host we
81 are connected to + name of port we are connected to) */
84 static Lisp_Object stream_process
;
86 #define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String)
88 #define NETCONN_P(p) 0
89 #endif /* HAVE_SOCKETS */
91 /* Define first descriptor number available for subprocesses. */
93 #define FIRST_PROC_DESC 1
95 #define FIRST_PROC_DESC 3
98 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
101 #if !defined (SIGCHLD) && defined (SIGCLD)
102 #define SIGCHLD SIGCLD
105 #include "syssignal.h"
107 /* Define the structure that the wait system call stores.
108 On many systems, there is a structure defined for this.
109 But on vanilla-ish USG systems there is not. */
113 #if (!defined (BSD) && !defined (UNIPLUS) && !defined (STRIDE) && !(defined (HPUX) && !defined (NOMULTIPLEJOBS)) && !defined (HAVE_WAIT_HEADER)) || defined (LINUX)
115 #define WIFSTOPPED(w) ((w&0377) == 0177)
116 #define WIFSIGNALED(w) ((w&0377) != 0177 && (w&~0377) == 0)
117 #define WIFEXITED(w) ((w&0377) == 0)
118 #define WRETCODE(w) (w >> 8)
119 #define WSTOPSIG(w) (w >> 8)
120 #define WTERMSIG(w) (w & 0377)
122 #define WCOREDUMP(w) ((w&0200) != 0)
128 #include <sys/wait.h>
129 #endif /* not BSD 4.1 */
131 #define WAITTYPE union wait
132 #define WRETCODE(w) w.w_retcode
133 #define WCOREDUMP(w) w.w_coredump
136 /* HPUX version 7 has broken definitions of these. */
145 #define WTERMSIG(w) w.w_termsig
148 #define WSTOPSIG(w) w.w_stopsig
151 #define WIFSTOPPED(w) (WTERMSIG (w) == 0177)
154 #define WIFSIGNALED(w) (WTERMSIG (w) != 0177 && (WSTOPSIG (w)) == 0)
157 #define WIFEXITED(w) (WTERMSIG (w) == 0)
159 #endif /* BSD or UNIPLUS or STRIDE */
160 #endif /* no WAITTYPE */
163 #define WIFSTOPPED(w) 0
164 #define WIFSIGNALED(w) 0
165 #define WIFEXITED(w) ((w) != -1)
166 #define WRETCODE(w) (w)
167 #define WSTOPSIG(w) (w)
168 #define WCOREDUMP(w) 0
169 #define WTERMSIG(w) (w)
178 extern char *sys_errlist
[];
183 extern char *sys_siglist
[];
186 char *sys_siglist
[] =
192 "illegal instruction",
196 "floating point exception",
199 "segmentation violation",
200 "bad argument to system call",
201 "write on a pipe with no one to read it",
203 "software termination signal from kill",
205 "sendable stop signal not from tty",
206 "stop signal from tty",
207 "continue a stopped process",
208 "child status has changed",
209 "background read attempted from control tty",
210 "background write attempted from control tty",
211 "input record available at control tty",
212 "exceeded CPU time limit",
213 "exceeded file size limit"
218 /* t means use pty, nil means use a pipe,
219 maybe other values to come. */
220 Lisp_Object Vprocess_connection_type
;
224 #include <sys/socket.h>
228 /* Number of events of change of status of a process. */
231 /* Number of events for which the user or sentinel has been notified. */
235 /* We could get this from param.h, but better not to depend on finding that.
236 And better not to risk that it might define other symbols used in this
239 #define MAXDESC FD_SETSIZE
243 #define SELECT_TYPE fd_set
244 #else /* no FD_SET */
246 #define SELECT_TYPE int
248 /* Define the macros to access a single-int bitmap of descriptors. */
249 #define FD_SET(n, p) (*(p) |= (1 << (n)))
250 #define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
251 #define FD_ISSET(n, p) (*(p) & (1 << (n)))
252 #define FD_ZERO(p) (*(p) = 0)
253 #endif /* no FD_SET */
255 /* Mask of bits indicating the descriptors that we wait for input on */
257 SELECT_TYPE input_wait_mask
;
259 int delete_exited_processes
;
261 /* Indexed by descriptor, gives the process (if any) for that descriptor */
262 Lisp_Object chan_process
[MAXDESC
];
264 /* Alist of elements (NAME . PROCESS) */
265 Lisp_Object Vprocess_alist
;
267 Lisp_Object Qprocessp
;
269 Lisp_Object
get_process ();
271 /* Buffered-ahead input char from process, indexed by channel.
272 -1 means empty (no char is buffered).
273 Used on sys V where the only way to tell if there is any
274 output from the process is to read at least one char.
275 Always -1 on systems that support FIONREAD. */
277 int proc_buffered_char
[MAXDESC
];
279 /* Compute the Lisp form of the process status, p->status, from
280 the numeric status that was returned by `wait'. */
282 Lisp_Object
status_convert ();
285 struct Lisp_Process
*p
;
287 union { int i
; WAITTYPE wt
; } u
;
288 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
289 p
->status
= status_convert (u
.wt
);
290 p
->raw_status_low
= Qnil
;
291 p
->raw_status_high
= Qnil
;
294 /* Convert a process status word in Unix format to
295 the list that we use internally. */
302 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
303 else if (WIFEXITED (w
))
304 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
305 WCOREDUMP (w
) ? Qt
: Qnil
));
306 else if (WIFSIGNALED (w
))
307 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
308 WCOREDUMP (w
) ? Qt
: Qnil
));
313 /* Given a status-list, extract the three pieces of information
314 and store them individually through the three pointers. */
317 decode_status (l
, symbol
, code
, coredump
)
325 if (XTYPE (l
) == Lisp_Symbol
)
333 *symbol
= XCONS (l
)->car
;
334 tem
= XCONS (l
)->cdr
;
335 *code
= XFASTINT (XCONS (tem
)->car
);
336 tem
= XCONS (tem
)->cdr
;
337 *coredump
= !NILP (tem
);
341 /* Return a string describing a process status list. */
344 status_message (status
)
349 Lisp_Object string
, string2
;
351 decode_status (status
, &symbol
, &code
, &coredump
);
353 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
356 string
= build_string (code
< NSIG
? sys_siglist
[code
] : "unknown");
358 string
= build_string (code
< NSIG
? sys_errlist
[code
] : "unknown");
360 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
361 XSTRING (string
)->data
[0] = DOWNCASE (XSTRING (string
)->data
[0]);
362 return concat2 (string
, string2
);
364 else if (EQ (symbol
, Qexit
))
367 return build_string ("finished\n");
368 string
= Fnumber_to_string (make_number (code
));
369 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
370 return concat2 (build_string ("exited abnormally with code "),
371 concat2 (string
, string2
));
374 return Fcopy_sequence (Fsymbol_name (symbol
));
379 /* Open an available pty, returning a file descriptor.
380 Return -1 on failure.
381 The file name of the terminal corresponding to the pty
382 is left in the variable pty_name. */
393 /* Some systems name their pseudoterminals so that there are gaps in
394 the usual sequence - for example, on HP9000/S700 systems, there
395 are no pseudoterminals with names ending in 'f'. So we wait for
396 three failures in a row before deciding that we've reached the
398 int failed_count
= 0;
403 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
404 for (i
= 0; i
< 16; i
++)
407 #ifdef PTY_NAME_SPRINTF
410 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
411 #endif /* no PTY_NAME_SPRINTF */
415 #else /* no PTY_OPEN */
417 /* Unusual IRIS code */
418 *ptyv
= open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
421 if (fstat (fd
, &stb
) < 0)
424 if (stat (pty_name
, &stb
) < 0)
427 if (failed_count
>= 3)
433 fd
= open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
435 fd
= open (pty_name
, O_RDWR
| O_NDELAY
, 0);
437 #endif /* not IRIS */
438 #endif /* no PTY_OPEN */
442 /* check to make certain that both sides are available
443 this avoids a nasty yet stupid bug in rlogins */
444 #ifdef PTY_TTY_NAME_SPRINTF
447 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
448 #endif /* no PTY_TTY_NAME_SPRINTF */
450 if (access (pty_name
, 6) != 0)
453 #if !defined(IRIS) && !defined(__sgi)
459 #endif /* not UNIPLUS */
466 #endif /* HAVE_PTYS */
472 register Lisp_Object val
, tem
, name1
;
473 register struct Lisp_Process
*p
;
477 /* size of process structure includes the vector header,
478 so deduct for that. But struct Lisp_Vector includes the first
479 element, thus deducts too much, so add it back. */
480 val
= Fmake_vector (make_number ((sizeof (struct Lisp_Process
)
481 - sizeof (struct Lisp_Vector
)
482 + sizeof (Lisp_Object
))
483 / sizeof (Lisp_Object
)),
485 XSETTYPE (val
, Lisp_Process
);
488 XFASTINT (p
->infd
) = 0;
489 XFASTINT (p
->outfd
) = 0;
490 XFASTINT (p
->pid
) = 0;
491 XFASTINT (p
->tick
) = 0;
492 XFASTINT (p
->update_tick
) = 0;
493 p
->raw_status_low
= Qnil
;
494 p
->raw_status_high
= Qnil
;
496 p
->mark
= Fmake_marker ();
498 /* If name is already in use, modify it until it is unused. */
503 tem
= Fget_process (name1
);
504 if (NILP (tem
)) break;
505 sprintf (suffix
, "<%d>", i
);
506 name1
= concat2 (name
, build_string (suffix
));
510 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
514 remove_process (proc
)
515 register Lisp_Object proc
;
517 register Lisp_Object pair
;
519 pair
= Frassq (proc
, Vprocess_alist
);
520 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
521 Fset_marker (XPROCESS (proc
)->mark
, Qnil
, Qnil
);
523 deactivate_process (proc
);
526 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
527 "Return t if OBJECT is a process.")
531 return XTYPE (obj
) == Lisp_Process
? Qt
: Qnil
;
534 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
535 "Return the process named NAME, or nil if there is none.")
537 register Lisp_Object name
;
539 if (XTYPE (name
) == Lisp_Process
)
541 CHECK_STRING (name
, 0);
542 return Fcdr (Fassoc (name
, Vprocess_alist
));
545 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
546 "Return the (or, a) process associated with BUFFER.\n\
547 BUFFER may be a buffer or the name of one.")
549 register Lisp_Object name
;
551 register Lisp_Object buf
, tail
, proc
;
553 if (NILP (name
)) return Qnil
;
554 buf
= Fget_buffer (name
);
555 if (NILP (buf
)) return Qnil
;
557 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
559 proc
= Fcdr (Fcar (tail
));
560 if (XTYPE (proc
) == Lisp_Process
&& EQ (XPROCESS (proc
)->buffer
, buf
))
566 /* This is how commands for the user decode process arguments. It
567 accepts a process, a process name, a buffer, a buffer name, or nil.
568 Buffers denote the first process in the buffer, and nil denotes the
573 register Lisp_Object name
;
575 register Lisp_Object proc
;
577 proc
= Fget_buffer_process (Fcurrent_buffer ());
580 proc
= Fget_process (name
);
582 proc
= Fget_buffer_process (Fget_buffer (name
));
589 error ("Current buffer has no process");
591 error ("Process %s does not exist", XSTRING (name
)->data
);
595 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
596 "Delete PROCESS: kill it and forget about it immediately.\n\
597 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
598 nil, indicating the current buffer's process.")
600 register Lisp_Object proc
;
602 proc
= get_process (proc
);
603 XPROCESS (proc
)->raw_status_low
= Qnil
;
604 XPROCESS (proc
)->raw_status_high
= Qnil
;
605 if (NETCONN_P (proc
))
607 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
608 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
610 else if (XFASTINT (XPROCESS (proc
)->infd
))
612 Fkill_process (proc
, Qnil
);
613 /* Do this now, since remove_process will make sigchld_handler do nothing. */
614 XPROCESS (proc
)->status
615 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
616 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
619 remove_process (proc
);
623 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
624 "Return the status of PROCESS: a symbol, one of these:\n\
625 run -- for a process that is running.\n\
626 stop -- for a process stopped but continuable.\n\
627 exit -- for a process that has exited.\n\
628 signal -- for a process that has got a fatal signal.\n\
629 open -- for a network stream connection that is open.\n\
630 closed -- for a network stream connection that is closed.\n\
631 nil -- if arg is a process name and no such process exists.\n\
632 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
633 nil, indicating the current buffer's process.")
634 /* command -- for a command channel opened to Emacs by another process.\n\
635 external -- for an i/o channel opened to Emacs by another process.\n\ */
637 register Lisp_Object proc
;
639 register struct Lisp_Process
*p
;
640 register Lisp_Object status
;
641 proc
= get_process (proc
);
645 if (!NILP (p
->raw_status_low
))
648 if (XTYPE (status
) == Lisp_Cons
)
649 status
= XCONS (status
)->car
;
650 if (NETCONN_P (proc
))
652 if (EQ (status
, Qrun
))
654 else if (EQ (status
, Qexit
))
660 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
662 "Return the exit status of PROCESS or the signal number that killed it.\n\
663 If PROCESS has not yet exited or died, return 0.")
665 register Lisp_Object proc
;
667 CHECK_PROCESS (proc
, 0);
668 if (!NILP (XPROCESS (proc
)->raw_status_low
))
669 update_status (XPROCESS (proc
));
670 if (XTYPE (XPROCESS (proc
)->status
) == Lisp_Cons
)
671 return XCONS (XCONS (XPROCESS (proc
)->status
)->cdr
)->car
;
672 return make_number (0);
675 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
676 "Return the process id of PROCESS.\n\
677 This is the pid of the Unix process which PROCESS uses or talks to.\n\
678 For a network connection, this value is nil.")
680 register Lisp_Object proc
;
682 CHECK_PROCESS (proc
, 0);
683 return XPROCESS (proc
)->pid
;
686 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
687 "Return the name of PROCESS, as a string.\n\
688 This is the name of the program invoked in PROCESS,\n\
689 possibly modified to make it unique among process names.")
691 register Lisp_Object proc
;
693 CHECK_PROCESS (proc
, 0);
694 return XPROCESS (proc
)->name
;
697 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
698 "Return the command that was executed to start PROCESS.\n\
699 This is a list of strings, the first string being the program executed\n\
700 and the rest of the strings being the arguments given to it.\n\
701 For a non-child channel, this is nil.")
703 register Lisp_Object proc
;
705 CHECK_PROCESS (proc
, 0);
706 return XPROCESS (proc
)->command
;
709 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
711 "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
713 register Lisp_Object proc
, buffer
;
715 CHECK_PROCESS (proc
, 0);
717 CHECK_BUFFER (buffer
, 1);
718 XPROCESS (proc
)->buffer
= buffer
;
722 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
724 "Return the buffer PROCESS is associated with.\n\
725 Output from PROCESS is inserted in this buffer\n\
726 unless PROCESS has a filter.")
728 register Lisp_Object proc
;
730 CHECK_PROCESS (proc
, 0);
731 return XPROCESS (proc
)->buffer
;
734 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
736 "Return the marker for the end of the last output from PROCESS.")
738 register Lisp_Object proc
;
740 CHECK_PROCESS (proc
, 0);
741 return XPROCESS (proc
)->mark
;
744 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
746 "Give PROCESS the filter function FILTER; nil means no filter.\n\
747 When a process has a filter, each time it does output\n\
748 the entire string of output is passed to the filter.\n\
749 The filter gets two arguments: the process and the string of output.\n\
750 If the process has a filter, its buffer is not used for output.")
752 register Lisp_Object proc
, filter
;
754 CHECK_PROCESS (proc
, 0);
755 XPROCESS (proc
)->filter
= filter
;
759 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
761 "Returns the filter function of PROCESS; nil if none.\n\
762 See `set-process-filter' for more info on filter functions.")
764 register Lisp_Object proc
;
766 CHECK_PROCESS (proc
, 0);
767 return XPROCESS (proc
)->filter
;
770 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
772 "Give PROCESS the sentinel SENTINEL; nil for none.\n\
773 The sentinel is called as a function when the process changes state.\n\
774 It gets two arguments: the process, and a string describing the change.")
776 register Lisp_Object proc
, sentinel
;
778 CHECK_PROCESS (proc
, 0);
779 XPROCESS (proc
)->sentinel
= sentinel
;
783 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
785 "Return the sentinel of PROCESS; nil if none.\n\
786 See `set-process-sentinel' for more info on sentinels.")
788 register Lisp_Object proc
;
790 CHECK_PROCESS (proc
, 0);
791 return XPROCESS (proc
)->sentinel
;
794 DEFUN ("process-kill-without-query", Fprocess_kill_without_query
,
795 Sprocess_kill_without_query
, 1, 2, 0,
796 "Say no query needed if PROCESS is running when Emacs is exited.\n\
797 Optional second argument if non-nill says to require a query.\n\
798 Value is t if a query was formerly required.")
800 register Lisp_Object proc
, value
;
804 CHECK_PROCESS (proc
, 0);
805 tem
= XPROCESS (proc
)->kill_without_query
;
806 XPROCESS (proc
)->kill_without_query
= Fnull (value
);
814 register Lisp_Object tail
, tem
;
815 Lisp_Object proc
, minspace
, tem1
;
816 register struct buffer
*old
= current_buffer
;
817 register struct Lisp_Process
*p
;
821 XFASTINT (minspace
) = 1;
823 set_buffer_internal (XBUFFER (Vstandard_output
));
824 Fbuffer_disable_undo (Vstandard_output
);
826 current_buffer
->truncate_lines
= Qt
;
829 Proc Status Buffer Command\n\
830 ---- ------ ------ -------\n", -1);
832 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
836 proc
= Fcdr (Fcar (tail
));
838 if (NILP (p
->childp
))
841 Finsert (1, &p
->name
);
842 Findent_to (make_number (13), minspace
);
844 if (!NILP (p
->raw_status_low
))
847 if (XTYPE (p
->status
) == Lisp_Cons
)
848 symbol
= XCONS (p
->status
)->car
;
851 if (EQ (symbol
, Qsignal
))
854 tem
= Fcar (Fcdr (p
->status
));
856 if (XINT (tem
) < NSIG
)
857 write_string (sys_errlist
[XINT (tem
)], -1);
860 Fprinc (symbol
, Qnil
);
862 else if (NETCONN_P (proc
))
864 if (EQ (symbol
, Qrun
))
865 write_string ("open", -1);
866 else if (EQ (symbol
, Qexit
))
867 write_string ("closed", -1);
869 Fprinc (symbol
, Qnil
);
872 Fprinc (symbol
, Qnil
);
874 if (EQ (symbol
, Qexit
))
877 tem
= Fcar (Fcdr (p
->status
));
880 sprintf (tembuf
, " %d", XFASTINT (tem
));
881 write_string (tembuf
, -1);
885 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
886 remove_process (proc
);
888 Findent_to (make_number (22), minspace
);
889 if (NILP (p
->buffer
))
890 insert_string ("(none)");
891 else if (NILP (XBUFFER (p
->buffer
)->name
))
892 insert_string ("(Killed)");
894 Finsert (1, &XBUFFER (p
->buffer
)->name
);
896 Findent_to (make_number (37), minspace
);
898 if (NETCONN_P (proc
))
900 sprintf (tembuf
, "(network stream connection to %s)\n",
901 XSTRING (p
->childp
)->data
);
902 insert_string (tembuf
);
916 insert_string ("\n");
922 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 0, "",
923 "Display a list of all processes.\n\
924 \(Any processes listed as Exited or Signaled are actually eliminated\n\
925 after the listing is made.)")
928 internal_with_output_to_temp_buffer ("*Process List*",
929 list_processes_1
, Qnil
);
933 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
934 "Return a list of all processes.")
937 return Fmapcar (Qcdr
, Vprocess_alist
);
940 /* Starting asynchronous inferior processes. */
942 static Lisp_Object
start_process_unwind ();
944 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
945 "Start a program in a subprocess. Return the process object for it.\n\
946 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
947 NAME is name for process. It is modified if necessary to make it unique.\n\
948 BUFFER is the buffer or (buffer-name) to associate with the process.\n\
949 Process output goes at end of that buffer, unless you specify\n\
950 an output stream or filter function to handle the output.\n\
951 BUFFER may be also nil, meaning that this process is not associated\n\
953 Third arg is program file name. It is searched for as in the shell.\n\
954 Remaining arguments are strings to give program as arguments.")
957 register Lisp_Object
*args
;
959 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
961 register unsigned char *new_argv
;
964 register unsigned char **new_argv
;
967 int count
= specpdl_ptr
- specpdl
;
971 buffer
= Fget_buffer_create (buffer
);
973 /* Make sure that the child will be able to chdir to the current
974 buffer's current directory, or its unhandled equivalent. We
975 can't just have the child check for an error when it does the
976 chdir, since it's in a vfork.
978 We have to GCPRO around this because Fexpand_file_name and
979 Funhandled_file_name_directory might call a file name handling
980 function. The argument list is protected by the caller, so all
981 we really have to worry about is buffer. */
983 struct gcpro gcpro1
, gcpro2
;
985 current_dir
= current_buffer
->directory
;
987 GCPRO2 (buffer
, current_dir
);
990 expand_and_dir_to_file
991 (Funhandled_file_name_directory (current_dir
), Qnil
);
992 if (NILP (Ffile_accessible_directory_p (current_dir
)))
993 report_file_error ("Setting current directory",
994 Fcons (current_buffer
->directory
, Qnil
));
1000 CHECK_STRING (name
, 0);
1004 CHECK_STRING (program
, 2);
1007 /* Make a one member argv with all args concatenated
1008 together separated by a blank. */
1009 len
= XSTRING (program
)->size
+ 2;
1010 for (i
= 3; i
< nargs
; i
++)
1013 CHECK_STRING (tem
, i
);
1014 len
+= XSTRING (tem
)->size
+ 1; /* count the blank */
1016 new_argv
= (unsigned char *) alloca (len
);
1017 strcpy (new_argv
, XSTRING (program
)->data
);
1018 for (i
= 3; i
< nargs
; i
++)
1021 CHECK_STRING (tem
, i
);
1022 strcat (new_argv
, " ");
1023 strcat (new_argv
, XSTRING (tem
)->data
);
1025 /* Need to add code here to check for program existence on VMS */
1028 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1030 for (i
= 3; i
< nargs
; i
++)
1033 CHECK_STRING (tem
, i
);
1034 new_argv
[i
- 2] = XSTRING (tem
)->data
;
1036 new_argv
[i
- 2] = 0;
1037 new_argv
[0] = XSTRING (program
)->data
;
1039 /* If program file name is not absolute, search our path for it */
1040 if (new_argv
[0][0] != '/')
1043 openp (Vexec_path
, program
, EXEC_SUFFIXES
, &tem
, 1);
1045 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1046 new_argv
[0] = XSTRING (tem
)->data
;
1048 #endif /* not VMS */
1050 proc
= make_process (name
);
1051 /* If an error occurs and we can't start the process, we want to
1052 remove it from the process list. This means that each error
1053 check in create_process doesn't need to call remove_process
1054 itself; it's all taken care of here. */
1055 record_unwind_protect (start_process_unwind
, proc
);
1057 XPROCESS (proc
)->childp
= Qt
;
1058 XPROCESS (proc
)->command_channel_p
= Qnil
;
1059 XPROCESS (proc
)->buffer
= buffer
;
1060 XPROCESS (proc
)->sentinel
= Qnil
;
1061 XPROCESS (proc
)->filter
= Qnil
;
1062 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1064 create_process (proc
, new_argv
, current_dir
);
1066 return unbind_to (count
, proc
);
1069 /* This function is the unwind_protect form for Fstart_process. If
1070 PROC doesn't have its pid set, then we know someone has signalled
1071 an error and the process wasn't started successfully, so we should
1072 remove it from the process list. */
1074 start_process_unwind (proc
)
1077 if (XTYPE (proc
) != Lisp_Process
)
1080 /* Was PROC started successfully? */
1081 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1082 remove_process (proc
);
1089 create_process_1 (signo
)
1093 /* USG systems forget handlers when they are used;
1094 must reestablish each time */
1095 signal (signo
, create_process_1
);
1099 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1102 /* Mimic blocking of signals on system V, which doesn't really have it. */
1104 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1105 int sigchld_deferred
;
1108 create_process_sigchld ()
1110 signal (SIGCHLD
, create_process_sigchld
);
1112 sigchld_deferred
= 1;
1118 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1119 create_process (process
, new_argv
, current_dir
)
1120 Lisp_Object process
;
1122 Lisp_Object current_dir
;
1124 int pid
, inchannel
, outchannel
, forkin
, forkout
;
1127 SIGTYPE (*sigchld
)();
1130 extern char **environ
;
1132 inchannel
= outchannel
= -1;
1135 if (EQ (Vprocess_connection_type
, Qt
))
1136 outchannel
= inchannel
= allocate_pty ();
1141 /* On USG systems it does not work to open the pty's tty here
1142 and then close and reopen it in the child. */
1144 /* Don't let this terminal become our controlling terminal
1145 (in case we don't have one). */
1146 forkout
= forkin
= open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1148 forkout
= forkin
= open (pty_name
, O_RDWR
, 0);
1151 report_file_error ("Opening pty", Qnil
);
1153 forkin
= forkout
= -1;
1154 #endif /* not USG */
1158 #endif /* HAVE_PTYS */
1161 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1162 report_file_error ("Opening socketpair", Qnil
);
1163 outchannel
= inchannel
= sv
[0];
1164 forkout
= forkin
= sv
[1];
1166 #else /* not SKTPAIR */
1175 #endif /* not SKTPAIR */
1178 /* Replaced by close_process_descs */
1179 set_exclusive_use (inchannel
);
1180 set_exclusive_use (outchannel
);
1183 /* Stride people say it's a mystery why this is needed
1184 as well as the O_NDELAY, but that it fails without this. */
1185 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1188 ioctl (inchannel
, FIONBIO
, &one
);
1193 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1196 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1200 /* Record this as an active process, with its channels.
1201 As a result, child_setup will close Emacs's side of the pipes. */
1202 chan_process
[inchannel
] = process
;
1203 XFASTINT (XPROCESS (process
)->infd
) = inchannel
;
1204 XFASTINT (XPROCESS (process
)->outfd
) = outchannel
;
1205 /* Record the tty descriptor used in the subprocess. */
1207 XPROCESS (process
)->subtty
= Qnil
;
1209 XFASTINT (XPROCESS (process
)->subtty
) = forkin
;
1210 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1211 XPROCESS (process
)->status
= Qrun
;
1213 /* Delay interrupts until we have a chance to store
1214 the new fork's pid in its process structure */
1218 #else /* not BSD4_1 */
1219 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1220 sigsetmask (sigmask (SIGCHLD
));
1221 #else /* ordinary USG */
1223 sigchld_deferred
= 0;
1224 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1226 #endif /* ordinary USG */
1227 #endif /* not BSD4_1 */
1228 #endif /* SIGCHLD */
1230 /* Until we store the proper pid, enable sigchld_handler
1231 to recognize an unknown pid as standing for this process.
1232 It is very important not to let this `marker' value stay
1233 in the table after this function has returned; if it does
1234 it might cause call-process to hang and subsequent asynchronous
1235 processes to get their return values scrambled. */
1236 XSETINT (XPROCESS (process
)->pid
, -1);
1239 /* child_setup must clobber environ on systems with true vfork.
1240 Protect it from permanent change. */
1241 char **save_environ
= environ
;
1246 int xforkin
= forkin
;
1247 int xforkout
= forkout
;
1249 #if 0 /* This was probably a mistake--it duplicates code later on,
1250 but fails to handle all the cases. */
1251 /* Make sure SIGCHLD is not blocked in the child. */
1252 sigsetmask (SIGEMPTYMASK
);
1255 /* Make the pty be the controlling terminal of the process. */
1257 /* First, disconnect its current controlling terminal. */
1261 /* Make the pty's terminal the controlling terminal. */
1263 /* We ignore the return value
1264 because faith@cs.unc.edu says that is necessary on Linux. */
1265 ioctl (xforkin
, TIOCSCTTY
, 0);
1267 #else /* not HAVE_SETSID */
1268 #if defined (USG) && !defined (IRIX)
1269 /* It's very important to call setpgrp() here and no time
1270 afterwards. Otherwise, we lose our controlling tty which
1271 is set when we open the pty. */
1274 #endif /* not HAVE_SETSID */
1276 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1277 can do TIOCSPGRP only to the process's controlling tty. */
1280 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1281 I can't test it since I don't have 4.3. */
1282 int j
= open ("/dev/tty", O_RDWR
, 0);
1283 ioctl (j
, TIOCNOTTY
, 0);
1286 /* In order to get a controlling terminal on some versions
1287 of BSD, it is necessary to put the process in pgrp 0
1288 before it opens the terminal. */
1292 #endif /* TIOCNOTTY */
1294 #if !defined (RTU) && !defined (UNIPLUS)
1295 /*** There is a suggestion that this ought to be a
1296 conditional on TIOCSPGRP. */
1297 /* Now close the pty (if we had it open) and reopen it.
1298 This makes the pty the controlling terminal of the subprocess. */
1301 /* I wonder if close (open (pty_name, ...)) would work? */
1304 xforkout
= xforkin
= open (pty_name
, O_RDWR
, 0);
1309 #endif /* not UNIPLUS and not RTU */
1310 #ifdef SETUP_SLAVE_PTY
1312 #endif /* SETUP_SLAVE_PTY */
1314 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1315 Now reenable it in the child, so it will die when we want it to. */
1317 signal (SIGHUP
, SIG_DFL
);
1319 #endif /* HAVE_PTYS */
1324 #else /* not BSD4_1 */
1325 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1326 sigsetmask (SIGEMPTYMASK
);
1327 #else /* ordinary USG */
1329 signal (SIGCHLD
, sigchld
);
1331 #endif /* ordinary USG */
1332 #endif /* not BSD4_1 */
1333 #endif /* SIGCHLD */
1335 child_setup_tty (xforkout
);
1336 child_setup (xforkin
, xforkout
, xforkout
,
1337 new_argv
, 1, current_dir
);
1339 environ
= save_environ
;
1343 report_file_error ("Doing vfork", Qnil
);
1345 XFASTINT (XPROCESS (process
)->pid
) = pid
;
1347 FD_SET (inchannel
, &input_wait_mask
);
1349 /* If the subfork execv fails, and it exits,
1350 this close hangs. I don't know why.
1351 So have an interrupt jar it loose. */
1353 signal (SIGALRM
, create_process_1
);
1356 /* OK to close only if it's not a pty. Otherwise we need to leave
1357 it open for ioctl to get pgrp when signals are sent, or to send
1358 the interrupt characters through if that's how we're signalling
1359 subprocesses. Alternately if you are concerned about running out
1360 of file descriptors, you could just save the tty name and open
1361 just to do the ioctl. */
1362 if (NILP (XFASTINT (XPROCESS (process
)->pty_flag
)))
1365 XPROCESS (process
)->subtty
= Qnil
;
1371 if (forkin
!= forkout
&& forkout
>= 0)
1377 #else /* not BSD4_1 */
1378 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1379 sigsetmask (SIGEMPTYMASK
);
1380 #else /* ordinary USG */
1382 signal (SIGCHLD
, sigchld
);
1383 /* Now really handle any of these signals
1384 that came in during this function. */
1385 if (sigchld_deferred
)
1386 kill (getpid (), SIGCHLD
);
1388 #endif /* ordinary USG */
1389 #endif /* not BSD4_1 */
1390 #endif /* SIGCHLD */
1392 #endif /* not VMS */
1396 /* open a TCP network connection to a given HOST/SERVICE. Treated
1397 exactly like a normal process when reading and writing. Only
1398 differences are in status display and process deletion. A network
1399 connection has no PID; you cannot signal it. All you can do is
1400 deactivate and close it via delete-process */
1402 DEFUN ("open-network-stream", Fopen_network_stream
, Sopen_network_stream
,
1404 "Open a TCP connection for a service to a host.\n\
1405 Returns a subprocess-object to represent the connection.\n\
1406 Input and output work as for subprocesses; `delete-process' closes it.\n\
1407 Args are NAME BUFFER HOST SERVICE.\n\
1408 NAME is name for process. It is modified if necessary to make it unique.\n\
1409 BUFFER is the buffer (or buffer-name) to associate with the process.\n\
1410 Process output goes at end of that buffer, unless you specify\n\
1411 an output stream or filter function to handle the output.\n\
1412 BUFFER may be also nil, meaning that this process is not associated\n\
1414 Third arg is name of the host to connect to, or its IP address.\n\
1415 Fourth arg SERVICE is name of the service desired, or an integer\n\
1416 specifying a port number to connect to.")
1417 (name
, buffer
, host
, service
)
1418 Lisp_Object name
, buffer
, host
, service
;
1422 struct sockaddr_in address
;
1423 struct servent
*svc_info
;
1424 struct hostent
*host_info_ptr
, host_info
;
1425 char *(addr_list
[2]);
1426 unsigned long numeric_addr
;
1430 struct hostent host_info_fixed
;
1431 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1433 GCPRO4 (name
, buffer
, host
, service
);
1434 CHECK_STRING (name
, 0);
1435 CHECK_STRING (host
, 0);
1436 if (XTYPE(service
) == Lisp_Int
)
1437 port
= htons ((unsigned short) XINT (service
));
1440 CHECK_STRING (service
, 0);
1441 svc_info
= getservbyname (XSTRING (service
)->data
, "tcp");
1443 error ("Unknown service \"%s\"", XSTRING (service
)->data
);
1444 port
= svc_info
->s_port
;
1447 host_info_ptr
= gethostbyname (XSTRING (host
)->data
);
1448 if (host_info_ptr
== 0)
1449 /* Attempt to interpret host as numeric inet address */
1451 numeric_addr
= inet_addr (XSTRING (host
)->data
);
1452 if (numeric_addr
== -1)
1453 error ("Unknown host \"%s\"", XSTRING (host
)->data
);
1455 host_info_ptr
= &host_info
;
1456 host_info
.h_name
= 0;
1457 host_info
.h_aliases
= 0;
1458 host_info
.h_addrtype
= AF_INET
;
1460 /* Older machines have only one address slot called h_addr.
1461 Newer machines have h_addr_list, but #define h_addr to
1462 be its first element. */
1463 host_info
.h_addr_list
= &(addr_list
[0]);
1465 host_info
.h_addr
= (char*)(&numeric_addr
);
1467 host_info
.h_length
= strlen (addr_list
[0]);
1470 bzero (&address
, sizeof address
);
1471 bcopy (host_info_ptr
->h_addr
, (char *) &address
.sin_addr
,
1472 host_info_ptr
->h_length
);
1473 address
.sin_family
= host_info_ptr
->h_addrtype
;
1474 address
.sin_port
= port
;
1476 s
= socket (host_info_ptr
->h_addrtype
, SOCK_STREAM
, 0);
1478 report_file_error ("error creating socket", Fcons (name
, Qnil
));
1481 if (connect (s
, (struct sockaddr
*) &address
, sizeof address
) == -1)
1488 report_file_error ("connection failed",
1489 Fcons (host
, Fcons (name
, Qnil
)));
1495 report_file_error ("error duplicating socket", Fcons (name
, Qnil
));
1498 buffer
= Fget_buffer_create (buffer
);
1499 proc
= make_process (name
);
1501 chan_process
[inch
] = proc
;
1504 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
1507 fcntl (inch
, F_SETFL
, O_NDELAY
);
1511 XPROCESS (proc
)->childp
= host
;
1512 XPROCESS (proc
)->command_channel_p
= Qnil
;
1513 XPROCESS (proc
)->buffer
= buffer
;
1514 XPROCESS (proc
)->sentinel
= Qnil
;
1515 XPROCESS (proc
)->filter
= Qnil
;
1516 XPROCESS (proc
)->command
= Qnil
;
1517 XPROCESS (proc
)->pid
= Qnil
;
1518 XFASTINT (XPROCESS (proc
)->infd
) = s
;
1519 XFASTINT (XPROCESS (proc
)->outfd
) = outch
;
1520 XPROCESS (proc
)->status
= Qrun
;
1521 FD_SET (inch
, &input_wait_mask
);
1526 #endif /* HAVE_SOCKETS */
1528 deactivate_process (proc
)
1531 register int inchannel
, outchannel
;
1532 register struct Lisp_Process
*p
= XPROCESS (proc
);
1534 inchannel
= XFASTINT (p
->infd
);
1535 outchannel
= XFASTINT (p
->outfd
);
1539 /* Beware SIGCHLD hereabouts. */
1540 flush_pending_output (inchannel
);
1543 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
1544 sys$
dassgn (outchannel
);
1545 vs
= get_vms_process_pointer (p
->pid
);
1547 give_back_vms_process_stuff (vs
);
1551 if (outchannel
&& outchannel
!= inchannel
)
1555 XFASTINT (p
->infd
) = 0;
1556 XFASTINT (p
->outfd
) = 0;
1557 chan_process
[inchannel
] = Qnil
;
1558 FD_CLR (inchannel
, &input_wait_mask
);
1562 /* Close all descriptors currently in use for communication
1563 with subprocess. This is used in a newly-forked subprocess
1564 to get rid of irrelevant descriptors. */
1566 close_process_descs ()
1569 for (i
= 0; i
< MAXDESC
; i
++)
1571 Lisp_Object process
;
1572 process
= chan_process
[i
];
1573 if (!NILP (process
))
1575 int in
= XFASTINT (XPROCESS (process
)->infd
);
1576 int out
= XFASTINT (XPROCESS (process
)->outfd
);
1579 if (out
&& in
!= out
)
1585 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
1587 "Allow any pending output from subprocesses to be read by Emacs.\n\
1588 It is read into the process' buffers or given to their filter functions.\n\
1589 Non-nil arg PROCESS means do not return until some output has been received\n\
1591 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\
1592 seconds and microseconds to wait; return after that much time whether\n\
1593 or not there is input.\n\
1594 Return non-nil iff we received any output before the timeout expired.")
1595 (proc
, timeout
, timeout_msecs
)
1596 register Lisp_Object proc
, timeout
, timeout_msecs
;
1601 if (! NILP (timeout_msecs
))
1603 CHECK_NUMBER (timeout_msecs
, 2);
1604 useconds
= XINT (timeout_msecs
);
1605 if (XTYPE (timeout
) != Lisp_Int
)
1606 XSET (timeout
, Lisp_Int
, 0);
1609 int carry
= useconds
/ 1000000;
1611 XSETINT (timeout
, XINT (timeout
) + carry
);
1612 useconds
-= carry
* 1000000;
1614 /* I think this clause is necessary because C doesn't
1615 guarantee a particular rounding direction for negative
1619 XSETINT (timeout
, XINT (timeout
) - 1);
1620 useconds
+= 1000000;
1627 if (! NILP (timeout
))
1629 CHECK_NUMBER (timeout
, 1);
1630 seconds
= XINT (timeout
);
1643 XFASTINT (proc
) = 0;
1646 (wait_reading_process_input (seconds
, useconds
, proc
, 0)
1650 /* This variable is different from waiting_for_input in keyboard.c.
1651 It is used to communicate to a lisp process-filter/sentinel (via the
1652 function Fwaiting_for_user_input_p below) whether emacs was waiting
1653 for user-input when that process-filter was called.
1654 waiting_for_input cannot be used as that is by definition 0 when
1655 lisp code is being evalled */
1656 static int waiting_for_user_input_p
;
1658 /* Read and dispose of subprocess output while waiting for timeout to
1659 elapse and/or keyboard input to be available.
1662 timeout in seconds, or
1663 zero for no limit, or
1664 -1 means gobble data immediately available but don't wait for any.
1667 an additional duration to wait (if time_limit is greater than
1668 zero), specified in millisec.
1670 read_kbd is a lisp value:
1671 0 to ignore keyboard input, or
1672 1 to return when input is available, or
1673 -1 meaning caller will actually read the input, so don't throw to
1674 the quit handler, or
1675 a cons cell, meaning wait wait until its car is non-nil, or
1676 a process object, meaning wait until something arrives from that
1677 process. The return value is true iff we read some input from
1680 do_display != 0 means redisplay should be done to show subprocess
1681 output that arrives.
1683 If read_kbd is a pointer to a struct Lisp_Process, then the
1684 function returns true iff we received input from that process
1685 before the timeout elapsed.
1686 Otherwise, return true iff we received input from any process. */
1688 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
1689 int time_limit
, microsecs
;
1690 Lisp_Object read_kbd
;
1693 register int channel
, nfds
, m
;
1694 static SELECT_TYPE Available
;
1697 EMACS_TIME timeout
, end_time
, garbage
;
1699 int wait_channel
= 0;
1700 struct Lisp_Process
*wait_proc
= 0;
1701 int got_some_input
= 0;
1702 Lisp_Object
*wait_for_cell
= 0;
1704 FD_ZERO (&Available
);
1706 /* If read_kbd is a process to watch, set wait_proc and wait_channel
1708 if (XTYPE (read_kbd
) == Lisp_Process
)
1710 wait_proc
= XPROCESS (read_kbd
);
1711 wait_channel
= XFASTINT (wait_proc
->infd
);
1712 XFASTINT (read_kbd
) = 0;
1715 /* If waiting for non-nil in a cell, record where. */
1716 if (XTYPE (read_kbd
) == Lisp_Cons
)
1718 wait_for_cell
= &XCONS (read_kbd
)->car
;
1719 XFASTINT (read_kbd
) = 0;
1722 waiting_for_user_input_p
= XINT (read_kbd
);
1724 /* Since we may need to wait several times,
1725 compute the absolute time to return at. */
1726 if (time_limit
|| microsecs
)
1728 EMACS_GET_TIME (end_time
);
1729 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
1730 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
1735 /* If calling from keyboard input, do not quit
1736 since we want to return C-g as an input character.
1737 Otherwise, do pending quit if requested. */
1738 if (XINT (read_kbd
) >= 0)
1741 /* Compute time from now till when time limit is up */
1742 /* Exit if already run out */
1743 if (time_limit
== -1)
1745 /* -1 specified for timeout means
1746 gobble output available now
1747 but don't wait at all. */
1749 EMACS_SET_SECS_USECS (timeout
, 0, 0);
1751 else if (time_limit
|| microsecs
)
1753 EMACS_GET_TIME (timeout
);
1754 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
1755 if (EMACS_TIME_NEG_P (timeout
))
1760 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
1763 /* Cause C-g and alarm signals to take immediate action,
1764 and cause input available signals to zero out timeout.
1766 It is important that we do this before checking for process
1767 activity. If we get a SIGCHLD after the explicit checks for
1768 process activity, timeout is the only way we will know. */
1769 if (XINT (read_kbd
) < 0)
1770 set_waiting_for_input (&timeout
);
1772 /* If status of something has changed, and no input is
1773 available, notify the user of the change right away. After
1774 this explicit check, we'll let the SIGCHLD handler zap
1775 timeout to get our attention. */
1776 if (update_tick
!= process_tick
&& do_display
)
1778 Atemp
= input_wait_mask
;
1779 EMACS_SET_SECS_USECS (timeout
, 0, 0);
1780 if (select (MAXDESC
, &Atemp
, 0, 0, &timeout
) <= 0)
1782 /* It's okay for us to do this and then continue with
1783 the loop, since timeout has already been zeroed out. */
1784 clear_waiting_for_input ();
1789 /* Don't wait for output from a non-running process. */
1790 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
1791 update_status (wait_proc
);
1793 && ! EQ (wait_proc
->status
, Qrun
))
1795 clear_waiting_for_input ();
1799 /* Wait till there is something to do */
1801 Available
= input_wait_mask
;
1802 if (! XINT (read_kbd
))
1803 FD_CLR (0, &Available
);
1805 /* If frame size has changed or the window is newly mapped,
1806 redisplay now, before we start to wait. There is a race
1807 condition here; if a SIGIO arrives between now and the select
1808 and indicates that a frame is trashed, the select may block
1809 displaying a trashed screen. */
1811 redisplay_preserve_echo_area ();
1813 if (XINT (read_kbd
) && detect_input_pending ())
1816 nfds
= select (MAXDESC
, &Available
, 0, 0, &timeout
);
1820 /* Make C-g and alarm signals set flags again */
1821 clear_waiting_for_input ();
1823 /* If we woke up due to SIGWINCH, actually change size now. */
1824 do_pending_window_change ();
1826 if (time_limit
&& nfds
== 0) /* timeout elapsed */
1830 if (xerrno
== EINTR
)
1831 FD_ZERO (&Available
);
1833 /* Ultrix select seems to return ENOMEM when it is
1834 interrupted. Treat it just like EINTR. Bleah. Note
1835 that we want to test for the "ultrix" CPP symbol, not
1836 "__ultrix__"; the latter is only defined under GCC, but
1837 not by DEC's bundled CC. -JimB */
1838 else if (xerrno
== ENOMEM
)
1839 FD_ZERO (&Available
);
1842 /* This happens for no known reason on ALLIANT.
1843 I am guessing that this is the right response. -- RMS. */
1844 else if (xerrno
== EFAULT
)
1845 FD_ZERO (&Available
);
1847 else if (xerrno
== EBADF
)
1850 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
1851 the child's closure of the pts gives the parent a SIGHUP, and
1852 the ptc file descriptor is automatically closed,
1853 yielding EBADF here or at select() call above.
1854 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
1855 in m-ibmrt-aix.h), and here we just ignore the select error.
1856 Cleanup occurs c/o status_notify after SIGCLD. */
1857 FD_ZERO (&Available
); /* Cannot depend on values returned */
1863 error("select error: %s", sys_errlist
[xerrno
]);
1865 #if defined(sun) && !defined(USG5_4)
1866 else if (nfds
> 0 && FD_ISSET (0, &Available
) && interrupt_input
)
1867 /* System sometimes fails to deliver SIGIO.
1869 David J. Mackenzie says that Emacs doesn't compile under
1870 Solaris if this code is enabled, thus the USG5_4 in the CPP
1871 conditional. "I haven't noticed any ill effects so far.
1872 If you find a Solaris expert somewhere, they might know
1874 kill (getpid (), SIGIO
);
1877 /* Check for keyboard input */
1878 /* If there is any, return immediately
1879 to give it higher priority than subprocesses */
1881 if (XINT (read_kbd
) && detect_input_pending ())
1884 if (detect_input_pending ())
1888 /* Exit now if the cell we're waiting for became non-nil. */
1889 if (wait_for_cell
&& ! NILP (*wait_for_cell
))
1893 /* If we think we have keyboard input waiting, but didn't get SIGIO
1894 go read it. This can happen with X on BSD after logging out.
1895 In that case, there really is no input and no SIGIO,
1896 but select says there is input. */
1898 if (XINT (read_kbd
) && interrupt_input
&& (FD_ISSET (fileno (stdin
), &Available
)))
1903 got_some_input
|= nfds
> 0;
1905 /* If checking input just got us a size-change event from X,
1906 obey it now if we should. */
1907 if (XINT (read_kbd
))
1908 do_pending_window_change ();
1910 /* Check for data from a process or a command channel */
1911 for (channel
= FIRST_PROC_DESC
; channel
< MAXDESC
; channel
++)
1913 if (FD_ISSET (channel
, &Available
))
1917 /* If waiting for this channel, arrange to return as
1918 soon as no more input to be processed. No more
1920 if (wait_channel
== channel
)
1926 proc
= chan_process
[channel
];
1930 /* Read data from the process, starting with our
1931 buffered-ahead character if we have one. */
1933 nread
= read_process_output (proc
, channel
);
1936 /* Since read_process_output can run a filter,
1937 which can call accept-process-output,
1938 don't try to read from any other processes
1939 before doing the select again. */
1940 FD_ZERO (&Available
);
1943 redisplay_preserve_echo_area ();
1946 else if (nread
== -1 && errno
== EWOULDBLOCK
)
1950 else if (nread
== -1 && errno
== EAGAIN
)
1954 else if (nread
== -1 && errno
== EAGAIN
)
1956 /* Note that we cannot distinguish between no input
1957 available now and a closed pipe.
1958 With luck, a closed pipe will be accompanied by
1959 subprocess termination and SIGCHLD. */
1960 else if (nread
== 0 && !NETCONN_P (proc
))
1962 #endif /* O_NDELAY */
1963 #endif /* O_NONBLOCK */
1964 #endif /* EWOULDBLOCK */
1966 /* On some OSs with ptys, when the process on one end of
1967 a pty exits, the other end gets an error reading with
1968 errno = EIO instead of getting an EOF (0 bytes read).
1969 Therefore, if we get an error reading and errno =
1970 EIO, just continue, because the child process has
1971 exited and should clean itself up soon (e.g. when we
1973 else if (nread
== -1 && errno
== EIO
)
1975 #endif /* HAVE_PTYS */
1976 /* If we can detect process termination, don't consider the process
1977 gone just because its pipe is closed. */
1979 else if (nread
== 0 && !NETCONN_P (proc
))
1984 /* Preserve status of processes already terminated. */
1985 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
1986 deactivate_process (proc
);
1987 if (!NILP (XPROCESS (proc
)->raw_status_low
))
1988 update_status (XPROCESS (proc
));
1989 if (EQ (XPROCESS (proc
)->status
, Qrun
))
1990 XPROCESS (proc
)->status
1991 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
1994 } /* end for each file descriptor */
1995 } /* end while exit conditions not met */
1997 /* If calling from keyboard input, do not quit
1998 since we want to return C-g as an input character.
1999 Otherwise, do pending quit if requested. */
2000 if (XINT (read_kbd
) >= 0)
2002 /* Prevent input_pending from remaining set if we quit. */
2003 clear_input_pending ();
2007 return got_some_input
;
2010 /* Read pending output from the process channel,
2011 starting with our buffered-ahead character if we have one.
2012 Yield number of characters read.
2014 This function reads at most 1024 characters.
2015 If you want to read all available subprocess output,
2016 you must call it repeatedly until it returns zero. */
2018 read_process_output (proc
, channel
)
2020 register int channel
;
2022 register int nchars
;
2028 register Lisp_Object outstream
;
2029 register struct buffer
*old
= current_buffer
;
2030 register struct Lisp_Process
*p
= XPROCESS (proc
);
2031 register int opoint
;
2034 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
2036 vs
= get_vms_process_pointer (p
->pid
);
2040 return(0); /* Really weird if it does this */
2041 if (!(vs
->iosb
[0] & 1))
2042 return -1; /* I/O error */
2045 error ("Could not get VMS process pointer");
2046 chars
= vs
->inputBuffer
;
2047 nchars
= clean_vms_buffer (chars
, vs
->iosb
[1]);
2050 start_vms_process_read (vs
); /* Crank up the next read on the process */
2051 return 1; /* Nothing worth printing, say we got 1 */
2055 if (proc_buffered_char
[channel
] < 0)
2056 nchars
= read (channel
, chars
, sizeof chars
);
2059 chars
[0] = proc_buffered_char
[channel
];
2060 proc_buffered_char
[channel
] = -1;
2061 nchars
= read (channel
, chars
+ 1, sizeof chars
- 1);
2065 nchars
= nchars
+ 1;
2067 #endif /* not VMS */
2069 if (nchars
<= 0) return nchars
;
2071 outstream
= p
->filter
;
2072 if (!NILP (outstream
))
2074 /* We inhibit quit here instead of just catching it so that
2075 hitting ^G when a filter happens to be running won't screw
2077 int count
= specpdl_ptr
- specpdl
;
2078 Lisp_Object odeactivate
;
2080 odeactivate
= Vdeactivate_mark
;
2082 specbind (Qinhibit_quit
, Qt
);
2083 call2 (outstream
, proc
, make_string (chars
, nchars
));
2085 /* Handling the process output should not deactivate the mark. */
2086 Vdeactivate_mark
= odeactivate
;
2089 start_vms_process_read (vs
);
2095 /* If no filter, write into buffer if it isn't dead. */
2096 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
2098 Lisp_Object old_read_only
;
2099 Lisp_Object old_begv
, old_zv
;
2100 Lisp_Object odeactivate
;
2102 odeactivate
= Vdeactivate_mark
;
2104 Fset_buffer (p
->buffer
);
2106 old_read_only
= current_buffer
->read_only
;
2107 XFASTINT (old_begv
) = BEGV
;
2108 XFASTINT (old_zv
) = ZV
;
2110 current_buffer
->read_only
= Qnil
;
2112 /* Insert new output into buffer
2113 at the current end-of-output marker,
2114 thus preserving logical ordering of input and output. */
2115 if (XMARKER (p
->mark
)->buffer
)
2116 SET_PT (marker_position (p
->mark
));
2120 /* If the output marker is outside of the visible region, save
2121 the restriction and widen. */
2122 if (! (BEGV
<= point
&& point
<= ZV
))
2125 /* Make sure opoint floats ahead of any new text, just as point
2127 if (point
<= opoint
)
2130 /* Insert after old_begv, but before old_zv. */
2131 if (point
< XFASTINT (old_begv
))
2132 XFASTINT (old_begv
) += nchars
;
2133 if (point
<= XFASTINT (old_zv
))
2134 XFASTINT (old_zv
) += nchars
;
2136 /* Insert before markers in case we are inserting where
2137 the buffer's mark is, and the user's next command is Meta-y. */
2138 insert_before_markers (chars
, nchars
);
2139 Fset_marker (p
->mark
, make_number (point
), p
->buffer
);
2141 update_mode_lines
++;
2143 /* If the restriction isn't what it should be, set it. */
2144 if (XFASTINT (old_begv
) != BEGV
|| XFASTINT (old_zv
) != ZV
)
2145 Fnarrow_to_region (old_begv
, old_zv
);
2147 /* Handling the process output should not deactivate the mark. */
2148 Vdeactivate_mark
= odeactivate
;
2150 current_buffer
->read_only
= old_read_only
;
2152 set_buffer_internal (old
);
2155 start_vms_process_read (vs
);
2160 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
2162 "Returns non-NIL if emacs is waiting for input from the user.\n\
2163 This is intended for use by asynchronous process output filters and sentinels.")
2166 return ((waiting_for_user_input_p
) ? Qt
: Qnil
);
2169 /* Sending data to subprocess */
2171 jmp_buf send_process_frame
;
2174 send_process_trap ()
2180 longjmp (send_process_frame
, 1);
2183 send_process (proc
, buf
, len
)
2188 /* Don't use register vars; longjmp can lose them. */
2190 unsigned char *procname
= XSTRING (XPROCESS (proc
)->name
)->data
;
2194 struct Lisp_Process
*p
= XPROCESS (proc
);
2195 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
2198 if (! NILP (XPROCESS (proc
)->raw_status_low
))
2199 update_status (XPROCESS (proc
));
2200 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
2201 error ("Process %s not running", procname
);
2204 vs
= get_vms_process_pointer (p
->pid
);
2206 error ("Could not find this process: %x", p
->pid
);
2207 else if (write_to_vms_process (vs
, buf
, len
))
2210 if (!setjmp (send_process_frame
))
2214 SIGTYPE (*old_sigpipe
)();
2216 /* Don't send more than 500 bytes at a time. */
2219 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
2220 rv
= write (XFASTINT (XPROCESS (proc
)->outfd
), buf
, this);
2221 signal (SIGPIPE
, old_sigpipe
);
2226 || errno
== EWOULDBLOCK
2233 /* It would be nice to accept process output here,
2234 but that is difficult. For example, it could
2235 garbage what we are sending if that is from a buffer. */
2242 report_file_error ("writing to process", Fcons (proc
, Qnil
));
2246 /* Allow input from processes between bursts of sending.
2247 Otherwise things may get stopped up. */
2252 XFASTINT (zero
) = 0;
2253 wait_reading_process_input (-1, 0, zero
, 0);
2259 XPROCESS (proc
)->raw_status_low
= Qnil
;
2260 XPROCESS (proc
)->raw_status_high
= Qnil
;
2261 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
2262 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
2263 deactivate_process (proc
);
2265 error ("Error writing to process %s; closed it", procname
);
2267 error ("SIGPIPE raised on process %s; closed it", procname
);
2272 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
2274 "Send current contents of region as input to PROCESS.\n\
2275 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2276 nil, indicating the current buffer's process.\n\
2277 Called from program, takes three arguments, PROCESS, START and END.\n\
2278 If the region is more than 500 characters long,\n\
2279 it is sent in several bunches. This may happen even for shorter regions.\n\
2280 Output from processes can arrive in between bunches.")
2281 (process
, start
, end
)
2282 Lisp_Object process
, start
, end
;
2287 proc
= get_process (process
);
2288 validate_region (&start
, &end
);
2290 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
2293 start1
= XINT (start
);
2294 send_process (proc
, &FETCH_CHAR (start1
), XINT (end
) - XINT (start
));
2299 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
2301 "Send PROCESS the contents of STRING as input.\n\
2302 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2303 nil, indicating the current buffer's process.\n\
2304 If STRING is more than 500 characters long,\n\
2305 it is sent in several bunches. This may happen even for shorter strings.\n\
2306 Output from processes can arrive in between bunches.")
2308 Lisp_Object process
, string
;
2311 CHECK_STRING (string
, 1);
2312 proc
= get_process (process
);
2313 send_process (proc
, XSTRING (string
)->data
, XSTRING (string
)->size
);
2317 /* send a signal number SIGNO to PROCESS.
2318 CURRENT_GROUP means send to the process group that currently owns
2319 the terminal being used to communicate with PROCESS.
2320 This is used for various commands in shell mode.
2321 If NOMSG is zero, insert signal-announcements into process's buffers
2324 If we can, we try to signal PROCESS by sending control characters
2325 down the pipe. This allows us to signal inferiors who have changed
2326 their uid, for which killpg would return an EPERM error. */
2329 process_send_signal (process
, signo
, current_group
, nomsg
)
2330 Lisp_Object process
;
2332 Lisp_Object current_group
;
2336 register struct Lisp_Process
*p
;
2340 proc
= get_process (process
);
2341 p
= XPROCESS (proc
);
2343 if (!EQ (p
->childp
, Qt
))
2344 error ("Process %s is not a subprocess",
2345 XSTRING (p
->name
)->data
);
2346 if (!XFASTINT (p
->infd
))
2347 error ("Process %s is not active",
2348 XSTRING (p
->name
)->data
);
2350 if (NILP (p
->pty_flag
))
2351 current_group
= Qnil
;
2353 /* If we are using pgrps, get a pgrp number and make it negative. */
2354 if (!NILP (current_group
))
2356 #ifdef SIGNALS_VIA_CHARACTERS
2357 /* If possible, send signals to the entire pgrp
2358 by sending an input character to it. */
2360 /* TERMIOS is the latest and bestest, and seems most likely to
2361 work. If the system has it, use it. */
2368 tcgetattr (XFASTINT (p
->infd
), &t
);
2369 send_process (proc
, &t
.c_cc
[VINTR
], 1);
2373 tcgetattr (XFASTINT (p
->infd
), &t
);
2374 send_process (proc
, &t
.c_cc
[VQUIT
], 1);
2378 tcgetattr (XFASTINT (p
->infd
), &t
);
2380 send_process (proc
, &t
.c_cc
[VSWTCH
], 1);
2382 send_process (proc
, &t
.c_cc
[VSUSP
], 1);
2387 #else /* ! HAVE_TERMIOS */
2389 /* On Berkeley descendants, the following IOCTL's retrieve the
2390 current control characters. */
2391 #if defined (TIOCGLTC) && defined (TIOCGETC)
2399 ioctl (XFASTINT (p
->infd
), TIOCGETC
, &c
);
2400 send_process (proc
, &c
.t_intrc
, 1);
2403 ioctl (XFASTINT (p
->infd
), TIOCGETC
, &c
);
2404 send_process (proc
, &c
.t_quitc
, 1);
2408 ioctl (XFASTINT (p
->infd
), TIOCGLTC
, &lc
);
2409 send_process (proc
, &lc
.t_suspc
, 1);
2411 #endif /* ! defined (SIGTSTP) */
2414 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
2416 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
2423 ioctl (XFASTINT (p
->infd
), TCGETA
, &t
);
2424 send_process (proc
, &t
.c_cc
[VINTR
], 1);
2427 ioctl (XFASTINT (p
->infd
), TCGETA
, &t
);
2428 send_process (proc
, &t
.c_cc
[VQUIT
], 1);
2432 ioctl (XFASTINT (p
->infd
), TCGETA
, &t
);
2433 send_process (proc
, &t
.c_cc
[VSWTCH
], 1);
2435 #endif /* ! defined (SIGTSTP) */
2437 #else /* ! defined (TCGETA) */
2438 Your configuration files are messed up
.
2439 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
2440 you'd better be using one of the alternatives above! */
2441 #endif /* ! defined (TCGETA) */
2442 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
2443 #endif /* ! defined HAVE_TERMIOS */
2444 #endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
2447 /* Get the pgrp using the tty itself, if we have that.
2448 Otherwise, use the pty to get the pgrp.
2449 On pfa systems, saka@pfu.fujitsu.co.JP writes:
2450 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
2451 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
2452 His patch indicates that if TIOCGPGRP returns an error, then
2453 we should just assume that p->pid is also the process group id. */
2457 if (!NILP (p
->subtty
))
2458 err
= ioctl (XFASTINT (p
->subtty
), TIOCGPGRP
, &gid
);
2460 err
= ioctl (XFASTINT (p
->infd
), TIOCGPGRP
, &gid
);
2464 gid
= - XFASTINT (p
->pid
);
2465 #endif /* ! defined (pfa) */
2471 #else /* ! defined (TIOCGPGRP ) */
2472 /* Can't select pgrps on this system, so we know that
2473 the child itself heads the pgrp. */
2474 gid
= - XFASTINT (p
->pid
);
2475 #endif /* ! defined (TIOCGPGRP ) */
2478 gid
= - XFASTINT (p
->pid
);
2484 p
->raw_status_low
= Qnil
;
2485 p
->raw_status_high
= Qnil
;
2487 XSETINT (p
->tick
, ++process_tick
);
2491 #endif /* ! defined (SIGCONT) */
2494 send_process (proc
, "\003", 1); /* ^C */
2499 send_process (proc
, "\031", 1); /* ^Y */
2504 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
2507 flush_pending_output (XFASTINT (p
->infd
));
2511 /* If we don't have process groups, send the signal to the immediate
2512 subprocess. That isn't really right, but it's better than any
2513 obvious alternative. */
2516 kill (XFASTINT (p
->pid
), signo
);
2520 /* gid may be a pid, or minus a pgrp's number */
2522 if (!NILP (current_group
))
2523 ioctl (XFASTINT (p
->infd
), TIOCSIGSEND
, signo
);
2526 gid
= - XFASTINT (p
->pid
);
2529 #else /* ! defined (TIOCSIGSEND) */
2530 EMACS_KILLPG (-gid
, signo
);
2531 #endif /* ! defined (TIOCSIGSEND) */
2534 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
2535 "Interrupt process PROCESS. May be process or name of one.\n\
2536 PROCESS may be a process, a buffer, or the name of a process or buffer.\n\
2537 Nil or no arg means current buffer's process.\n\
2538 Second arg CURRENT-GROUP non-nil means send signal to\n\
2539 the current process-group of the process's controlling terminal\n\
2540 rather than to the process's own process group.\n\
2541 If the process is a shell, this means interrupt current subjob\n\
2542 rather than the shell.")
2543 (process
, current_group
)
2544 Lisp_Object process
, current_group
;
2546 process_send_signal (process
, SIGINT
, current_group
, 0);
2550 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
2551 "Kill process PROCESS. May be process or name of one.\n\
2552 See function `interrupt-process' for more details on usage.")
2553 (process
, current_group
)
2554 Lisp_Object process
, current_group
;
2556 process_send_signal (process
, SIGKILL
, current_group
, 0);
2560 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
2561 "Send QUIT signal to process PROCESS. May be process or name of one.\n\
2562 See function `interrupt-process' for more details on usage.")
2563 (process
, current_group
)
2564 Lisp_Object process
, current_group
;
2566 process_send_signal (process
, SIGQUIT
, current_group
, 0);
2570 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
2571 "Stop process PROCESS. May be process or name of one.\n\
2572 See function `interrupt-process' for more details on usage.")
2573 (process
, current_group
)
2574 Lisp_Object process
, current_group
;
2577 error ("no SIGTSTP support");
2579 process_send_signal (process
, SIGTSTP
, current_group
, 0);
2584 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
2585 "Continue process PROCESS. May be process or name of one.\n\
2586 See function `interrupt-process' for more details on usage.")
2587 (process
, current_group
)
2588 Lisp_Object process
, current_group
;
2591 process_send_signal (process
, SIGCONT
, current_group
, 0);
2593 error ("no SIGCONT support");
2598 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
2599 2, 2, "nProcess number: \nnSignal code: ",
2600 "Send the process with number PID the signal with code CODE.\n\
2601 Both PID and CODE are integers.")
2603 Lisp_Object pid
, sig
;
2605 CHECK_NUMBER (pid
, 0);
2606 CHECK_NUMBER (sig
, 1);
2607 return make_number (kill (XINT (pid
), XINT (sig
)));
2610 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
2611 "Make PROCESS see end-of-file in its input.\n\
2612 Eof comes after any text already sent to it.\n\
2613 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2614 nil, indicating the current buffer's process.")
2616 Lisp_Object process
;
2620 proc
= get_process (process
);
2622 /* Make sure the process is really alive. */
2623 if (! NILP (XPROCESS (proc
)->raw_status_low
))
2624 update_status (XPROCESS (proc
));
2625 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
2626 error ("Process %s not running", XSTRING (XPROCESS (proc
)->name
)->data
);
2628 /* Sending a zero-length record is supposed to mean eof
2629 when TIOCREMOTE is turned on. */
2633 write (XFASTINT (XPROCESS (proc
)->outfd
), buf
, 0);
2635 #else /* did not do TOICREMOTE */
2637 send_process (proc
, "\032", 1); /* ^z */
2639 if (!NILP (XPROCESS (proc
)->pty_flag
))
2640 send_process (proc
, "\004", 1);
2643 close (XPROCESS (proc
)->outfd
);
2644 XFASTINT (XPROCESS (proc
)->outfd
) = open (NULL_DEVICE
, O_WRONLY
);
2647 #endif /* did not do TOICREMOTE */
2651 /* Kill all processes associated with `buffer'.
2652 If `buffer' is nil, kill all processes */
2654 kill_buffer_processes (buffer
)
2657 Lisp_Object tail
, proc
;
2659 for (tail
= Vprocess_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2660 tail
= XCONS (tail
)->cdr
)
2662 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
2663 if (XGCTYPE (proc
) == Lisp_Process
2664 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
2666 if (NETCONN_P (proc
))
2667 deactivate_process (proc
);
2668 else if (XFASTINT (XPROCESS (proc
)->infd
))
2669 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
2674 /* On receipt of a signal that a child status has changed,
2675 loop asking about children with changed statuses until
2676 the system says there are no more.
2677 All we do is change the status;
2678 we do not run sentinels or print notifications.
2679 That is saved for the next time keyboard input is done,
2680 in order to avoid timing errors. */
2682 /** WARNING: this can be called during garbage collection.
2683 Therefore, it must not be fooled by the presence of mark bits in
2686 /** USG WARNING: Although it is not obvious from the documentation
2687 in signal(2), on a USG system the SIGCLD handler MUST NOT call
2688 signal() before executing at least one wait(), otherwise the handler
2689 will be called again, resulting in an infinite loop. The relevant
2690 portion of the documentation reads "SIGCLD signals will be queued
2691 and the signal-catching function will be continually reentered until
2692 the queue is empty". Invoking signal() causes the kernel to reexamine
2693 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
2696 sigchld_handler (signo
)
2699 int old_errno
= errno
;
2701 register struct Lisp_Process
*p
;
2702 extern EMACS_TIME
*input_available_clear_time
;
2706 sigheld
|= sigbit (SIGCHLD
);
2718 #endif /* no WUNTRACED */
2719 /* Keep trying to get a status until we get a definitive result. */
2723 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
2725 while (pid
<= 0 && errno
== EINTR
);
2729 /* A real failure. We have done all our job, so return. */
2731 /* USG systems forget handlers when they are used;
2732 must reestablish each time */
2734 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
2737 sigheld
&= ~sigbit (SIGCHLD
);
2745 #endif /* no WNOHANG */
2747 /* Find the process that signaled us, and record its status. */
2750 for (tail
= Vprocess_alist
; XSYMBOL (tail
) != XSYMBOL (Qnil
); tail
= XCONS (tail
)->cdr
)
2752 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
2753 p
= XPROCESS (proc
);
2754 if (EQ (p
->childp
, Qt
) && XFASTINT (p
->pid
) == pid
)
2759 /* Look for an asynchronous process whose pid hasn't been filled
2762 for (tail
= Vprocess_alist
; XSYMBOL (tail
) != XSYMBOL (Qnil
); tail
= XCONS (tail
)->cdr
)
2764 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
2765 p
= XPROCESS (proc
);
2766 if (XTYPE (p
->pid
) == Lisp_Int
&& XINT (p
->pid
) == -1)
2771 /* Change the status of the process that was found. */
2774 union { int i
; WAITTYPE wt
; } u
;
2776 XSETINT (p
->tick
, ++process_tick
);
2778 XFASTINT (p
->raw_status_low
) = u
.i
& 0xffff;
2779 XFASTINT (p
->raw_status_high
) = u
.i
>> 16;
2781 /* If process has terminated, stop waiting for its output. */
2782 if (WIFSIGNALED (w
) || WIFEXITED (w
))
2783 if (XFASTINT (p
->infd
))
2784 FD_CLR (XFASTINT (p
->infd
), &input_wait_mask
);
2786 /* Tell wait_reading_process_input that it needs to wake up and
2788 if (input_available_clear_time
)
2789 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
2792 /* There was no asynchronous process found for that id. Check
2793 if we have a synchronous process. */
2796 synch_process_alive
= 0;
2798 /* Report the status of the synchronous process. */
2800 synch_process_retcode
= WRETCODE (w
);
2801 else if (WIFSIGNALED (w
))
2803 synch_process_death
= (char *) sys_siglist
[WTERMSIG (w
)];
2805 synch_process_death
= sys_errlist
[WTERMSIG (w
)];
2808 /* Tell wait_reading_process_input that it needs to wake up and
2810 if (input_available_clear_time
)
2811 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
2814 /* On some systems, we must return right away.
2815 If any more processes want to signal us, we will
2817 Otherwise (on systems that have WNOHANG), loop around
2818 to use up all the processes that have something to tell us. */
2819 #if defined (USG) && ! (defined (HPUX) && defined (WNOHANG))
2821 signal (signo
, sigchld_handler
);
2825 #endif /* USG, but not HPUX with WNOHANG */
2831 exec_sentinel_unwind (data
)
2834 XPROCESS (XCONS (data
)->car
)->sentinel
= XCONS (data
)->cdr
;
2839 exec_sentinel (proc
, reason
)
2840 Lisp_Object proc
, reason
;
2842 Lisp_Object sentinel
;
2843 register struct Lisp_Process
*p
= XPROCESS (proc
);
2844 int count
= specpdl_ptr
- specpdl
;
2846 sentinel
= p
->sentinel
;
2847 if (NILP (sentinel
))
2850 /* Zilch the sentinel while it's running, to avoid recursive invocations;
2851 assure that it gets restored no matter how the sentinel exits. */
2853 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
2854 /* Inhibit quit so that random quits don't screw up a running filter. */
2855 specbind (Qinhibit_quit
, Qt
);
2856 call2 (sentinel
, proc
, reason
);
2860 /* Report all recent events of a change in process status
2861 (either run the sentinel or output a message).
2862 This is done while Emacs is waiting for keyboard input. */
2866 register Lisp_Object proc
, buffer
;
2867 Lisp_Object tail
= Qnil
;
2868 Lisp_Object msg
= Qnil
;
2869 struct gcpro gcpro1
, gcpro2
;
2871 /* We need to gcpro tail; if read_process_output calls a filter
2872 which deletes a process and removes the cons to which tail points
2873 from Vprocess_alist, and then causes a GC, tail is an unprotected
2877 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
2880 register struct Lisp_Process
*p
;
2882 proc
= Fcdr (Fcar (tail
));
2883 p
= XPROCESS (proc
);
2885 if (XINT (p
->tick
) != XINT (p
->update_tick
))
2887 XSETINT (p
->update_tick
, XINT (p
->tick
));
2889 /* If process is still active, read any output that remains. */
2890 if (XFASTINT (p
->infd
))
2891 while (read_process_output (proc
, XFASTINT (p
->infd
)) > 0);
2895 /* Get the text to use for the message. */
2896 if (!NILP (p
->raw_status_low
))
2898 msg
= status_message (p
->status
);
2900 /* If process is terminated, deactivate it or delete it. */
2902 if (XTYPE (p
->status
) == Lisp_Cons
)
2903 symbol
= XCONS (p
->status
)->car
;
2905 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
2906 || EQ (symbol
, Qclosed
))
2908 if (delete_exited_processes
)
2909 remove_process (proc
);
2911 deactivate_process (proc
);
2914 /* Now output the message suitably. */
2915 if (!NILP (p
->sentinel
))
2916 exec_sentinel (proc
, msg
);
2917 /* Don't bother with a message in the buffer
2918 when a process becomes runnable. */
2919 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
2921 Lisp_Object ro
= XBUFFER (buffer
)->read_only
;
2923 struct buffer
*old
= current_buffer
;
2926 /* Avoid error if buffer is deleted
2927 (probably that's why the process is dead, too) */
2928 if (NILP (XBUFFER (buffer
)->name
))
2930 Fset_buffer (buffer
);
2932 /* Insert new output into buffer
2933 at the current end-of-output marker,
2934 thus preserving logical ordering of input and output. */
2935 if (XMARKER (p
->mark
)->buffer
)
2936 SET_PT (marker_position (p
->mark
));
2939 if (point
<= opoint
)
2940 opoint
+= XSTRING (msg
)->size
+ XSTRING (p
->name
)->size
+ 10;
2942 tem
= current_buffer
->read_only
;
2943 current_buffer
->read_only
= Qnil
;
2944 insert_string ("\nProcess ");
2945 Finsert (1, &p
->name
);
2946 insert_string (" ");
2948 current_buffer
->read_only
= tem
;
2949 Fset_marker (p
->mark
, make_number (point
), p
->buffer
);
2952 set_buffer_internal (old
);
2957 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
2958 redisplay_preserve_echo_area ();
2960 update_tick
= process_tick
;
2971 if (! noninteractive
|| initialized
)
2973 signal (SIGCHLD
, sigchld_handler
);
2976 FD_ZERO (&input_wait_mask
);
2977 FD_SET (0, &input_wait_mask
);
2978 Vprocess_alist
= Qnil
;
2979 for (i
= 0; i
< MAXDESC
; i
++)
2981 chan_process
[i
] = Qnil
;
2982 proc_buffered_char
[i
] = -1;
2986 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 0, 1, 0,
2987 "Return the connection type of `PROCESS'. This can be nil (pipe),\n\
2988 t or pty (pty) or stream (socket connection).")
2990 Lisp_Object process
;
2992 return XPROCESS (process
)->type
;
2998 stream_process
= intern ("stream");
3000 Qprocessp
= intern ("processp");
3001 staticpro (&Qprocessp
);
3002 Qrun
= intern ("run");
3004 Qstop
= intern ("stop");
3006 Qsignal
= intern ("signal");
3007 staticpro (&Qsignal
);
3009 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
3012 Qexit = intern ("exit");
3013 staticpro (&Qexit); */
3015 Qopen
= intern ("open");
3017 Qclosed
= intern ("closed");
3018 staticpro (&Qclosed
);
3020 staticpro (&Vprocess_alist
);
3022 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
3023 "*Non-nil means delete processes immediately when they exit.\n\
3024 nil means don't delete them until `list-processes' is run.");
3026 delete_exited_processes
= 1;
3028 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
3029 "Control type of device used to communicate with subprocesses.\n\
3030 Values are nil to use a pipe, and t or 'pty for a pty. Note that if\n\
3031 pty's are not available, this variable will be ignored. The value takes\n\
3032 effect when `start-process' is called.");
3033 Vprocess_connection_type
= Qt
;
3035 defsubr (&Sprocessp
);
3036 defsubr (&Sget_process
);
3037 defsubr (&Sget_buffer_process
);
3038 defsubr (&Sdelete_process
);
3039 defsubr (&Sprocess_status
);
3040 defsubr (&Sprocess_exit_status
);
3041 defsubr (&Sprocess_id
);
3042 defsubr (&Sprocess_name
);
3043 defsubr (&Sprocess_command
);
3044 defsubr (&Sset_process_buffer
);
3045 defsubr (&Sprocess_buffer
);
3046 defsubr (&Sprocess_mark
);
3047 defsubr (&Sset_process_filter
);
3048 defsubr (&Sprocess_filter
);
3049 defsubr (&Sset_process_sentinel
);
3050 defsubr (&Sprocess_sentinel
);
3051 defsubr (&Sprocess_kill_without_query
);
3052 defsubr (&Slist_processes
);
3053 defsubr (&Sprocess_list
);
3054 defsubr (&Sstart_process
);
3056 defsubr (&Sopen_network_stream
);
3057 #endif /* HAVE_SOCKETS */
3058 defsubr (&Saccept_process_output
);
3059 defsubr (&Sprocess_send_region
);
3060 defsubr (&Sprocess_send_string
);
3061 defsubr (&Sinterrupt_process
);
3062 defsubr (&Skill_process
);
3063 defsubr (&Squit_process
);
3064 defsubr (&Sstop_process
);
3065 defsubr (&Scontinue_process
);
3066 defsubr (&Sprocess_send_eof
);
3067 defsubr (&Ssignal_process
);
3068 defsubr (&Swaiting_for_user_input_p
);
3069 /* defsubr (&Sprocess_connection); */
3073 #else /* not subprocesses */
3075 #include <sys/types.h>
3079 #include "systime.h"
3080 #include "termopts.h"
3082 extern int frame_garbaged
;
3085 /* As described above, except assuming that there are no subprocesses:
3087 Wait for timeout to elapse and/or keyboard input to be available.
3090 timeout in seconds, or
3091 zero for no limit, or
3092 -1 means gobble data immediately available but don't wait for any.
3094 read_kbd is a Lisp_Object:
3095 0 to ignore keyboard input, or
3096 1 to return when input is available, or
3097 -1 means caller will actually read the input, so don't throw to
3099 We know that read_kbd will never be a Lisp_Process, since
3100 `subprocesses' isn't defined.
3102 do_display != 0 means redisplay should be done to show subprocess
3103 output that arrives. This version of the function ignores it.
3105 Return true iff we received input from any process. */
3108 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
3109 int time_limit
, microsecs
;
3110 Lisp_Object read_kbd
;
3113 EMACS_TIME end_time
, timeout
, *timeout_p
;
3116 /* What does time_limit really mean? */
3117 if (time_limit
|| microsecs
)
3119 /* It's not infinite. */
3120 timeout_p
= &timeout
;
3122 if (time_limit
== -1)
3123 /* In fact, it's zero. */
3124 EMACS_SET_SECS_USECS (timeout
, 0, 0);
3126 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
3128 /* How far in the future is that? */
3129 EMACS_GET_TIME (end_time
);
3130 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
3133 /* It's infinite. */
3136 /* Turn off periodic alarms (in case they are in use)
3137 because the select emulator uses alarms. */
3144 waitchannels
= XINT (read_kbd
) ? 1 : 0;
3146 /* If calling from keyboard input, do not quit
3147 since we want to return C-g as an input character.
3148 Otherwise, do pending quit if requested. */
3149 if (XINT (read_kbd
) >= 0)
3154 EMACS_GET_TIME (*timeout_p
);
3155 EMACS_SUB_TIME (*timeout_p
, end_time
, *timeout_p
);
3156 if (EMACS_TIME_NEG_P (*timeout_p
))
3160 /* Cause C-g and alarm signals to take immediate action,
3161 and cause input available signals to zero out timeout. */
3162 if (XINT (read_kbd
) < 0)
3163 set_waiting_for_input (&timeout
);
3165 /* If a frame has been newly mapped and needs updating,
3166 reprocess its display stuff. */
3168 redisplay_preserve_echo_area ();
3170 if (XINT (read_kbd
) && detect_input_pending ())
3173 nfds
= select (1, &waitchannels
, 0, 0, timeout_p
);
3175 /* Make C-g and alarm signals set flags again */
3176 clear_waiting_for_input ();
3178 /* If we woke up due to SIGWINCH, actually change size now. */
3179 do_pending_window_change ();
3183 /* If the system call was interrupted, then go around the
3189 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
3190 /* System sometimes fails to deliver SIGIO. */
3191 kill (getpid (), SIGIO
);
3193 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
3196 /* If we have timed out (nfds == 0) or found some input (nfds > 0),
3208 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
3209 "Return the (or, a) process associated with BUFFER.\n\
3210 This copy of Emacs has not been built to support subprocesses, so this\n\
3211 function always returns nil.")
3213 register Lisp_Object name
;
3218 /* Kill all processes associated with `buffer'.
3219 If `buffer' is nil, kill all processes.
3220 Since we have no subprocesses, this does nothing. */
3222 kill_buffer_processes (buffer
)
3233 defsubr (&Sget_buffer_process
);
3237 #endif /* not subprocesses */