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.")
635 register Lisp_Object proc
;
637 register struct Lisp_Process
*p
;
638 register Lisp_Object status
;
639 proc
= Fget_process (proc
);
643 if (!NILP (p
->raw_status_low
))
646 if (XTYPE (status
) == Lisp_Cons
)
647 status
= XCONS (status
)->car
;
648 if (NETCONN_P (proc
))
650 if (EQ (status
, Qrun
))
652 else if (EQ (status
, Qexit
))
658 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
660 "Return the exit status of PROCESS or the signal number that killed it.\n\
661 If PROCESS has not yet exited or died, return 0.")
663 register Lisp_Object proc
;
665 CHECK_PROCESS (proc
, 0);
666 if (!NILP (XPROCESS (proc
)->raw_status_low
))
667 update_status (XPROCESS (proc
));
668 if (XTYPE (XPROCESS (proc
)->status
) == Lisp_Cons
)
669 return XCONS (XCONS (XPROCESS (proc
)->status
)->cdr
)->car
;
670 return make_number (0);
673 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
674 "Return the process id of PROCESS.\n\
675 This is the pid of the Unix process which PROCESS uses or talks to.\n\
676 For a network connection, this value is nil.")
678 register Lisp_Object proc
;
680 CHECK_PROCESS (proc
, 0);
681 return XPROCESS (proc
)->pid
;
684 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
685 "Return the name of PROCESS, as a string.\n\
686 This is the name of the program invoked in PROCESS,\n\
687 possibly modified to make it unique among process names.")
689 register Lisp_Object proc
;
691 CHECK_PROCESS (proc
, 0);
692 return XPROCESS (proc
)->name
;
695 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
696 "Return the command that was executed to start PROCESS.\n\
697 This is a list of strings, the first string being the program executed\n\
698 and the rest of the strings being the arguments given to it.\n\
699 For a non-child channel, this is nil.")
701 register Lisp_Object proc
;
703 CHECK_PROCESS (proc
, 0);
704 return XPROCESS (proc
)->command
;
707 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
709 "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
711 register Lisp_Object proc
, buffer
;
713 CHECK_PROCESS (proc
, 0);
715 CHECK_BUFFER (buffer
, 1);
716 XPROCESS (proc
)->buffer
= buffer
;
720 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
722 "Return the buffer PROCESS is associated with.\n\
723 Output from PROCESS is inserted in this buffer\n\
724 unless PROCESS has a filter.")
726 register Lisp_Object proc
;
728 CHECK_PROCESS (proc
, 0);
729 return XPROCESS (proc
)->buffer
;
732 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
734 "Return the marker for the end of the last output from PROCESS.")
736 register Lisp_Object proc
;
738 CHECK_PROCESS (proc
, 0);
739 return XPROCESS (proc
)->mark
;
742 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
744 "Give PROCESS the filter function FILTER; nil means no filter.\n\
745 When a process has a filter, each time it does output\n\
746 the entire string of output is passed to the filter.\n\
747 The filter gets two arguments: the process and the string of output.\n\
748 If the process has a filter, its buffer is not used for output.")
750 register Lisp_Object proc
, filter
;
752 CHECK_PROCESS (proc
, 0);
753 XPROCESS (proc
)->filter
= filter
;
757 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
759 "Returns the filter function of PROCESS; nil if none.\n\
760 See `set-process-filter' for more info on filter functions.")
762 register Lisp_Object proc
;
764 CHECK_PROCESS (proc
, 0);
765 return XPROCESS (proc
)->filter
;
768 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
770 "Give PROCESS the sentinel SENTINEL; nil for none.\n\
771 The sentinel is called as a function when the process changes state.\n\
772 It gets two arguments: the process, and a string describing the change.")
774 register Lisp_Object proc
, sentinel
;
776 CHECK_PROCESS (proc
, 0);
777 XPROCESS (proc
)->sentinel
= sentinel
;
781 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
783 "Return the sentinel of PROCESS; nil if none.\n\
784 See `set-process-sentinel' for more info on sentinels.")
786 register Lisp_Object proc
;
788 CHECK_PROCESS (proc
, 0);
789 return XPROCESS (proc
)->sentinel
;
792 DEFUN ("process-kill-without-query", Fprocess_kill_without_query
,
793 Sprocess_kill_without_query
, 1, 2, 0,
794 "Say no query needed if PROCESS is running when Emacs is exited.\n\
795 Optional second argument if non-nill says to require a query.\n\
796 Value is t if a query was formerly required.")
798 register Lisp_Object proc
, value
;
802 CHECK_PROCESS (proc
, 0);
803 tem
= XPROCESS (proc
)->kill_without_query
;
804 XPROCESS (proc
)->kill_without_query
= Fnull (value
);
809 #if 0 /* Turned off because we don't currently record this info
810 in the process. Perhaps add it. */
811 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
812 "Return the connection type of `PROCESS'.\n\
813 The value is `nil' for a pipe,\n\
814 `t' or `pty' for a pty, or `stream' for a socket connection.")
818 return XPROCESS (process
)->type
;
825 register Lisp_Object tail
, tem
;
826 Lisp_Object proc
, minspace
, tem1
;
827 register struct buffer
*old
= current_buffer
;
828 register struct Lisp_Process
*p
;
832 XFASTINT (minspace
) = 1;
834 set_buffer_internal (XBUFFER (Vstandard_output
));
835 Fbuffer_disable_undo (Vstandard_output
);
837 current_buffer
->truncate_lines
= Qt
;
840 Proc Status Buffer Command\n\
841 ---- ------ ------ -------\n", -1);
843 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
847 proc
= Fcdr (Fcar (tail
));
849 if (NILP (p
->childp
))
852 Finsert (1, &p
->name
);
853 Findent_to (make_number (13), minspace
);
855 if (!NILP (p
->raw_status_low
))
858 if (XTYPE (p
->status
) == Lisp_Cons
)
859 symbol
= XCONS (p
->status
)->car
;
862 if (EQ (symbol
, Qsignal
))
865 tem
= Fcar (Fcdr (p
->status
));
867 if (XINT (tem
) < NSIG
)
868 write_string (sys_errlist
[XINT (tem
)], -1);
871 Fprinc (symbol
, Qnil
);
873 else if (NETCONN_P (proc
))
875 if (EQ (symbol
, Qrun
))
876 write_string ("open", -1);
877 else if (EQ (symbol
, Qexit
))
878 write_string ("closed", -1);
880 Fprinc (symbol
, Qnil
);
883 Fprinc (symbol
, Qnil
);
885 if (EQ (symbol
, Qexit
))
888 tem
= Fcar (Fcdr (p
->status
));
891 sprintf (tembuf
, " %d", XFASTINT (tem
));
892 write_string (tembuf
, -1);
896 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
897 remove_process (proc
);
899 Findent_to (make_number (22), minspace
);
900 if (NILP (p
->buffer
))
901 insert_string ("(none)");
902 else if (NILP (XBUFFER (p
->buffer
)->name
))
903 insert_string ("(Killed)");
905 Finsert (1, &XBUFFER (p
->buffer
)->name
);
907 Findent_to (make_number (37), minspace
);
909 if (NETCONN_P (proc
))
911 sprintf (tembuf
, "(network stream connection to %s)\n",
912 XSTRING (p
->childp
)->data
);
913 insert_string (tembuf
);
927 insert_string ("\n");
933 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 0, "",
934 "Display a list of all processes.\n\
935 \(Any processes listed as Exited or Signaled are actually eliminated\n\
936 after the listing is made.)")
939 internal_with_output_to_temp_buffer ("*Process List*",
940 list_processes_1
, Qnil
);
944 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
945 "Return a list of all processes.")
948 return Fmapcar (Qcdr
, Vprocess_alist
);
951 /* Starting asynchronous inferior processes. */
953 static Lisp_Object
start_process_unwind ();
955 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
956 "Start a program in a subprocess. Return the process object for it.\n\
957 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
958 NAME is name for process. It is modified if necessary to make it unique.\n\
959 BUFFER is the buffer or (buffer-name) to associate with the process.\n\
960 Process output goes at end of that buffer, unless you specify\n\
961 an output stream or filter function to handle the output.\n\
962 BUFFER may be also nil, meaning that this process is not associated\n\
964 Third arg is program file name. It is searched for as in the shell.\n\
965 Remaining arguments are strings to give program as arguments.")
968 register Lisp_Object
*args
;
970 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
972 register unsigned char *new_argv
;
975 register unsigned char **new_argv
;
978 int count
= specpdl_ptr
- specpdl
;
982 buffer
= Fget_buffer_create (buffer
);
984 /* Make sure that the child will be able to chdir to the current
985 buffer's current directory, or its unhandled equivalent. We
986 can't just have the child check for an error when it does the
987 chdir, since it's in a vfork.
989 We have to GCPRO around this because Fexpand_file_name and
990 Funhandled_file_name_directory might call a file name handling
991 function. The argument list is protected by the caller, so all
992 we really have to worry about is buffer. */
994 struct gcpro gcpro1
, gcpro2
;
996 current_dir
= current_buffer
->directory
;
998 GCPRO2 (buffer
, current_dir
);
1001 expand_and_dir_to_file
1002 (Funhandled_file_name_directory (current_dir
), Qnil
);
1003 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1004 report_file_error ("Setting current directory",
1005 Fcons (current_buffer
->directory
, Qnil
));
1011 CHECK_STRING (name
, 0);
1015 CHECK_STRING (program
, 2);
1018 /* Make a one member argv with all args concatenated
1019 together separated by a blank. */
1020 len
= XSTRING (program
)->size
+ 2;
1021 for (i
= 3; i
< nargs
; i
++)
1024 CHECK_STRING (tem
, i
);
1025 len
+= XSTRING (tem
)->size
+ 1; /* count the blank */
1027 new_argv
= (unsigned char *) alloca (len
);
1028 strcpy (new_argv
, XSTRING (program
)->data
);
1029 for (i
= 3; i
< nargs
; i
++)
1032 CHECK_STRING (tem
, i
);
1033 strcat (new_argv
, " ");
1034 strcat (new_argv
, XSTRING (tem
)->data
);
1036 /* Need to add code here to check for program existence on VMS */
1039 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1041 for (i
= 3; i
< nargs
; i
++)
1044 CHECK_STRING (tem
, i
);
1045 new_argv
[i
- 2] = XSTRING (tem
)->data
;
1047 new_argv
[i
- 2] = 0;
1048 new_argv
[0] = XSTRING (program
)->data
;
1050 /* If program file name is not absolute, search our path for it */
1051 if (new_argv
[0][0] != '/')
1054 openp (Vexec_path
, program
, EXEC_SUFFIXES
, &tem
, 1);
1056 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1057 new_argv
[0] = XSTRING (tem
)->data
;
1059 #endif /* not VMS */
1061 proc
= make_process (name
);
1062 /* If an error occurs and we can't start the process, we want to
1063 remove it from the process list. This means that each error
1064 check in create_process doesn't need to call remove_process
1065 itself; it's all taken care of here. */
1066 record_unwind_protect (start_process_unwind
, proc
);
1068 XPROCESS (proc
)->childp
= Qt
;
1069 XPROCESS (proc
)->command_channel_p
= Qnil
;
1070 XPROCESS (proc
)->buffer
= buffer
;
1071 XPROCESS (proc
)->sentinel
= Qnil
;
1072 XPROCESS (proc
)->filter
= Qnil
;
1073 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1075 create_process (proc
, new_argv
, current_dir
);
1077 return unbind_to (count
, proc
);
1080 /* This function is the unwind_protect form for Fstart_process. If
1081 PROC doesn't have its pid set, then we know someone has signalled
1082 an error and the process wasn't started successfully, so we should
1083 remove it from the process list. */
1085 start_process_unwind (proc
)
1088 if (XTYPE (proc
) != Lisp_Process
)
1091 /* Was PROC started successfully? */
1092 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1093 remove_process (proc
);
1100 create_process_1 (signo
)
1104 /* USG systems forget handlers when they are used;
1105 must reestablish each time */
1106 signal (signo
, create_process_1
);
1110 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1113 /* Mimic blocking of signals on system V, which doesn't really have it. */
1115 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1116 int sigchld_deferred
;
1119 create_process_sigchld ()
1121 signal (SIGCHLD
, create_process_sigchld
);
1123 sigchld_deferred
= 1;
1129 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1130 create_process (process
, new_argv
, current_dir
)
1131 Lisp_Object process
;
1133 Lisp_Object current_dir
;
1135 int pid
, inchannel
, outchannel
, forkin
, forkout
;
1138 SIGTYPE (*sigchld
)();
1141 extern char **environ
;
1143 inchannel
= outchannel
= -1;
1146 if (EQ (Vprocess_connection_type
, Qt
))
1147 outchannel
= inchannel
= allocate_pty ();
1152 /* On USG systems it does not work to open the pty's tty here
1153 and then close and reopen it in the child. */
1155 /* Don't let this terminal become our controlling terminal
1156 (in case we don't have one). */
1157 forkout
= forkin
= open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1159 forkout
= forkin
= open (pty_name
, O_RDWR
, 0);
1162 report_file_error ("Opening pty", Qnil
);
1164 forkin
= forkout
= -1;
1165 #endif /* not USG */
1169 #endif /* HAVE_PTYS */
1172 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1173 report_file_error ("Opening socketpair", Qnil
);
1174 outchannel
= inchannel
= sv
[0];
1175 forkout
= forkin
= sv
[1];
1177 #else /* not SKTPAIR */
1186 #endif /* not SKTPAIR */
1189 /* Replaced by close_process_descs */
1190 set_exclusive_use (inchannel
);
1191 set_exclusive_use (outchannel
);
1194 /* Stride people say it's a mystery why this is needed
1195 as well as the O_NDELAY, but that it fails without this. */
1196 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1199 ioctl (inchannel
, FIONBIO
, &one
);
1204 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1207 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1211 /* Record this as an active process, with its channels.
1212 As a result, child_setup will close Emacs's side of the pipes. */
1213 chan_process
[inchannel
] = process
;
1214 XFASTINT (XPROCESS (process
)->infd
) = inchannel
;
1215 XFASTINT (XPROCESS (process
)->outfd
) = outchannel
;
1216 /* Record the tty descriptor used in the subprocess. */
1218 XPROCESS (process
)->subtty
= Qnil
;
1220 XFASTINT (XPROCESS (process
)->subtty
) = forkin
;
1221 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1222 XPROCESS (process
)->status
= Qrun
;
1224 /* Delay interrupts until we have a chance to store
1225 the new fork's pid in its process structure */
1229 #else /* not BSD4_1 */
1230 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1231 sigsetmask (sigmask (SIGCHLD
));
1232 #else /* ordinary USG */
1234 sigchld_deferred
= 0;
1235 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1237 #endif /* ordinary USG */
1238 #endif /* not BSD4_1 */
1239 #endif /* SIGCHLD */
1241 /* Until we store the proper pid, enable sigchld_handler
1242 to recognize an unknown pid as standing for this process.
1243 It is very important not to let this `marker' value stay
1244 in the table after this function has returned; if it does
1245 it might cause call-process to hang and subsequent asynchronous
1246 processes to get their return values scrambled. */
1247 XSETINT (XPROCESS (process
)->pid
, -1);
1250 /* child_setup must clobber environ on systems with true vfork.
1251 Protect it from permanent change. */
1252 char **save_environ
= environ
;
1257 int xforkin
= forkin
;
1258 int xforkout
= forkout
;
1260 #if 0 /* This was probably a mistake--it duplicates code later on,
1261 but fails to handle all the cases. */
1262 /* Make sure SIGCHLD is not blocked in the child. */
1263 sigsetmask (SIGEMPTYMASK
);
1266 /* Make the pty be the controlling terminal of the process. */
1268 /* First, disconnect its current controlling terminal. */
1272 /* Make the pty's terminal the controlling terminal. */
1274 /* We ignore the return value
1275 because faith@cs.unc.edu says that is necessary on Linux. */
1276 ioctl (xforkin
, TIOCSCTTY
, 0);
1278 #else /* not HAVE_SETSID */
1279 #if defined (USG) && !defined (IRIX)
1280 /* It's very important to call setpgrp() here and no time
1281 afterwards. Otherwise, we lose our controlling tty which
1282 is set when we open the pty. */
1285 #endif /* not HAVE_SETSID */
1287 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1288 can do TIOCSPGRP only to the process's controlling tty. */
1291 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1292 I can't test it since I don't have 4.3. */
1293 int j
= open ("/dev/tty", O_RDWR
, 0);
1294 ioctl (j
, TIOCNOTTY
, 0);
1297 /* In order to get a controlling terminal on some versions
1298 of BSD, it is necessary to put the process in pgrp 0
1299 before it opens the terminal. */
1303 #endif /* TIOCNOTTY */
1305 #if !defined (RTU) && !defined (UNIPLUS)
1306 /*** There is a suggestion that this ought to be a
1307 conditional on TIOCSPGRP. */
1308 /* Now close the pty (if we had it open) and reopen it.
1309 This makes the pty the controlling terminal of the subprocess. */
1312 /* I wonder if close (open (pty_name, ...)) would work? */
1315 xforkout
= xforkin
= open (pty_name
, O_RDWR
, 0);
1320 #endif /* not UNIPLUS and not RTU */
1321 #ifdef SETUP_SLAVE_PTY
1323 #endif /* SETUP_SLAVE_PTY */
1325 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1326 Now reenable it in the child, so it will die when we want it to. */
1328 signal (SIGHUP
, SIG_DFL
);
1330 #endif /* HAVE_PTYS */
1335 #else /* not BSD4_1 */
1336 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1337 sigsetmask (SIGEMPTYMASK
);
1338 #else /* ordinary USG */
1340 signal (SIGCHLD
, sigchld
);
1342 #endif /* ordinary USG */
1343 #endif /* not BSD4_1 */
1344 #endif /* SIGCHLD */
1346 child_setup_tty (xforkout
);
1347 child_setup (xforkin
, xforkout
, xforkout
,
1348 new_argv
, 1, current_dir
);
1350 environ
= save_environ
;
1354 report_file_error ("Doing vfork", Qnil
);
1356 XFASTINT (XPROCESS (process
)->pid
) = pid
;
1358 FD_SET (inchannel
, &input_wait_mask
);
1360 /* If the subfork execv fails, and it exits,
1361 this close hangs. I don't know why.
1362 So have an interrupt jar it loose. */
1364 signal (SIGALRM
, create_process_1
);
1367 /* OK to close only if it's not a pty. Otherwise we need to leave
1368 it open for ioctl to get pgrp when signals are sent, or to send
1369 the interrupt characters through if that's how we're signalling
1370 subprocesses. Alternately if you are concerned about running out
1371 of file descriptors, you could just save the tty name and open
1372 just to do the ioctl. */
1373 if (NILP (XFASTINT (XPROCESS (process
)->pty_flag
)))
1376 XPROCESS (process
)->subtty
= Qnil
;
1382 if (forkin
!= forkout
&& forkout
>= 0)
1388 #else /* not BSD4_1 */
1389 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1390 sigsetmask (SIGEMPTYMASK
);
1391 #else /* ordinary USG */
1393 signal (SIGCHLD
, sigchld
);
1394 /* Now really handle any of these signals
1395 that came in during this function. */
1396 if (sigchld_deferred
)
1397 kill (getpid (), SIGCHLD
);
1399 #endif /* ordinary USG */
1400 #endif /* not BSD4_1 */
1401 #endif /* SIGCHLD */
1403 #endif /* not VMS */
1407 /* open a TCP network connection to a given HOST/SERVICE. Treated
1408 exactly like a normal process when reading and writing. Only
1409 differences are in status display and process deletion. A network
1410 connection has no PID; you cannot signal it. All you can do is
1411 deactivate and close it via delete-process */
1413 DEFUN ("open-network-stream", Fopen_network_stream
, Sopen_network_stream
,
1415 "Open a TCP connection for a service to a host.\n\
1416 Returns a subprocess-object to represent the connection.\n\
1417 Input and output work as for subprocesses; `delete-process' closes it.\n\
1418 Args are NAME BUFFER HOST SERVICE.\n\
1419 NAME is name for process. It is modified if necessary to make it unique.\n\
1420 BUFFER is the buffer (or buffer-name) to associate with the process.\n\
1421 Process output goes at end of that buffer, unless you specify\n\
1422 an output stream or filter function to handle the output.\n\
1423 BUFFER may be also nil, meaning that this process is not associated\n\
1425 Third arg is name of the host to connect to, or its IP address.\n\
1426 Fourth arg SERVICE is name of the service desired, or an integer\n\
1427 specifying a port number to connect to.")
1428 (name
, buffer
, host
, service
)
1429 Lisp_Object name
, buffer
, host
, service
;
1433 struct sockaddr_in address
;
1434 struct servent
*svc_info
;
1435 struct hostent
*host_info_ptr
, host_info
;
1436 char *(addr_list
[2]);
1437 unsigned long numeric_addr
;
1441 struct hostent host_info_fixed
;
1442 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1444 GCPRO4 (name
, buffer
, host
, service
);
1445 CHECK_STRING (name
, 0);
1446 CHECK_STRING (host
, 0);
1447 if (XTYPE(service
) == Lisp_Int
)
1448 port
= htons ((unsigned short) XINT (service
));
1451 CHECK_STRING (service
, 0);
1452 svc_info
= getservbyname (XSTRING (service
)->data
, "tcp");
1454 error ("Unknown service \"%s\"", XSTRING (service
)->data
);
1455 port
= svc_info
->s_port
;
1458 host_info_ptr
= gethostbyname (XSTRING (host
)->data
);
1459 if (host_info_ptr
== 0)
1460 /* Attempt to interpret host as numeric inet address */
1462 numeric_addr
= inet_addr (XSTRING (host
)->data
);
1463 if (numeric_addr
== -1)
1464 error ("Unknown host \"%s\"", XSTRING (host
)->data
);
1466 host_info_ptr
= &host_info
;
1467 host_info
.h_name
= 0;
1468 host_info
.h_aliases
= 0;
1469 host_info
.h_addrtype
= AF_INET
;
1471 /* Older machines have only one address slot called h_addr.
1472 Newer machines have h_addr_list, but #define h_addr to
1473 be its first element. */
1474 host_info
.h_addr_list
= &(addr_list
[0]);
1476 host_info
.h_addr
= (char*)(&numeric_addr
);
1478 host_info
.h_length
= strlen (addr_list
[0]);
1481 bzero (&address
, sizeof address
);
1482 bcopy (host_info_ptr
->h_addr
, (char *) &address
.sin_addr
,
1483 host_info_ptr
->h_length
);
1484 address
.sin_family
= host_info_ptr
->h_addrtype
;
1485 address
.sin_port
= port
;
1487 s
= socket (host_info_ptr
->h_addrtype
, SOCK_STREAM
, 0);
1489 report_file_error ("error creating socket", Fcons (name
, Qnil
));
1492 if (connect (s
, (struct sockaddr
*) &address
, sizeof address
) == -1)
1499 report_file_error ("connection failed",
1500 Fcons (host
, Fcons (name
, Qnil
)));
1506 report_file_error ("error duplicating socket", Fcons (name
, Qnil
));
1509 buffer
= Fget_buffer_create (buffer
);
1510 proc
= make_process (name
);
1512 chan_process
[inch
] = proc
;
1515 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
1518 fcntl (inch
, F_SETFL
, O_NDELAY
);
1522 XPROCESS (proc
)->childp
= host
;
1523 XPROCESS (proc
)->command_channel_p
= Qnil
;
1524 XPROCESS (proc
)->buffer
= buffer
;
1525 XPROCESS (proc
)->sentinel
= Qnil
;
1526 XPROCESS (proc
)->filter
= Qnil
;
1527 XPROCESS (proc
)->command
= Qnil
;
1528 XPROCESS (proc
)->pid
= Qnil
;
1529 XFASTINT (XPROCESS (proc
)->infd
) = s
;
1530 XFASTINT (XPROCESS (proc
)->outfd
) = outch
;
1531 XPROCESS (proc
)->status
= Qrun
;
1532 FD_SET (inch
, &input_wait_mask
);
1537 #endif /* HAVE_SOCKETS */
1539 deactivate_process (proc
)
1542 register int inchannel
, outchannel
;
1543 register struct Lisp_Process
*p
= XPROCESS (proc
);
1545 inchannel
= XFASTINT (p
->infd
);
1546 outchannel
= XFASTINT (p
->outfd
);
1550 /* Beware SIGCHLD hereabouts. */
1551 flush_pending_output (inchannel
);
1554 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
1555 sys$
dassgn (outchannel
);
1556 vs
= get_vms_process_pointer (p
->pid
);
1558 give_back_vms_process_stuff (vs
);
1562 if (outchannel
&& outchannel
!= inchannel
)
1566 XFASTINT (p
->infd
) = 0;
1567 XFASTINT (p
->outfd
) = 0;
1568 chan_process
[inchannel
] = Qnil
;
1569 FD_CLR (inchannel
, &input_wait_mask
);
1573 /* Close all descriptors currently in use for communication
1574 with subprocess. This is used in a newly-forked subprocess
1575 to get rid of irrelevant descriptors. */
1577 close_process_descs ()
1580 for (i
= 0; i
< MAXDESC
; i
++)
1582 Lisp_Object process
;
1583 process
= chan_process
[i
];
1584 if (!NILP (process
))
1586 int in
= XFASTINT (XPROCESS (process
)->infd
);
1587 int out
= XFASTINT (XPROCESS (process
)->outfd
);
1590 if (out
&& in
!= out
)
1596 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
1598 "Allow any pending output from subprocesses to be read by Emacs.\n\
1599 It is read into the process' buffers or given to their filter functions.\n\
1600 Non-nil arg PROCESS means do not return until some output has been received\n\
1602 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\
1603 seconds and microseconds to wait; return after that much time whether\n\
1604 or not there is input.\n\
1605 Return non-nil iff we received any output before the timeout expired.")
1606 (proc
, timeout
, timeout_msecs
)
1607 register Lisp_Object proc
, timeout
, timeout_msecs
;
1612 if (! NILP (timeout_msecs
))
1614 CHECK_NUMBER (timeout_msecs
, 2);
1615 useconds
= XINT (timeout_msecs
);
1616 if (XTYPE (timeout
) != Lisp_Int
)
1617 XSET (timeout
, Lisp_Int
, 0);
1620 int carry
= useconds
/ 1000000;
1622 XSETINT (timeout
, XINT (timeout
) + carry
);
1623 useconds
-= carry
* 1000000;
1625 /* I think this clause is necessary because C doesn't
1626 guarantee a particular rounding direction for negative
1630 XSETINT (timeout
, XINT (timeout
) - 1);
1631 useconds
+= 1000000;
1638 if (! NILP (timeout
))
1640 CHECK_NUMBER (timeout
, 1);
1641 seconds
= XINT (timeout
);
1654 XFASTINT (proc
) = 0;
1657 (wait_reading_process_input (seconds
, useconds
, proc
, 0)
1661 /* This variable is different from waiting_for_input in keyboard.c.
1662 It is used to communicate to a lisp process-filter/sentinel (via the
1663 function Fwaiting_for_user_input_p below) whether emacs was waiting
1664 for user-input when that process-filter was called.
1665 waiting_for_input cannot be used as that is by definition 0 when
1666 lisp code is being evalled */
1667 static int waiting_for_user_input_p
;
1669 /* Read and dispose of subprocess output while waiting for timeout to
1670 elapse and/or keyboard input to be available.
1673 timeout in seconds, or
1674 zero for no limit, or
1675 -1 means gobble data immediately available but don't wait for any.
1678 an additional duration to wait, measured in microseconds.
1679 If this is nonzero and time_limit is 0, then the timeout
1680 consists of MICROSECS only.
1682 READ_KBD is a lisp value:
1683 0 to ignore keyboard input, or
1684 1 to return when input is available, or
1685 -1 meaning caller will actually read the input, so don't throw to
1686 the quit handler, or
1687 a cons cell, meaning wait wait until its car is non-nil
1688 (and gobble terminal input into the buffer if any arrives), or
1689 a process object, meaning wait until something arrives from that
1690 process. The return value is true iff we read some input from
1693 DO_DISPLAY != 0 means redisplay should be done to show subprocess
1694 output that arrives.
1696 If READ_KBD is a pointer to a struct Lisp_Process, then the
1697 function returns true iff we received input from that process
1698 before the timeout elapsed.
1699 Otherwise, return true iff we received input from any process. */
1701 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
1702 int time_limit
, microsecs
;
1703 Lisp_Object read_kbd
;
1706 register int channel
, nfds
, m
;
1707 static SELECT_TYPE Available
;
1710 EMACS_TIME timeout
, end_time
, garbage
;
1712 int wait_channel
= 0;
1713 struct Lisp_Process
*wait_proc
= 0;
1714 int got_some_input
= 0;
1715 Lisp_Object
*wait_for_cell
= 0;
1717 FD_ZERO (&Available
);
1719 /* If read_kbd is a process to watch, set wait_proc and wait_channel
1721 if (XTYPE (read_kbd
) == Lisp_Process
)
1723 wait_proc
= XPROCESS (read_kbd
);
1724 wait_channel
= XFASTINT (wait_proc
->infd
);
1725 XFASTINT (read_kbd
) = 0;
1728 /* If waiting for non-nil in a cell, record where. */
1729 if (XTYPE (read_kbd
) == Lisp_Cons
)
1731 wait_for_cell
= &XCONS (read_kbd
)->car
;
1732 XFASTINT (read_kbd
) = 0;
1735 waiting_for_user_input_p
= XINT (read_kbd
);
1737 /* Since we may need to wait several times,
1738 compute the absolute time to return at. */
1739 if (time_limit
|| microsecs
)
1741 EMACS_GET_TIME (end_time
);
1742 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
1743 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
1748 /* If calling from keyboard input, do not quit
1749 since we want to return C-g as an input character.
1750 Otherwise, do pending quit if requested. */
1751 if (XINT (read_kbd
) >= 0)
1754 /* Compute time from now till when time limit is up */
1755 /* Exit if already run out */
1756 if (time_limit
== -1)
1758 /* -1 specified for timeout means
1759 gobble output available now
1760 but don't wait at all. */
1762 EMACS_SET_SECS_USECS (timeout
, 0, 0);
1764 else if (time_limit
|| microsecs
)
1766 EMACS_GET_TIME (timeout
);
1767 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
1768 if (EMACS_TIME_NEG_P (timeout
))
1773 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
1776 /* Cause C-g and alarm signals to take immediate action,
1777 and cause input available signals to zero out timeout.
1779 It is important that we do this before checking for process
1780 activity. If we get a SIGCHLD after the explicit checks for
1781 process activity, timeout is the only way we will know. */
1782 if (XINT (read_kbd
) < 0)
1783 set_waiting_for_input (&timeout
);
1785 /* If status of something has changed, and no input is
1786 available, notify the user of the change right away. After
1787 this explicit check, we'll let the SIGCHLD handler zap
1788 timeout to get our attention. */
1789 if (update_tick
!= process_tick
&& do_display
)
1791 Atemp
= input_wait_mask
;
1792 EMACS_SET_SECS_USECS (timeout
, 0, 0);
1793 if (select (MAXDESC
, &Atemp
, 0, 0, &timeout
) <= 0)
1795 /* It's okay for us to do this and then continue with
1796 the loop, since timeout has already been zeroed out. */
1797 clear_waiting_for_input ();
1802 /* Don't wait for output from a non-running process. */
1803 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
1804 update_status (wait_proc
);
1806 && ! EQ (wait_proc
->status
, Qrun
))
1808 clear_waiting_for_input ();
1812 /* Wait till there is something to do */
1814 Available
= input_wait_mask
;
1815 /* We used to have && wait_for_cell == 0
1816 but that led to lossage handling selection_request events:
1817 within one, we would start to handle another. */
1818 if (! XINT (read_kbd
))
1819 FD_CLR (0, &Available
);
1821 /* If frame size has changed or the window is newly mapped,
1822 redisplay now, before we start to wait. There is a race
1823 condition here; if a SIGIO arrives between now and the select
1824 and indicates that a frame is trashed, the select may block
1825 displaying a trashed screen. */
1827 redisplay_preserve_echo_area ();
1829 if (XINT (read_kbd
) && detect_input_pending ())
1832 nfds
= select (MAXDESC
, &Available
, 0, 0, &timeout
);
1836 /* Make C-g and alarm signals set flags again */
1837 clear_waiting_for_input ();
1839 /* If we woke up due to SIGWINCH, actually change size now. */
1840 do_pending_window_change ();
1842 if (time_limit
&& nfds
== 0) /* timeout elapsed */
1846 if (xerrno
== EINTR
)
1847 FD_ZERO (&Available
);
1849 /* Ultrix select seems to return ENOMEM when it is
1850 interrupted. Treat it just like EINTR. Bleah. Note
1851 that we want to test for the "ultrix" CPP symbol, not
1852 "__ultrix__"; the latter is only defined under GCC, but
1853 not by DEC's bundled CC. -JimB */
1854 else if (xerrno
== ENOMEM
)
1855 FD_ZERO (&Available
);
1858 /* This happens for no known reason on ALLIANT.
1859 I am guessing that this is the right response. -- RMS. */
1860 else if (xerrno
== EFAULT
)
1861 FD_ZERO (&Available
);
1863 else if (xerrno
== EBADF
)
1866 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
1867 the child's closure of the pts gives the parent a SIGHUP, and
1868 the ptc file descriptor is automatically closed,
1869 yielding EBADF here or at select() call above.
1870 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
1871 in m-ibmrt-aix.h), and here we just ignore the select error.
1872 Cleanup occurs c/o status_notify after SIGCLD. */
1873 FD_ZERO (&Available
); /* Cannot depend on values returned */
1879 error("select error: %s", sys_errlist
[xerrno
]);
1881 #if defined(sun) && !defined(USG5_4)
1882 else if (nfds
> 0 && FD_ISSET (0, &Available
) && interrupt_input
)
1883 /* System sometimes fails to deliver SIGIO.
1885 David J. Mackenzie says that Emacs doesn't compile under
1886 Solaris if this code is enabled, thus the USG5_4 in the CPP
1887 conditional. "I haven't noticed any ill effects so far.
1888 If you find a Solaris expert somewhere, they might know
1890 kill (getpid (), SIGIO
);
1893 /* Check for keyboard input */
1894 /* If there is any, return immediately
1895 to give it higher priority than subprocesses */
1897 /* We used to do his if wait_for_cell,
1898 but that caused infinite recursion in selection request events. */
1899 if ((XINT (read_kbd
))
1900 && detect_input_pending ())
1903 if (detect_input_pending ())
1907 /* Exit now if the cell we're waiting for became non-nil. */
1908 if (wait_for_cell
&& ! NILP (*wait_for_cell
))
1912 /* If we think we have keyboard input waiting, but didn't get SIGIO
1913 go read it. This can happen with X on BSD after logging out.
1914 In that case, there really is no input and no SIGIO,
1915 but select says there is input. */
1917 if (XINT (read_kbd
) && interrupt_input
&& (FD_ISSET (fileno (stdin
), &Available
)))
1922 got_some_input
|= nfds
> 0;
1924 /* If checking input just got us a size-change event from X,
1925 obey it now if we should. */
1926 if (XINT (read_kbd
) || wait_for_cell
)
1927 do_pending_window_change ();
1929 /* Check for data from a process or a command channel */
1930 for (channel
= FIRST_PROC_DESC
; channel
< MAXDESC
; channel
++)
1932 if (FD_ISSET (channel
, &Available
))
1936 /* If waiting for this channel, arrange to return as
1937 soon as no more input to be processed. No more
1939 if (wait_channel
== channel
)
1945 proc
= chan_process
[channel
];
1949 /* Read data from the process, starting with our
1950 buffered-ahead character if we have one. */
1952 nread
= read_process_output (proc
, channel
);
1955 /* Since read_process_output can run a filter,
1956 which can call accept-process-output,
1957 don't try to read from any other processes
1958 before doing the select again. */
1959 FD_ZERO (&Available
);
1962 redisplay_preserve_echo_area ();
1965 else if (nread
== -1 && errno
== EWOULDBLOCK
)
1969 else if (nread
== -1 && errno
== EAGAIN
)
1973 else if (nread
== -1 && errno
== EAGAIN
)
1975 /* Note that we cannot distinguish between no input
1976 available now and a closed pipe.
1977 With luck, a closed pipe will be accompanied by
1978 subprocess termination and SIGCHLD. */
1979 else if (nread
== 0 && !NETCONN_P (proc
))
1981 #endif /* O_NDELAY */
1982 #endif /* O_NONBLOCK */
1983 #endif /* EWOULDBLOCK */
1985 /* On some OSs with ptys, when the process on one end of
1986 a pty exits, the other end gets an error reading with
1987 errno = EIO instead of getting an EOF (0 bytes read).
1988 Therefore, if we get an error reading and errno =
1989 EIO, just continue, because the child process has
1990 exited and should clean itself up soon (e.g. when we
1992 else if (nread
== -1 && errno
== EIO
)
1994 #endif /* HAVE_PTYS */
1995 /* If we can detect process termination, don't consider the process
1996 gone just because its pipe is closed. */
1998 else if (nread
== 0 && !NETCONN_P (proc
))
2003 /* Preserve status of processes already terminated. */
2004 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
2005 deactivate_process (proc
);
2006 if (!NILP (XPROCESS (proc
)->raw_status_low
))
2007 update_status (XPROCESS (proc
));
2008 if (EQ (XPROCESS (proc
)->status
, Qrun
))
2009 XPROCESS (proc
)->status
2010 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
2013 } /* end for each file descriptor */
2014 } /* end while exit conditions not met */
2016 /* If calling from keyboard input, do not quit
2017 since we want to return C-g as an input character.
2018 Otherwise, do pending quit if requested. */
2019 if (XINT (read_kbd
) >= 0)
2021 /* Prevent input_pending from remaining set if we quit. */
2022 clear_input_pending ();
2026 return got_some_input
;
2029 /* Read pending output from the process channel,
2030 starting with our buffered-ahead character if we have one.
2031 Yield number of characters read.
2033 This function reads at most 1024 characters.
2034 If you want to read all available subprocess output,
2035 you must call it repeatedly until it returns zero. */
2037 read_process_output (proc
, channel
)
2039 register int channel
;
2041 register int nchars
;
2047 register Lisp_Object outstream
;
2048 register struct buffer
*old
= current_buffer
;
2049 register struct Lisp_Process
*p
= XPROCESS (proc
);
2050 register int opoint
;
2053 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
2055 vs
= get_vms_process_pointer (p
->pid
);
2059 return(0); /* Really weird if it does this */
2060 if (!(vs
->iosb
[0] & 1))
2061 return -1; /* I/O error */
2064 error ("Could not get VMS process pointer");
2065 chars
= vs
->inputBuffer
;
2066 nchars
= clean_vms_buffer (chars
, vs
->iosb
[1]);
2069 start_vms_process_read (vs
); /* Crank up the next read on the process */
2070 return 1; /* Nothing worth printing, say we got 1 */
2074 if (proc_buffered_char
[channel
] < 0)
2075 nchars
= read (channel
, chars
, sizeof chars
);
2078 chars
[0] = proc_buffered_char
[channel
];
2079 proc_buffered_char
[channel
] = -1;
2080 nchars
= read (channel
, chars
+ 1, sizeof chars
- 1);
2084 nchars
= nchars
+ 1;
2086 #endif /* not VMS */
2088 if (nchars
<= 0) return nchars
;
2090 outstream
= p
->filter
;
2091 if (!NILP (outstream
))
2093 /* We inhibit quit here instead of just catching it so that
2094 hitting ^G when a filter happens to be running won't screw
2096 int count
= specpdl_ptr
- specpdl
;
2097 Lisp_Object odeactivate
;
2099 odeactivate
= Vdeactivate_mark
;
2101 specbind (Qinhibit_quit
, Qt
);
2102 call2 (outstream
, proc
, make_string (chars
, nchars
));
2104 /* Handling the process output should not deactivate the mark. */
2105 Vdeactivate_mark
= odeactivate
;
2108 start_vms_process_read (vs
);
2114 /* If no filter, write into buffer if it isn't dead. */
2115 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
2117 Lisp_Object old_read_only
;
2118 Lisp_Object old_begv
, old_zv
;
2119 Lisp_Object odeactivate
;
2121 odeactivate
= Vdeactivate_mark
;
2123 Fset_buffer (p
->buffer
);
2125 old_read_only
= current_buffer
->read_only
;
2126 XFASTINT (old_begv
) = BEGV
;
2127 XFASTINT (old_zv
) = ZV
;
2129 current_buffer
->read_only
= Qnil
;
2131 /* Insert new output into buffer
2132 at the current end-of-output marker,
2133 thus preserving logical ordering of input and output. */
2134 if (XMARKER (p
->mark
)->buffer
)
2135 SET_PT (marker_position (p
->mark
));
2139 /* If the output marker is outside of the visible region, save
2140 the restriction and widen. */
2141 if (! (BEGV
<= point
&& point
<= ZV
))
2144 /* Make sure opoint floats ahead of any new text, just as point
2146 if (point
<= opoint
)
2149 /* Insert after old_begv, but before old_zv. */
2150 if (point
< XFASTINT (old_begv
))
2151 XFASTINT (old_begv
) += nchars
;
2152 if (point
<= XFASTINT (old_zv
))
2153 XFASTINT (old_zv
) += nchars
;
2155 /* Insert before markers in case we are inserting where
2156 the buffer's mark is, and the user's next command is Meta-y. */
2157 insert_before_markers (chars
, nchars
);
2158 Fset_marker (p
->mark
, make_number (point
), p
->buffer
);
2160 update_mode_lines
++;
2162 /* If the restriction isn't what it should be, set it. */
2163 if (XFASTINT (old_begv
) != BEGV
|| XFASTINT (old_zv
) != ZV
)
2164 Fnarrow_to_region (old_begv
, old_zv
);
2166 /* Handling the process output should not deactivate the mark. */
2167 Vdeactivate_mark
= odeactivate
;
2169 current_buffer
->read_only
= old_read_only
;
2171 set_buffer_internal (old
);
2174 start_vms_process_read (vs
);
2179 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
2181 "Returns non-NIL if emacs is waiting for input from the user.\n\
2182 This is intended for use by asynchronous process output filters and sentinels.")
2185 return ((waiting_for_user_input_p
) ? Qt
: Qnil
);
2188 /* Sending data to subprocess */
2190 jmp_buf send_process_frame
;
2193 send_process_trap ()
2199 longjmp (send_process_frame
, 1);
2202 send_process (proc
, buf
, len
)
2207 /* Don't use register vars; longjmp can lose them. */
2209 unsigned char *procname
= XSTRING (XPROCESS (proc
)->name
)->data
;
2213 struct Lisp_Process
*p
= XPROCESS (proc
);
2214 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
2217 if (! NILP (XPROCESS (proc
)->raw_status_low
))
2218 update_status (XPROCESS (proc
));
2219 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
2220 error ("Process %s not running", procname
);
2223 vs
= get_vms_process_pointer (p
->pid
);
2225 error ("Could not find this process: %x", p
->pid
);
2226 else if (write_to_vms_process (vs
, buf
, len
))
2229 if (!setjmp (send_process_frame
))
2233 SIGTYPE (*old_sigpipe
)();
2235 /* Don't send more than 500 bytes at a time. */
2238 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
2239 rv
= write (XFASTINT (XPROCESS (proc
)->outfd
), buf
, this);
2240 signal (SIGPIPE
, old_sigpipe
);
2245 || errno
== EWOULDBLOCK
2252 /* It would be nice to accept process output here,
2253 but that is difficult. For example, it could
2254 garbage what we are sending if that is from a buffer. */
2261 report_file_error ("writing to process", Fcons (proc
, Qnil
));
2265 /* Allow input from processes between bursts of sending.
2266 Otherwise things may get stopped up. */
2271 XFASTINT (zero
) = 0;
2272 wait_reading_process_input (-1, 0, zero
, 0);
2278 XPROCESS (proc
)->raw_status_low
= Qnil
;
2279 XPROCESS (proc
)->raw_status_high
= Qnil
;
2280 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
2281 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
2282 deactivate_process (proc
);
2284 error ("Error writing to process %s; closed it", procname
);
2286 error ("SIGPIPE raised on process %s; closed it", procname
);
2291 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
2293 "Send current contents of region as input to PROCESS.\n\
2294 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2295 nil, indicating the current buffer's process.\n\
2296 Called from program, takes three arguments, PROCESS, START and END.\n\
2297 If the region is more than 500 characters long,\n\
2298 it is sent in several bunches. This may happen even for shorter regions.\n\
2299 Output from processes can arrive in between bunches.")
2300 (process
, start
, end
)
2301 Lisp_Object process
, start
, end
;
2306 proc
= get_process (process
);
2307 validate_region (&start
, &end
);
2309 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
2312 start1
= XINT (start
);
2313 send_process (proc
, &FETCH_CHAR (start1
), XINT (end
) - XINT (start
));
2318 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
2320 "Send PROCESS the contents of STRING as input.\n\
2321 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2322 nil, indicating the current buffer's process.\n\
2323 If STRING is more than 500 characters long,\n\
2324 it is sent in several bunches. This may happen even for shorter strings.\n\
2325 Output from processes can arrive in between bunches.")
2327 Lisp_Object process
, string
;
2330 CHECK_STRING (string
, 1);
2331 proc
= get_process (process
);
2332 send_process (proc
, XSTRING (string
)->data
, XSTRING (string
)->size
);
2336 /* send a signal number SIGNO to PROCESS.
2337 CURRENT_GROUP means send to the process group that currently owns
2338 the terminal being used to communicate with PROCESS.
2339 This is used for various commands in shell mode.
2340 If NOMSG is zero, insert signal-announcements into process's buffers
2343 If we can, we try to signal PROCESS by sending control characters
2344 down the pipe. This allows us to signal inferiors who have changed
2345 their uid, for which killpg would return an EPERM error. */
2348 process_send_signal (process
, signo
, current_group
, nomsg
)
2349 Lisp_Object process
;
2351 Lisp_Object current_group
;
2355 register struct Lisp_Process
*p
;
2359 proc
= get_process (process
);
2360 p
= XPROCESS (proc
);
2362 if (!EQ (p
->childp
, Qt
))
2363 error ("Process %s is not a subprocess",
2364 XSTRING (p
->name
)->data
);
2365 if (!XFASTINT (p
->infd
))
2366 error ("Process %s is not active",
2367 XSTRING (p
->name
)->data
);
2369 if (NILP (p
->pty_flag
))
2370 current_group
= Qnil
;
2372 /* If we are using pgrps, get a pgrp number and make it negative. */
2373 if (!NILP (current_group
))
2375 #ifdef SIGNALS_VIA_CHARACTERS
2376 /* If possible, send signals to the entire pgrp
2377 by sending an input character to it. */
2379 /* TERMIOS is the latest and bestest, and seems most likely to
2380 work. If the system has it, use it. */
2387 tcgetattr (XFASTINT (p
->infd
), &t
);
2388 send_process (proc
, &t
.c_cc
[VINTR
], 1);
2392 tcgetattr (XFASTINT (p
->infd
), &t
);
2393 send_process (proc
, &t
.c_cc
[VQUIT
], 1);
2397 tcgetattr (XFASTINT (p
->infd
), &t
);
2399 send_process (proc
, &t
.c_cc
[VSWTCH
], 1);
2401 send_process (proc
, &t
.c_cc
[VSUSP
], 1);
2406 #else /* ! HAVE_TERMIOS */
2408 /* On Berkeley descendants, the following IOCTL's retrieve the
2409 current control characters. */
2410 #if defined (TIOCGLTC) && defined (TIOCGETC)
2418 ioctl (XFASTINT (p
->infd
), TIOCGETC
, &c
);
2419 send_process (proc
, &c
.t_intrc
, 1);
2422 ioctl (XFASTINT (p
->infd
), TIOCGETC
, &c
);
2423 send_process (proc
, &c
.t_quitc
, 1);
2427 ioctl (XFASTINT (p
->infd
), TIOCGLTC
, &lc
);
2428 send_process (proc
, &lc
.t_suspc
, 1);
2430 #endif /* ! defined (SIGTSTP) */
2433 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
2435 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
2442 ioctl (XFASTINT (p
->infd
), TCGETA
, &t
);
2443 send_process (proc
, &t
.c_cc
[VINTR
], 1);
2446 ioctl (XFASTINT (p
->infd
), TCGETA
, &t
);
2447 send_process (proc
, &t
.c_cc
[VQUIT
], 1);
2451 ioctl (XFASTINT (p
->infd
), TCGETA
, &t
);
2452 send_process (proc
, &t
.c_cc
[VSWTCH
], 1);
2454 #endif /* ! defined (SIGTSTP) */
2456 #else /* ! defined (TCGETA) */
2457 Your configuration files are messed up
.
2458 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
2459 you'd better be using one of the alternatives above! */
2460 #endif /* ! defined (TCGETA) */
2461 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
2462 #endif /* ! defined HAVE_TERMIOS */
2463 #endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
2466 /* Get the pgrp using the tty itself, if we have that.
2467 Otherwise, use the pty to get the pgrp.
2468 On pfa systems, saka@pfu.fujitsu.co.JP writes:
2469 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
2470 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
2471 His patch indicates that if TIOCGPGRP returns an error, then
2472 we should just assume that p->pid is also the process group id. */
2476 if (!NILP (p
->subtty
))
2477 err
= ioctl (XFASTINT (p
->subtty
), TIOCGPGRP
, &gid
);
2479 err
= ioctl (XFASTINT (p
->infd
), TIOCGPGRP
, &gid
);
2483 gid
= - XFASTINT (p
->pid
);
2484 #endif /* ! defined (pfa) */
2490 #else /* ! defined (TIOCGPGRP ) */
2491 /* Can't select pgrps on this system, so we know that
2492 the child itself heads the pgrp. */
2493 gid
= - XFASTINT (p
->pid
);
2494 #endif /* ! defined (TIOCGPGRP ) */
2497 gid
= - XFASTINT (p
->pid
);
2503 p
->raw_status_low
= Qnil
;
2504 p
->raw_status_high
= Qnil
;
2506 XSETINT (p
->tick
, ++process_tick
);
2510 #endif /* ! defined (SIGCONT) */
2513 send_process (proc
, "\003", 1); /* ^C */
2518 send_process (proc
, "\031", 1); /* ^Y */
2523 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
2526 flush_pending_output (XFASTINT (p
->infd
));
2530 /* If we don't have process groups, send the signal to the immediate
2531 subprocess. That isn't really right, but it's better than any
2532 obvious alternative. */
2535 kill (XFASTINT (p
->pid
), signo
);
2539 /* gid may be a pid, or minus a pgrp's number */
2541 if (!NILP (current_group
))
2542 ioctl (XFASTINT (p
->infd
), TIOCSIGSEND
, signo
);
2545 gid
= - XFASTINT (p
->pid
);
2548 #else /* ! defined (TIOCSIGSEND) */
2549 EMACS_KILLPG (-gid
, signo
);
2550 #endif /* ! defined (TIOCSIGSEND) */
2553 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
2554 "Interrupt process PROCESS. May be process or name of one.\n\
2555 PROCESS may be a process, a buffer, or the name of a process or buffer.\n\
2556 Nil or no arg means current buffer's process.\n\
2557 Second arg CURRENT-GROUP non-nil means send signal to\n\
2558 the current process-group of the process's controlling terminal\n\
2559 rather than to the process's own process group.\n\
2560 If the process is a shell, this means interrupt current subjob\n\
2561 rather than the shell.")
2562 (process
, current_group
)
2563 Lisp_Object process
, current_group
;
2565 process_send_signal (process
, SIGINT
, current_group
, 0);
2569 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
2570 "Kill process PROCESS. May be process or name of one.\n\
2571 See function `interrupt-process' for more details on usage.")
2572 (process
, current_group
)
2573 Lisp_Object process
, current_group
;
2575 process_send_signal (process
, SIGKILL
, current_group
, 0);
2579 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
2580 "Send QUIT signal to process PROCESS. May be process or name of one.\n\
2581 See function `interrupt-process' for more details on usage.")
2582 (process
, current_group
)
2583 Lisp_Object process
, current_group
;
2585 process_send_signal (process
, SIGQUIT
, current_group
, 0);
2589 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
2590 "Stop process PROCESS. May be process or name of one.\n\
2591 See function `interrupt-process' for more details on usage.")
2592 (process
, current_group
)
2593 Lisp_Object process
, current_group
;
2596 error ("no SIGTSTP support");
2598 process_send_signal (process
, SIGTSTP
, current_group
, 0);
2603 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
2604 "Continue process PROCESS. May be process or name of one.\n\
2605 See function `interrupt-process' for more details on usage.")
2606 (process
, current_group
)
2607 Lisp_Object process
, current_group
;
2610 process_send_signal (process
, SIGCONT
, current_group
, 0);
2612 error ("no SIGCONT support");
2617 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
2618 2, 2, "nProcess number: \nnSignal code: ",
2619 "Send the process with number PID the signal with code CODE.\n\
2620 Both PID and CODE are integers.")
2622 Lisp_Object pid
, sig
;
2624 CHECK_NUMBER (pid
, 0);
2625 CHECK_NUMBER (sig
, 1);
2626 return make_number (kill (XINT (pid
), XINT (sig
)));
2629 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
2630 "Make PROCESS see end-of-file in its input.\n\
2631 Eof comes after any text already sent to it.\n\
2632 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2633 nil, indicating the current buffer's process.")
2635 Lisp_Object process
;
2639 proc
= get_process (process
);
2641 /* Make sure the process is really alive. */
2642 if (! NILP (XPROCESS (proc
)->raw_status_low
))
2643 update_status (XPROCESS (proc
));
2644 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
2645 error ("Process %s not running", XSTRING (XPROCESS (proc
)->name
)->data
);
2647 /* Sending a zero-length record is supposed to mean eof
2648 when TIOCREMOTE is turned on. */
2652 write (XFASTINT (XPROCESS (proc
)->outfd
), buf
, 0);
2654 #else /* did not do TOICREMOTE */
2656 send_process (proc
, "\032", 1); /* ^z */
2658 if (!NILP (XPROCESS (proc
)->pty_flag
))
2659 send_process (proc
, "\004", 1);
2662 close (XPROCESS (proc
)->outfd
);
2663 XFASTINT (XPROCESS (proc
)->outfd
) = open (NULL_DEVICE
, O_WRONLY
);
2666 #endif /* did not do TOICREMOTE */
2670 /* Kill all processes associated with `buffer'.
2671 If `buffer' is nil, kill all processes */
2673 kill_buffer_processes (buffer
)
2676 Lisp_Object tail
, proc
;
2678 for (tail
= Vprocess_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2679 tail
= XCONS (tail
)->cdr
)
2681 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
2682 if (XGCTYPE (proc
) == Lisp_Process
2683 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
2685 if (NETCONN_P (proc
))
2686 deactivate_process (proc
);
2687 else if (XFASTINT (XPROCESS (proc
)->infd
))
2688 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
2693 /* On receipt of a signal that a child status has changed,
2694 loop asking about children with changed statuses until
2695 the system says there are no more.
2696 All we do is change the status;
2697 we do not run sentinels or print notifications.
2698 That is saved for the next time keyboard input is done,
2699 in order to avoid timing errors. */
2701 /** WARNING: this can be called during garbage collection.
2702 Therefore, it must not be fooled by the presence of mark bits in
2705 /** USG WARNING: Although it is not obvious from the documentation
2706 in signal(2), on a USG system the SIGCLD handler MUST NOT call
2707 signal() before executing at least one wait(), otherwise the handler
2708 will be called again, resulting in an infinite loop. The relevant
2709 portion of the documentation reads "SIGCLD signals will be queued
2710 and the signal-catching function will be continually reentered until
2711 the queue is empty". Invoking signal() causes the kernel to reexamine
2712 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
2715 sigchld_handler (signo
)
2718 int old_errno
= errno
;
2720 register struct Lisp_Process
*p
;
2721 extern EMACS_TIME
*input_available_clear_time
;
2725 sigheld
|= sigbit (SIGCHLD
);
2737 #endif /* no WUNTRACED */
2738 /* Keep trying to get a status until we get a definitive result. */
2742 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
2744 while (pid
<= 0 && errno
== EINTR
);
2748 /* A real failure. We have done all our job, so return. */
2750 /* USG systems forget handlers when they are used;
2751 must reestablish each time */
2753 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
2756 sigheld
&= ~sigbit (SIGCHLD
);
2764 #endif /* no WNOHANG */
2766 /* Find the process that signaled us, and record its status. */
2769 for (tail
= Vprocess_alist
; XSYMBOL (tail
) != XSYMBOL (Qnil
); tail
= XCONS (tail
)->cdr
)
2771 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
2772 p
= XPROCESS (proc
);
2773 if (EQ (p
->childp
, Qt
) && XFASTINT (p
->pid
) == pid
)
2778 /* Look for an asynchronous process whose pid hasn't been filled
2781 for (tail
= Vprocess_alist
; XSYMBOL (tail
) != XSYMBOL (Qnil
); tail
= XCONS (tail
)->cdr
)
2783 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
2784 p
= XPROCESS (proc
);
2785 if (XTYPE (p
->pid
) == Lisp_Int
&& XINT (p
->pid
) == -1)
2790 /* Change the status of the process that was found. */
2793 union { int i
; WAITTYPE wt
; } u
;
2795 XSETINT (p
->tick
, ++process_tick
);
2797 XFASTINT (p
->raw_status_low
) = u
.i
& 0xffff;
2798 XFASTINT (p
->raw_status_high
) = u
.i
>> 16;
2800 /* If process has terminated, stop waiting for its output. */
2801 if (WIFSIGNALED (w
) || WIFEXITED (w
))
2802 if (XFASTINT (p
->infd
))
2803 FD_CLR (XFASTINT (p
->infd
), &input_wait_mask
);
2805 /* Tell wait_reading_process_input that it needs to wake up and
2807 if (input_available_clear_time
)
2808 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
2811 /* There was no asynchronous process found for that id. Check
2812 if we have a synchronous process. */
2815 synch_process_alive
= 0;
2817 /* Report the status of the synchronous process. */
2819 synch_process_retcode
= WRETCODE (w
);
2820 else if (WIFSIGNALED (w
))
2822 synch_process_death
= (char *) sys_siglist
[WTERMSIG (w
)];
2824 synch_process_death
= sys_errlist
[WTERMSIG (w
)];
2827 /* Tell wait_reading_process_input that it needs to wake up and
2829 if (input_available_clear_time
)
2830 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
2833 /* On some systems, we must return right away.
2834 If any more processes want to signal us, we will
2836 Otherwise (on systems that have WNOHANG), loop around
2837 to use up all the processes that have something to tell us. */
2838 #if defined (USG) && ! (defined (HPUX) && defined (WNOHANG))
2840 signal (signo
, sigchld_handler
);
2844 #endif /* USG, but not HPUX with WNOHANG */
2850 exec_sentinel_unwind (data
)
2853 XPROCESS (XCONS (data
)->car
)->sentinel
= XCONS (data
)->cdr
;
2858 exec_sentinel (proc
, reason
)
2859 Lisp_Object proc
, reason
;
2861 Lisp_Object sentinel
;
2862 register struct Lisp_Process
*p
= XPROCESS (proc
);
2863 int count
= specpdl_ptr
- specpdl
;
2865 sentinel
= p
->sentinel
;
2866 if (NILP (sentinel
))
2869 /* Zilch the sentinel while it's running, to avoid recursive invocations;
2870 assure that it gets restored no matter how the sentinel exits. */
2872 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
2873 /* Inhibit quit so that random quits don't screw up a running filter. */
2874 specbind (Qinhibit_quit
, Qt
);
2875 call2 (sentinel
, proc
, reason
);
2879 /* Report all recent events of a change in process status
2880 (either run the sentinel or output a message).
2881 This is done while Emacs is waiting for keyboard input. */
2885 register Lisp_Object proc
, buffer
;
2886 Lisp_Object tail
= Qnil
;
2887 Lisp_Object msg
= Qnil
;
2888 struct gcpro gcpro1
, gcpro2
;
2890 /* We need to gcpro tail; if read_process_output calls a filter
2891 which deletes a process and removes the cons to which tail points
2892 from Vprocess_alist, and then causes a GC, tail is an unprotected
2896 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
2899 register struct Lisp_Process
*p
;
2901 proc
= Fcdr (Fcar (tail
));
2902 p
= XPROCESS (proc
);
2904 if (XINT (p
->tick
) != XINT (p
->update_tick
))
2906 XSETINT (p
->update_tick
, XINT (p
->tick
));
2908 /* If process is still active, read any output that remains. */
2909 if (XFASTINT (p
->infd
))
2910 while (read_process_output (proc
, XFASTINT (p
->infd
)) > 0);
2914 /* Get the text to use for the message. */
2915 if (!NILP (p
->raw_status_low
))
2917 msg
= status_message (p
->status
);
2919 /* If process is terminated, deactivate it or delete it. */
2921 if (XTYPE (p
->status
) == Lisp_Cons
)
2922 symbol
= XCONS (p
->status
)->car
;
2924 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
2925 || EQ (symbol
, Qclosed
))
2927 if (delete_exited_processes
)
2928 remove_process (proc
);
2930 deactivate_process (proc
);
2933 /* Now output the message suitably. */
2934 if (!NILP (p
->sentinel
))
2935 exec_sentinel (proc
, msg
);
2936 /* Don't bother with a message in the buffer
2937 when a process becomes runnable. */
2938 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
2940 Lisp_Object ro
= XBUFFER (buffer
)->read_only
;
2942 struct buffer
*old
= current_buffer
;
2945 /* Avoid error if buffer is deleted
2946 (probably that's why the process is dead, too) */
2947 if (NILP (XBUFFER (buffer
)->name
))
2949 Fset_buffer (buffer
);
2951 /* Insert new output into buffer
2952 at the current end-of-output marker,
2953 thus preserving logical ordering of input and output. */
2954 if (XMARKER (p
->mark
)->buffer
)
2955 SET_PT (marker_position (p
->mark
));
2958 if (point
<= opoint
)
2959 opoint
+= XSTRING (msg
)->size
+ XSTRING (p
->name
)->size
+ 10;
2961 tem
= current_buffer
->read_only
;
2962 current_buffer
->read_only
= Qnil
;
2963 insert_string ("\nProcess ");
2964 Finsert (1, &p
->name
);
2965 insert_string (" ");
2967 current_buffer
->read_only
= tem
;
2968 Fset_marker (p
->mark
, make_number (point
), p
->buffer
);
2971 set_buffer_internal (old
);
2976 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
2977 redisplay_preserve_echo_area ();
2979 update_tick
= process_tick
;
2990 if (! noninteractive
|| initialized
)
2992 signal (SIGCHLD
, sigchld_handler
);
2995 FD_ZERO (&input_wait_mask
);
2996 FD_SET (0, &input_wait_mask
);
2997 Vprocess_alist
= Qnil
;
2998 for (i
= 0; i
< MAXDESC
; i
++)
3000 chan_process
[i
] = Qnil
;
3001 proc_buffered_char
[i
] = -1;
3008 stream_process
= intern ("stream");
3010 Qprocessp
= intern ("processp");
3011 staticpro (&Qprocessp
);
3012 Qrun
= intern ("run");
3014 Qstop
= intern ("stop");
3016 Qsignal
= intern ("signal");
3017 staticpro (&Qsignal
);
3019 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
3022 Qexit = intern ("exit");
3023 staticpro (&Qexit); */
3025 Qopen
= intern ("open");
3027 Qclosed
= intern ("closed");
3028 staticpro (&Qclosed
);
3030 staticpro (&Vprocess_alist
);
3032 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
3033 "*Non-nil means delete processes immediately when they exit.\n\
3034 nil means don't delete them until `list-processes' is run.");
3036 delete_exited_processes
= 1;
3038 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
3039 "Control type of device used to communicate with subprocesses.\n\
3040 Values are nil to use a pipe, and t or 'pty for a pty. Note that if\n\
3041 pty's are not available, this variable will be ignored. The value takes\n\
3042 effect when `start-process' is called.");
3043 Vprocess_connection_type
= Qt
;
3045 defsubr (&Sprocessp
);
3046 defsubr (&Sget_process
);
3047 defsubr (&Sget_buffer_process
);
3048 defsubr (&Sdelete_process
);
3049 defsubr (&Sprocess_status
);
3050 defsubr (&Sprocess_exit_status
);
3051 defsubr (&Sprocess_id
);
3052 defsubr (&Sprocess_name
);
3053 defsubr (&Sprocess_command
);
3054 defsubr (&Sset_process_buffer
);
3055 defsubr (&Sprocess_buffer
);
3056 defsubr (&Sprocess_mark
);
3057 defsubr (&Sset_process_filter
);
3058 defsubr (&Sprocess_filter
);
3059 defsubr (&Sset_process_sentinel
);
3060 defsubr (&Sprocess_sentinel
);
3061 defsubr (&Sprocess_kill_without_query
);
3062 defsubr (&Slist_processes
);
3063 defsubr (&Sprocess_list
);
3064 defsubr (&Sstart_process
);
3066 defsubr (&Sopen_network_stream
);
3067 #endif /* HAVE_SOCKETS */
3068 defsubr (&Saccept_process_output
);
3069 defsubr (&Sprocess_send_region
);
3070 defsubr (&Sprocess_send_string
);
3071 defsubr (&Sinterrupt_process
);
3072 defsubr (&Skill_process
);
3073 defsubr (&Squit_process
);
3074 defsubr (&Sstop_process
);
3075 defsubr (&Scontinue_process
);
3076 defsubr (&Sprocess_send_eof
);
3077 defsubr (&Ssignal_process
);
3078 defsubr (&Swaiting_for_user_input_p
);
3079 /* defsubr (&Sprocess_connection); */
3083 #else /* not subprocesses */
3085 #include <sys/types.h>
3089 #include "systime.h"
3090 #include "termopts.h"
3092 extern int frame_garbaged
;
3095 /* As described above, except assuming that there are no subprocesses:
3097 Wait for timeout to elapse and/or keyboard input to be available.
3100 timeout in seconds, or
3101 zero for no limit, or
3102 -1 means gobble data immediately available but don't wait for any.
3104 read_kbd is a Lisp_Object:
3105 0 to ignore keyboard input, or
3106 1 to return when input is available, or
3107 -1 means caller will actually read the input, so don't throw to
3109 We know that read_kbd will never be a Lisp_Process, since
3110 `subprocesses' isn't defined.
3112 do_display != 0 means redisplay should be done to show subprocess
3113 output that arrives. This version of the function ignores it.
3115 Return true iff we received input from any process. */
3118 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
3119 int time_limit
, microsecs
;
3120 Lisp_Object read_kbd
;
3123 EMACS_TIME end_time
, timeout
, *timeout_p
;
3126 /* What does time_limit really mean? */
3127 if (time_limit
|| microsecs
)
3129 /* It's not infinite. */
3130 timeout_p
= &timeout
;
3132 if (time_limit
== -1)
3133 /* In fact, it's zero. */
3134 EMACS_SET_SECS_USECS (timeout
, 0, 0);
3136 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
3138 /* How far in the future is that? */
3139 EMACS_GET_TIME (end_time
);
3140 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
3143 /* It's infinite. */
3146 /* Turn off periodic alarms (in case they are in use)
3147 because the select emulator uses alarms. */
3154 waitchannels
= XINT (read_kbd
) ? 1 : 0;
3156 /* If calling from keyboard input, do not quit
3157 since we want to return C-g as an input character.
3158 Otherwise, do pending quit if requested. */
3159 if (XINT (read_kbd
) >= 0)
3164 EMACS_GET_TIME (*timeout_p
);
3165 EMACS_SUB_TIME (*timeout_p
, end_time
, *timeout_p
);
3166 if (EMACS_TIME_NEG_P (*timeout_p
))
3170 /* Cause C-g and alarm signals to take immediate action,
3171 and cause input available signals to zero out timeout. */
3172 if (XINT (read_kbd
) < 0)
3173 set_waiting_for_input (&timeout
);
3175 /* If a frame has been newly mapped and needs updating,
3176 reprocess its display stuff. */
3178 redisplay_preserve_echo_area ();
3180 if (XINT (read_kbd
) && detect_input_pending ())
3183 nfds
= select (1, &waitchannels
, 0, 0, timeout_p
);
3185 /* Make C-g and alarm signals set flags again */
3186 clear_waiting_for_input ();
3188 /* If we woke up due to SIGWINCH, actually change size now. */
3189 do_pending_window_change ();
3193 /* If the system call was interrupted, then go around the
3199 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
3200 /* System sometimes fails to deliver SIGIO. */
3201 kill (getpid (), SIGIO
);
3204 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
3208 /* If we have timed out (nfds == 0) or found some input (nfds > 0),
3220 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
3221 /* Don't confused make-docfile by having two doc strings for this function.
3222 make-docfile does not pay attention to #if, for good reason! */
3225 register Lisp_Object name
;
3230 /* Kill all processes associated with `buffer'.
3231 If `buffer' is nil, kill all processes.
3232 Since we have no subprocesses, this does nothing. */
3234 kill_buffer_processes (buffer
)
3245 defsubr (&Sget_buffer_process
);
3249 #endif /* not subprocesses */