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 /* TERM is a poor-man's SLIP, used on Linux. */
54 /* DGUX inet_addr returns a 'struct in_addr'. */
56 #define IN_ADDR struct in_addr
57 #define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
59 #define IN_ADDR unsigned long
60 #define NUMERIC_ADDR_ERROR (numeric_addr == -1)
63 #if defined(BSD) || defined(STRIDE)
64 #include <sys/ioctl.h>
65 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
67 #endif /* HAVE_PTYS and no O_NDELAY */
68 #endif /* BSD or STRIDE */
70 #ifdef BROKEN_O_NONBLOCK
72 #endif /* BROKEN_O_NONBLOCK */
79 #include <sys/sysmacros.h> /* for "minor" */
89 #include "termhooks.h"
94 Lisp_Object Qprocessp
;
95 Lisp_Object Qrun
, Qstop
, Qsignal
, Qopen
, Qclosed
;
96 /* Qexit is declared and initialized in eval.c. */
98 /* a process object is a network connection when its childp field is neither
99 Qt nor Qnil but is instead a string (name of foreign host we
100 are connected to + name of port we are connected to) */
103 static Lisp_Object stream_process
;
105 #define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String)
107 #define NETCONN_P(p) 0
108 #endif /* HAVE_SOCKETS */
110 /* Define first descriptor number available for subprocesses. */
112 #define FIRST_PROC_DESC 1
114 #define FIRST_PROC_DESC 3
117 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
120 #if !defined (SIGCHLD) && defined (SIGCLD)
121 #define SIGCHLD SIGCLD
124 #include "syssignal.h"
130 extern char *sys_errlist
[];
135 extern char *sys_siglist
[];
138 char *sys_siglist
[] =
144 "illegal instruction",
148 "floating point exception",
151 "segmentation violation",
152 "bad argument to system call",
153 "write on a pipe with no one to read it",
155 "software termination signal from kill",
157 "sendable stop signal not from tty",
158 "stop signal from tty",
159 "continue a stopped process",
160 "child status has changed",
161 "background read attempted from control tty",
162 "background write attempted from control tty",
163 "input record available at control tty",
164 "exceeded CPU time limit",
165 "exceeded file size limit"
170 /* t means use pty, nil means use a pipe,
171 maybe other values to come. */
172 static Lisp_Object Vprocess_connection_type
;
176 #include <sys/socket.h>
180 /* Number of events of change of status of a process. */
181 static int process_tick
;
183 /* Number of events for which the user or sentinel has been notified. */
184 static int update_tick
;
187 /* We could get this from param.h, but better not to depend on finding that.
188 And better not to risk that it might define other symbols used in this
191 #define MAXDESC FD_SETSIZE
195 #define SELECT_TYPE fd_set
196 #else /* no FD_SET */
198 #define SELECT_TYPE int
200 /* Define the macros to access a single-int bitmap of descriptors. */
201 #define FD_SET(n, p) (*(p) |= (1 << (n)))
202 #define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
203 #define FD_ISSET(n, p) (*(p) & (1 << (n)))
204 #define FD_ZERO(p) (*(p) = 0)
205 #endif /* no FD_SET */
207 /* Mask of bits indicating the descriptors that we wait for input on */
209 static SELECT_TYPE input_wait_mask
;
211 /* Descriptor to use for keyboard input. */
212 static int keyboard_descriptor
;
214 /* Nonzero means delete a process right away if it exits. */
215 static int delete_exited_processes
;
217 /* Indexed by descriptor, gives the process (if any) for that descriptor */
218 static Lisp_Object chan_process
[MAXDESC
];
220 /* Alist of elements (NAME . PROCESS) */
221 static Lisp_Object Vprocess_alist
;
223 /* Buffered-ahead input char from process, indexed by channel.
224 -1 means empty (no char is buffered).
225 Used on sys V where the only way to tell if there is any
226 output from the process is to read at least one char.
227 Always -1 on systems that support FIONREAD. */
229 static int proc_buffered_char
[MAXDESC
];
231 static Lisp_Object
get_process ();
233 /* Compute the Lisp form of the process status, p->status, from
234 the numeric status that was returned by `wait'. */
236 Lisp_Object
status_convert ();
239 struct Lisp_Process
*p
;
241 union { int i
; WAITTYPE wt
; } u
;
242 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
243 p
->status
= status_convert (u
.wt
);
244 p
->raw_status_low
= Qnil
;
245 p
->raw_status_high
= Qnil
;
248 /* Convert a process status word in Unix format to
249 the list that we use internally. */
256 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
257 else if (WIFEXITED (w
))
258 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
259 WCOREDUMP (w
) ? Qt
: Qnil
));
260 else if (WIFSIGNALED (w
))
261 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
262 WCOREDUMP (w
) ? Qt
: Qnil
));
267 /* Given a status-list, extract the three pieces of information
268 and store them individually through the three pointers. */
271 decode_status (l
, symbol
, code
, coredump
)
279 if (XTYPE (l
) == Lisp_Symbol
)
287 *symbol
= XCONS (l
)->car
;
288 tem
= XCONS (l
)->cdr
;
289 *code
= XFASTINT (XCONS (tem
)->car
);
290 tem
= XCONS (tem
)->cdr
;
291 *coredump
= !NILP (tem
);
295 /* Return a string describing a process status list. */
298 status_message (status
)
303 Lisp_Object string
, string2
;
305 decode_status (status
, &symbol
, &code
, &coredump
);
307 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
310 string
= build_string (code
< NSIG
? sys_siglist
[code
] : "unknown");
312 string
= build_string (code
< NSIG
? sys_errlist
[code
] : "unknown");
314 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
315 XSTRING (string
)->data
[0] = DOWNCASE (XSTRING (string
)->data
[0]);
316 return concat2 (string
, string2
);
318 else if (EQ (symbol
, Qexit
))
321 return build_string ("finished\n");
322 string
= Fnumber_to_string (make_number (code
));
323 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
324 return concat2 (build_string ("exited abnormally with code "),
325 concat2 (string
, string2
));
328 return Fcopy_sequence (Fsymbol_name (symbol
));
333 /* Open an available pty, returning a file descriptor.
334 Return -1 on failure.
335 The file name of the terminal corresponding to the pty
336 is left in the variable pty_name. */
347 /* Some systems name their pseudoterminals so that there are gaps in
348 the usual sequence - for example, on HP9000/S700 systems, there
349 are no pseudoterminals with names ending in 'f'. So we wait for
350 three failures in a row before deciding that we've reached the
352 int failed_count
= 0;
357 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
358 for (i
= 0; i
< 16; i
++)
361 #ifdef PTY_NAME_SPRINTF
364 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
365 #endif /* no PTY_NAME_SPRINTF */
369 #else /* no PTY_OPEN */
371 /* Unusual IRIS code */
372 *ptyv
= open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
375 if (fstat (fd
, &stb
) < 0)
378 if (stat (pty_name
, &stb
) < 0)
381 if (failed_count
>= 3)
387 fd
= open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
389 fd
= open (pty_name
, O_RDWR
| O_NDELAY
, 0);
391 #endif /* not IRIS */
392 #endif /* no PTY_OPEN */
396 /* check to make certain that both sides are available
397 this avoids a nasty yet stupid bug in rlogins */
398 #ifdef PTY_TTY_NAME_SPRINTF
401 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
402 #endif /* no PTY_TTY_NAME_SPRINTF */
404 if (access (pty_name
, 6) != 0)
407 #if !defined(IRIS) && !defined(__sgi)
413 #endif /* not UNIPLUS */
420 #endif /* HAVE_PTYS */
426 register Lisp_Object val
, tem
, name1
;
427 register struct Lisp_Process
*p
;
431 /* size of process structure includes the vector header,
432 so deduct for that. But struct Lisp_Vector includes the first
433 element, thus deducts too much, so add it back. */
434 val
= Fmake_vector (make_number ((sizeof (struct Lisp_Process
)
435 - sizeof (struct Lisp_Vector
)
436 + sizeof (Lisp_Object
))
437 / sizeof (Lisp_Object
)),
439 XSETTYPE (val
, Lisp_Process
);
442 XSET (p
->infd
, Lisp_Int
, -1);
443 XSET (p
->outfd
, Lisp_Int
, -1);
444 XFASTINT (p
->pid
) = 0;
445 XFASTINT (p
->tick
) = 0;
446 XFASTINT (p
->update_tick
) = 0;
447 p
->raw_status_low
= Qnil
;
448 p
->raw_status_high
= Qnil
;
450 p
->mark
= Fmake_marker ();
452 /* If name is already in use, modify it until it is unused. */
457 tem
= Fget_process (name1
);
458 if (NILP (tem
)) break;
459 sprintf (suffix
, "<%d>", i
);
460 name1
= concat2 (name
, build_string (suffix
));
464 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
468 remove_process (proc
)
469 register Lisp_Object proc
;
471 register Lisp_Object pair
;
473 pair
= Frassq (proc
, Vprocess_alist
);
474 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
475 Fset_marker (XPROCESS (proc
)->mark
, Qnil
, Qnil
);
477 deactivate_process (proc
);
480 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
481 "Return t if OBJECT is a process.")
485 return XTYPE (obj
) == Lisp_Process
? Qt
: Qnil
;
488 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
489 "Return the process named NAME, or nil if there is none.")
491 register Lisp_Object name
;
493 if (XTYPE (name
) == Lisp_Process
)
495 CHECK_STRING (name
, 0);
496 return Fcdr (Fassoc (name
, Vprocess_alist
));
499 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
500 "Return the (or, a) process associated with BUFFER.\n\
501 BUFFER may be a buffer or the name of one.")
503 register Lisp_Object name
;
505 register Lisp_Object buf
, tail
, proc
;
507 if (NILP (name
)) return Qnil
;
508 buf
= Fget_buffer (name
);
509 if (NILP (buf
)) return Qnil
;
511 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
513 proc
= Fcdr (Fcar (tail
));
514 if (XTYPE (proc
) == Lisp_Process
&& EQ (XPROCESS (proc
)->buffer
, buf
))
520 /* This is how commands for the user decode process arguments. It
521 accepts a process, a process name, a buffer, a buffer name, or nil.
522 Buffers denote the first process in the buffer, and nil denotes the
527 register Lisp_Object name
;
529 register Lisp_Object proc
;
531 proc
= Fget_buffer_process (Fcurrent_buffer ());
534 proc
= Fget_process (name
);
536 proc
= Fget_buffer_process (Fget_buffer (name
));
543 error ("Current buffer has no process");
545 error ("Process %s does not exist", XSTRING (name
)->data
);
549 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
550 "Delete PROCESS: kill it and forget about it immediately.\n\
551 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
552 nil, indicating the current buffer's process.")
554 register Lisp_Object proc
;
556 proc
= get_process (proc
);
557 XPROCESS (proc
)->raw_status_low
= Qnil
;
558 XPROCESS (proc
)->raw_status_high
= Qnil
;
559 if (NETCONN_P (proc
))
561 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
562 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
564 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
566 Fkill_process (proc
, Qnil
);
567 /* Do this now, since remove_process will make sigchld_handler do nothing. */
568 XPROCESS (proc
)->status
569 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
570 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
573 remove_process (proc
);
577 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
578 "Return the status of PROCESS: a symbol, one of these:\n\
579 run -- for a process that is running.\n\
580 stop -- for a process stopped but continuable.\n\
581 exit -- for a process that has exited.\n\
582 signal -- for a process that has got a fatal signal.\n\
583 open -- for a network stream connection that is open.\n\
584 closed -- for a network stream connection that is closed.\n\
585 nil -- if arg is a process name and no such process exists.\n\
586 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
587 nil, indicating the current buffer's process.")
589 register Lisp_Object proc
;
591 register struct Lisp_Process
*p
;
592 register Lisp_Object status
;
593 proc
= get_process (proc
);
597 if (!NILP (p
->raw_status_low
))
600 if (XTYPE (status
) == Lisp_Cons
)
601 status
= XCONS (status
)->car
;
602 if (NETCONN_P (proc
))
604 if (EQ (status
, Qrun
))
606 else if (EQ (status
, Qexit
))
612 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
614 "Return the exit status of PROCESS or the signal number that killed it.\n\
615 If PROCESS has not yet exited or died, return 0.")
617 register Lisp_Object proc
;
619 CHECK_PROCESS (proc
, 0);
620 if (!NILP (XPROCESS (proc
)->raw_status_low
))
621 update_status (XPROCESS (proc
));
622 if (XTYPE (XPROCESS (proc
)->status
) == Lisp_Cons
)
623 return XCONS (XCONS (XPROCESS (proc
)->status
)->cdr
)->car
;
624 return make_number (0);
627 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
628 "Return the process id of PROCESS.\n\
629 This is the pid of the Unix process which PROCESS uses or talks to.\n\
630 For a network connection, this value is nil.")
632 register Lisp_Object proc
;
634 CHECK_PROCESS (proc
, 0);
635 return XPROCESS (proc
)->pid
;
638 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
639 "Return the name of PROCESS, as a string.\n\
640 This is the name of the program invoked in PROCESS,\n\
641 possibly modified to make it unique among process names.")
643 register Lisp_Object proc
;
645 CHECK_PROCESS (proc
, 0);
646 return XPROCESS (proc
)->name
;
649 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
650 "Return the command that was executed to start PROCESS.\n\
651 This is a list of strings, the first string being the program executed\n\
652 and the rest of the strings being the arguments given to it.\n\
653 For a non-child channel, this is nil.")
655 register Lisp_Object proc
;
657 CHECK_PROCESS (proc
, 0);
658 return XPROCESS (proc
)->command
;
661 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
663 "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
665 register Lisp_Object proc
, buffer
;
667 CHECK_PROCESS (proc
, 0);
669 CHECK_BUFFER (buffer
, 1);
670 XPROCESS (proc
)->buffer
= buffer
;
674 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
676 "Return the buffer PROCESS is associated with.\n\
677 Output from PROCESS is inserted in this buffer\n\
678 unless PROCESS has a filter.")
680 register Lisp_Object proc
;
682 CHECK_PROCESS (proc
, 0);
683 return XPROCESS (proc
)->buffer
;
686 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
688 "Return the marker for the end of the last output from PROCESS.")
690 register Lisp_Object proc
;
692 CHECK_PROCESS (proc
, 0);
693 return XPROCESS (proc
)->mark
;
696 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
698 "Give PROCESS the filter function FILTER; nil means no filter.\n\
699 t means stop accepting output from the process.\n\
700 When a process has a filter, each time it does output\n\
701 the entire string of output is passed to the filter.\n\
702 The filter gets two arguments: the process and the string of output.\n\
703 If the process has a filter, its buffer is not used for output.")
705 register Lisp_Object proc
, filter
;
707 CHECK_PROCESS (proc
, 0);
709 FD_CLR (XINT (XPROCESS (proc
)->infd
), &input_wait_mask
);
710 else if (EQ (XPROCESS (proc
)->filter
, Qt
))
711 FD_SET (XINT (XPROCESS (proc
)->infd
), &input_wait_mask
);
712 XPROCESS (proc
)->filter
= filter
;
716 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
718 "Returns the filter function of PROCESS; nil if none.\n\
719 See `set-process-filter' for more info on filter functions.")
721 register Lisp_Object proc
;
723 CHECK_PROCESS (proc
, 0);
724 return XPROCESS (proc
)->filter
;
727 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
729 "Give PROCESS the sentinel SENTINEL; nil for none.\n\
730 The sentinel is called as a function when the process changes state.\n\
731 It gets two arguments: the process, and a string describing the change.")
733 register Lisp_Object proc
, sentinel
;
735 CHECK_PROCESS (proc
, 0);
736 XPROCESS (proc
)->sentinel
= sentinel
;
740 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
742 "Return the sentinel of PROCESS; nil if none.\n\
743 See `set-process-sentinel' for more info on sentinels.")
745 register Lisp_Object proc
;
747 CHECK_PROCESS (proc
, 0);
748 return XPROCESS (proc
)->sentinel
;
751 DEFUN ("process-kill-without-query", Fprocess_kill_without_query
,
752 Sprocess_kill_without_query
, 1, 2, 0,
753 "Say no query needed if PROCESS is running when Emacs is exited.\n\
754 Optional second argument if non-nill says to require a query.\n\
755 Value is t if a query was formerly required.")
757 register Lisp_Object proc
, value
;
761 CHECK_PROCESS (proc
, 0);
762 tem
= XPROCESS (proc
)->kill_without_query
;
763 XPROCESS (proc
)->kill_without_query
= Fnull (value
);
768 #if 0 /* Turned off because we don't currently record this info
769 in the process. Perhaps add it. */
770 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
771 "Return the connection type of `PROCESS'.\n\
772 The value is `nil' for a pipe,\n\
773 `t' or `pty' for a pty, or `stream' for a socket connection.")
777 return XPROCESS (process
)->type
;
784 register Lisp_Object tail
, tem
;
785 Lisp_Object proc
, minspace
, tem1
;
786 register struct buffer
*old
= current_buffer
;
787 register struct Lisp_Process
*p
;
791 XFASTINT (minspace
) = 1;
793 set_buffer_internal (XBUFFER (Vstandard_output
));
794 Fbuffer_disable_undo (Vstandard_output
);
796 current_buffer
->truncate_lines
= Qt
;
799 Proc Status Buffer Command\n\
800 ---- ------ ------ -------\n", -1);
802 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
806 proc
= Fcdr (Fcar (tail
));
808 if (NILP (p
->childp
))
811 Finsert (1, &p
->name
);
812 Findent_to (make_number (13), minspace
);
814 if (!NILP (p
->raw_status_low
))
817 if (XTYPE (p
->status
) == Lisp_Cons
)
818 symbol
= XCONS (p
->status
)->car
;
821 if (EQ (symbol
, Qsignal
))
824 tem
= Fcar (Fcdr (p
->status
));
826 if (XINT (tem
) < NSIG
)
827 write_string (sys_errlist
[XINT (tem
)], -1);
830 Fprinc (symbol
, Qnil
);
832 else if (NETCONN_P (proc
))
834 if (EQ (symbol
, Qrun
))
835 write_string ("open", -1);
836 else if (EQ (symbol
, Qexit
))
837 write_string ("closed", -1);
839 Fprinc (symbol
, Qnil
);
842 Fprinc (symbol
, Qnil
);
844 if (EQ (symbol
, Qexit
))
847 tem
= Fcar (Fcdr (p
->status
));
850 sprintf (tembuf
, " %d", XFASTINT (tem
));
851 write_string (tembuf
, -1);
855 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
856 remove_process (proc
);
858 Findent_to (make_number (22), minspace
);
859 if (NILP (p
->buffer
))
860 insert_string ("(none)");
861 else if (NILP (XBUFFER (p
->buffer
)->name
))
862 insert_string ("(Killed)");
864 Finsert (1, &XBUFFER (p
->buffer
)->name
);
866 Findent_to (make_number (37), minspace
);
868 if (NETCONN_P (proc
))
870 sprintf (tembuf
, "(network stream connection to %s)\n",
871 XSTRING (p
->childp
)->data
);
872 insert_string (tembuf
);
886 insert_string ("\n");
892 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 0, "",
893 "Display a list of all processes.\n\
894 \(Any processes listed as Exited or Signaled are actually eliminated\n\
895 after the listing is made.)")
898 internal_with_output_to_temp_buffer ("*Process List*",
899 list_processes_1
, Qnil
);
903 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
904 "Return a list of all processes.")
907 return Fmapcar (Qcdr
, Vprocess_alist
);
910 /* Starting asynchronous inferior processes. */
912 static Lisp_Object
start_process_unwind ();
914 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
915 "Start a program in a subprocess. Return the process object for it.\n\
916 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
917 NAME is name for process. It is modified if necessary to make it unique.\n\
918 BUFFER is the buffer or (buffer-name) to associate with the process.\n\
919 Process output goes at end of that buffer, unless you specify\n\
920 an output stream or filter function to handle the output.\n\
921 BUFFER may be also nil, meaning that this process is not associated\n\
923 Third arg is program file name. It is searched for as in the shell.\n\
924 Remaining arguments are strings to give program as arguments.")
927 register Lisp_Object
*args
;
929 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
931 register unsigned char *new_argv
;
934 register unsigned char **new_argv
;
937 int count
= specpdl_ptr
- specpdl
;
941 buffer
= Fget_buffer_create (buffer
);
943 /* Make sure that the child will be able to chdir to the current
944 buffer's current directory, or its unhandled equivalent. We
945 can't just have the child check for an error when it does the
946 chdir, since it's in a vfork.
948 We have to GCPRO around this because Fexpand_file_name and
949 Funhandled_file_name_directory might call a file name handling
950 function. The argument list is protected by the caller, so all
951 we really have to worry about is buffer. */
953 struct gcpro gcpro1
, gcpro2
;
955 current_dir
= current_buffer
->directory
;
957 GCPRO2 (buffer
, current_dir
);
960 expand_and_dir_to_file
961 (Funhandled_file_name_directory (current_dir
), Qnil
);
962 if (NILP (Ffile_accessible_directory_p (current_dir
)))
963 report_file_error ("Setting current directory",
964 Fcons (current_buffer
->directory
, Qnil
));
970 CHECK_STRING (name
, 0);
974 CHECK_STRING (program
, 2);
977 /* Make a one member argv with all args concatenated
978 together separated by a blank. */
979 len
= XSTRING (program
)->size
+ 2;
980 for (i
= 3; i
< nargs
; i
++)
983 CHECK_STRING (tem
, i
);
984 len
+= XSTRING (tem
)->size
+ 1; /* count the blank */
986 new_argv
= (unsigned char *) alloca (len
);
987 strcpy (new_argv
, XSTRING (program
)->data
);
988 for (i
= 3; i
< nargs
; i
++)
991 CHECK_STRING (tem
, i
);
992 strcat (new_argv
, " ");
993 strcat (new_argv
, XSTRING (tem
)->data
);
995 /* Need to add code here to check for program existence on VMS */
998 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1000 for (i
= 3; i
< nargs
; i
++)
1003 CHECK_STRING (tem
, i
);
1004 new_argv
[i
- 2] = XSTRING (tem
)->data
;
1006 new_argv
[i
- 2] = 0;
1007 new_argv
[0] = XSTRING (program
)->data
;
1009 /* If program file name is not absolute, search our path for it */
1010 if (new_argv
[0][0] != '/')
1013 openp (Vexec_path
, program
, EXEC_SUFFIXES
, &tem
, 1);
1015 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1016 new_argv
[0] = XSTRING (tem
)->data
;
1018 #endif /* not VMS */
1020 proc
= make_process (name
);
1021 /* If an error occurs and we can't start the process, we want to
1022 remove it from the process list. This means that each error
1023 check in create_process doesn't need to call remove_process
1024 itself; it's all taken care of here. */
1025 record_unwind_protect (start_process_unwind
, proc
);
1027 XPROCESS (proc
)->childp
= Qt
;
1028 XPROCESS (proc
)->command_channel_p
= Qnil
;
1029 XPROCESS (proc
)->buffer
= buffer
;
1030 XPROCESS (proc
)->sentinel
= Qnil
;
1031 XPROCESS (proc
)->filter
= Qnil
;
1032 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1034 create_process (proc
, new_argv
, current_dir
);
1036 return unbind_to (count
, proc
);
1039 /* This function is the unwind_protect form for Fstart_process. If
1040 PROC doesn't have its pid set, then we know someone has signalled
1041 an error and the process wasn't started successfully, so we should
1042 remove it from the process list. */
1044 start_process_unwind (proc
)
1047 if (XTYPE (proc
) != Lisp_Process
)
1050 /* Was PROC started successfully? */
1051 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1052 remove_process (proc
);
1059 create_process_1 (signo
)
1063 /* USG systems forget handlers when they are used;
1064 must reestablish each time */
1065 signal (signo
, create_process_1
);
1069 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1072 /* Mimic blocking of signals on system V, which doesn't really have it. */
1074 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1075 int sigchld_deferred
;
1078 create_process_sigchld ()
1080 signal (SIGCHLD
, create_process_sigchld
);
1082 sigchld_deferred
= 1;
1088 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1089 create_process (process
, new_argv
, current_dir
)
1090 Lisp_Object process
;
1092 Lisp_Object current_dir
;
1094 int pid
, inchannel
, outchannel
, forkin
, forkout
;
1097 SIGTYPE (*sigchld
)();
1100 extern char **environ
;
1102 inchannel
= outchannel
= -1;
1105 if (EQ (Vprocess_connection_type
, Qt
))
1106 outchannel
= inchannel
= allocate_pty ();
1111 /* On USG systems it does not work to open the pty's tty here
1112 and then close and reopen it in the child. */
1114 /* Don't let this terminal become our controlling terminal
1115 (in case we don't have one). */
1116 forkout
= forkin
= open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1118 forkout
= forkin
= open (pty_name
, O_RDWR
, 0);
1121 report_file_error ("Opening pty", Qnil
);
1123 forkin
= forkout
= -1;
1124 #endif /* not USG */
1128 #endif /* HAVE_PTYS */
1131 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1132 report_file_error ("Opening socketpair", Qnil
);
1133 outchannel
= inchannel
= sv
[0];
1134 forkout
= forkin
= sv
[1];
1136 #else /* not SKTPAIR */
1145 #endif /* not SKTPAIR */
1148 /* Replaced by close_process_descs */
1149 set_exclusive_use (inchannel
);
1150 set_exclusive_use (outchannel
);
1153 /* Stride people say it's a mystery why this is needed
1154 as well as the O_NDELAY, but that it fails without this. */
1155 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1158 ioctl (inchannel
, FIONBIO
, &one
);
1163 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1166 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1170 /* Record this as an active process, with its channels.
1171 As a result, child_setup will close Emacs's side of the pipes. */
1172 chan_process
[inchannel
] = process
;
1173 XSET (XPROCESS (process
)->infd
, Lisp_Int
, inchannel
);
1174 XSET (XPROCESS (process
)->outfd
, Lisp_Int
, outchannel
);
1175 /* Record the tty descriptor used in the subprocess. */
1177 XPROCESS (process
)->subtty
= Qnil
;
1179 XFASTINT (XPROCESS (process
)->subtty
) = forkin
;
1180 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1181 XPROCESS (process
)->status
= Qrun
;
1183 /* Delay interrupts until we have a chance to store
1184 the new fork's pid in its process structure */
1188 #else /* not BSD4_1 */
1189 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1190 sigsetmask (sigmask (SIGCHLD
));
1191 #else /* ordinary USG */
1193 sigchld_deferred
= 0;
1194 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1196 #endif /* ordinary USG */
1197 #endif /* not BSD4_1 */
1198 #endif /* SIGCHLD */
1200 /* Until we store the proper pid, enable sigchld_handler
1201 to recognize an unknown pid as standing for this process.
1202 It is very important not to let this `marker' value stay
1203 in the table after this function has returned; if it does
1204 it might cause call-process to hang and subsequent asynchronous
1205 processes to get their return values scrambled. */
1206 XSETINT (XPROCESS (process
)->pid
, -1);
1209 /* child_setup must clobber environ on systems with true vfork.
1210 Protect it from permanent change. */
1211 char **save_environ
= environ
;
1216 int xforkin
= forkin
;
1217 int xforkout
= forkout
;
1219 #if 0 /* This was probably a mistake--it duplicates code later on,
1220 but fails to handle all the cases. */
1221 /* Make sure SIGCHLD is not blocked in the child. */
1222 sigsetmask (SIGEMPTYMASK
);
1225 /* Make the pty be the controlling terminal of the process. */
1227 /* First, disconnect its current controlling terminal. */
1231 /* Make the pty's terminal the controlling terminal. */
1233 /* We ignore the return value
1234 because faith@cs.unc.edu says that is necessary on Linux. */
1235 ioctl (xforkin
, TIOCSCTTY
, 0);
1237 #else /* not HAVE_SETSID */
1239 /* It's very important to call setpgrp here and no time
1240 afterwards. Otherwise, we lose our controlling tty which
1241 is set when we open the pty. */
1244 #endif /* not HAVE_SETSID */
1247 /* Use new line discipline. */
1248 int ldisc
= NTTYDISC
;
1249 if (ioctl (xforkin
, TIOCSETD
, &ldisc
) < 0)
1250 write (1, "create_process/TIOCSETD failed\n", 31);
1254 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1255 can do TIOCSPGRP only to the process's controlling tty. */
1258 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1259 I can't test it since I don't have 4.3. */
1260 int j
= open ("/dev/tty", O_RDWR
, 0);
1261 ioctl (j
, TIOCNOTTY
, 0);
1264 /* In order to get a controlling terminal on some versions
1265 of BSD, it is necessary to put the process in pgrp 0
1266 before it opens the terminal. */
1270 #endif /* TIOCNOTTY */
1272 #if !defined (RTU) && !defined (UNIPLUS)
1273 /*** There is a suggestion that this ought to be a
1274 conditional on TIOCSPGRP. */
1275 /* Now close the pty (if we had it open) and reopen it.
1276 This makes the pty the controlling terminal of the subprocess. */
1279 #ifdef SET_CHILD_PTY_PGRP
1280 int pgrp
= getpid ();
1283 /* I wonder if close (open (pty_name, ...)) would work? */
1286 xforkout
= xforkin
= open (pty_name
, O_RDWR
, 0);
1288 #ifdef SET_CHILD_PTY_PGRP
1289 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
1290 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
1296 #endif /* not UNIPLUS and not RTU */
1297 #ifdef SETUP_SLAVE_PTY
1299 #endif /* SETUP_SLAVE_PTY */
1301 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1302 Now reenable it in the child, so it will die when we want it to. */
1304 signal (SIGHUP
, SIG_DFL
);
1306 #endif /* HAVE_PTYS */
1311 #else /* not BSD4_1 */
1312 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1313 sigsetmask (SIGEMPTYMASK
);
1314 #else /* ordinary USG */
1316 signal (SIGCHLD
, sigchld
);
1318 #endif /* ordinary USG */
1319 #endif /* not BSD4_1 */
1320 #endif /* SIGCHLD */
1322 child_setup_tty (xforkout
);
1323 child_setup (xforkin
, xforkout
, xforkout
,
1324 new_argv
, 1, current_dir
);
1326 environ
= save_environ
;
1330 report_file_error ("Doing vfork", Qnil
);
1332 XFASTINT (XPROCESS (process
)->pid
) = pid
;
1334 FD_SET (inchannel
, &input_wait_mask
);
1336 /* If the subfork execv fails, and it exits,
1337 this close hangs. I don't know why.
1338 So have an interrupt jar it loose. */
1340 signal (SIGALRM
, create_process_1
);
1342 XPROCESS (process
)->subtty
= Qnil
;
1347 if (forkin
!= forkout
&& forkout
>= 0)
1353 #else /* not BSD4_1 */
1354 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1355 sigsetmask (SIGEMPTYMASK
);
1356 #else /* ordinary USG */
1358 signal (SIGCHLD
, sigchld
);
1359 /* Now really handle any of these signals
1360 that came in during this function. */
1361 if (sigchld_deferred
)
1362 kill (getpid (), SIGCHLD
);
1364 #endif /* ordinary USG */
1365 #endif /* not BSD4_1 */
1366 #endif /* SIGCHLD */
1368 #endif /* not VMS */
1372 /* open a TCP network connection to a given HOST/SERVICE. Treated
1373 exactly like a normal process when reading and writing. Only
1374 differences are in status display and process deletion. A network
1375 connection has no PID; you cannot signal it. All you can do is
1376 deactivate and close it via delete-process */
1378 DEFUN ("open-network-stream", Fopen_network_stream
, Sopen_network_stream
,
1380 "Open a TCP connection for a service to a host.\n\
1381 Returns a subprocess-object to represent the connection.\n\
1382 Input and output work as for subprocesses; `delete-process' closes it.\n\
1383 Args are NAME BUFFER HOST SERVICE.\n\
1384 NAME is name for process. It is modified if necessary to make it unique.\n\
1385 BUFFER is the buffer (or buffer-name) to associate with the process.\n\
1386 Process output goes at end of that buffer, unless you specify\n\
1387 an output stream or filter function to handle the output.\n\
1388 BUFFER may be also nil, meaning that this process is not associated\n\
1390 Third arg is name of the host to connect to, or its IP address.\n\
1391 Fourth arg SERVICE is name of the service desired, or an integer\n\
1392 specifying a port number to connect to.")
1393 (name
, buffer
, host
, service
)
1394 Lisp_Object name
, buffer
, host
, service
;
1398 struct sockaddr_in address
;
1399 struct servent
*svc_info
;
1400 struct hostent
*host_info_ptr
, host_info
;
1401 char *(addr_list
[2]);
1402 IN_ADDR numeric_addr
;
1406 struct hostent host_info_fixed
;
1407 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1409 GCPRO4 (name
, buffer
, host
, service
);
1410 CHECK_STRING (name
, 0);
1411 CHECK_STRING (host
, 0);
1412 if (XTYPE(service
) == Lisp_Int
)
1413 port
= htons ((unsigned short) XINT (service
));
1416 CHECK_STRING (service
, 0);
1417 svc_info
= getservbyname (XSTRING (service
)->data
, "tcp");
1419 error ("Unknown service \"%s\"", XSTRING (service
)->data
);
1420 port
= svc_info
->s_port
;
1424 host_info_ptr
= gethostbyname (XSTRING (host
)->data
);
1425 if (host_info_ptr
== 0)
1426 /* Attempt to interpret host as numeric inet address */
1428 numeric_addr
= inet_addr ((char *) XSTRING (host
)->data
);
1429 if (NUMERIC_ADDR_ERROR
)
1430 error ("Unknown host \"%s\"", XSTRING (host
)->data
);
1432 host_info_ptr
= &host_info
;
1433 host_info
.h_name
= 0;
1434 host_info
.h_aliases
= 0;
1435 host_info
.h_addrtype
= AF_INET
;
1437 /* Older machines have only one address slot called h_addr.
1438 Newer machines have h_addr_list, but #define h_addr to
1439 be its first element. */
1440 host_info
.h_addr_list
= &(addr_list
[0]);
1442 host_info
.h_addr
= (char*)(&numeric_addr
);
1444 host_info
.h_length
= strlen (addr_list
[0]);
1447 bzero (&address
, sizeof address
);
1448 bcopy (host_info_ptr
->h_addr
, (char *) &address
.sin_addr
,
1449 host_info_ptr
->h_length
);
1450 address
.sin_family
= host_info_ptr
->h_addrtype
;
1451 address
.sin_port
= port
;
1453 s
= socket (host_info_ptr
->h_addrtype
, SOCK_STREAM
, 0);
1455 report_file_error ("error creating socket", Fcons (name
, Qnil
));
1457 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1458 when connect is interrupted. So let's not let it get interrupted.
1459 Note we do not turn off polling, because polling is only used
1460 when not interrupt_input, and thus not normally used on the systems
1461 which have this bug. On systems which use polling, there's no way
1462 to quit if polling is turned off. */
1463 if (interrupt_input
)
1467 if (connect (s
, (struct sockaddr
*) &address
, sizeof address
) == -1)
1474 if (interrupt_input
)
1478 report_file_error ("connection failed",
1479 Fcons (host
, Fcons (name
, Qnil
)));
1482 if (interrupt_input
)
1486 s
= connect_server (0);
1488 report_file_error ("error creating socket", Fcons (name
, Qnil
));
1489 send_command (s
, C_PORT
, 0, "%s:%d", XSTRING (host
)->data
, ntohs (port
));
1490 send_command (s
, C_DUMB
, 1, 0);
1496 report_file_error ("error duplicating socket", Fcons (name
, Qnil
));
1499 buffer
= Fget_buffer_create (buffer
);
1500 proc
= make_process (name
);
1502 chan_process
[inch
] = proc
;
1505 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
1508 fcntl (inch
, F_SETFL
, O_NDELAY
);
1512 XPROCESS (proc
)->childp
= host
;
1513 XPROCESS (proc
)->command_channel_p
= Qnil
;
1514 XPROCESS (proc
)->buffer
= buffer
;
1515 XPROCESS (proc
)->sentinel
= Qnil
;
1516 XPROCESS (proc
)->filter
= Qnil
;
1517 XPROCESS (proc
)->command
= Qnil
;
1518 XPROCESS (proc
)->pid
= Qnil
;
1519 XSET (XPROCESS (proc
)->infd
, Lisp_Int
, s
);
1520 XSET (XPROCESS (proc
)->outfd
, Lisp_Int
, outch
);
1521 XPROCESS (proc
)->status
= Qrun
;
1522 FD_SET (inch
, &input_wait_mask
);
1527 #endif /* HAVE_SOCKETS */
1529 deactivate_process (proc
)
1532 register int inchannel
, outchannel
;
1533 register struct Lisp_Process
*p
= XPROCESS (proc
);
1535 inchannel
= XINT (p
->infd
);
1536 outchannel
= XINT (p
->outfd
);
1540 /* Beware SIGCHLD hereabouts. */
1541 flush_pending_output (inchannel
);
1544 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
1545 sys$
dassgn (outchannel
);
1546 vs
= get_vms_process_pointer (p
->pid
);
1548 give_back_vms_process_stuff (vs
);
1552 if (outchannel
>= 0 && outchannel
!= inchannel
)
1556 XSET (p
->infd
, Lisp_Int
, -1);
1557 XSET (p
->outfd
, Lisp_Int
, -1);
1558 chan_process
[inchannel
] = Qnil
;
1559 FD_CLR (inchannel
, &input_wait_mask
);
1563 /* Close all descriptors currently in use for communication
1564 with subprocess. This is used in a newly-forked subprocess
1565 to get rid of irrelevant descriptors. */
1567 close_process_descs ()
1570 for (i
= 0; i
< MAXDESC
; i
++)
1572 Lisp_Object process
;
1573 process
= chan_process
[i
];
1574 if (!NILP (process
))
1576 int in
= XINT (XPROCESS (process
)->infd
);
1577 int out
= XINT (XPROCESS (process
)->outfd
);
1580 if (out
>= 0 && in
!= out
)
1586 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
1588 "Allow any pending output from subprocesses to be read by Emacs.\n\
1589 It is read into the process' buffers or given to their filter functions.\n\
1590 Non-nil arg PROCESS means do not return until some output has been received\n\
1592 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\
1593 seconds and microseconds to wait; return after that much time whether\n\
1594 or not there is input.\n\
1595 Return non-nil iff we received any output before the timeout expired.")
1596 (proc
, timeout
, timeout_msecs
)
1597 register Lisp_Object proc
, timeout
, timeout_msecs
;
1602 if (! NILP (timeout_msecs
))
1604 CHECK_NUMBER (timeout_msecs
, 2);
1605 useconds
= XINT (timeout_msecs
);
1606 if (XTYPE (timeout
) != Lisp_Int
)
1607 XSET (timeout
, Lisp_Int
, 0);
1610 int carry
= useconds
/ 1000000;
1612 XSETINT (timeout
, XINT (timeout
) + carry
);
1613 useconds
-= carry
* 1000000;
1615 /* I think this clause is necessary because C doesn't
1616 guarantee a particular rounding direction for negative
1620 XSETINT (timeout
, XINT (timeout
) - 1);
1621 useconds
+= 1000000;
1628 if (! NILP (timeout
))
1630 CHECK_NUMBER (timeout
, 1);
1631 seconds
= XINT (timeout
);
1644 XFASTINT (proc
) = 0;
1647 (wait_reading_process_input (seconds
, useconds
, proc
, 0)
1651 /* This variable is different from waiting_for_input in keyboard.c.
1652 It is used to communicate to a lisp process-filter/sentinel (via the
1653 function Fwaiting_for_user_input_p below) whether emacs was waiting
1654 for user-input when that process-filter was called.
1655 waiting_for_input cannot be used as that is by definition 0 when
1656 lisp code is being evalled */
1657 static int waiting_for_user_input_p
;
1659 /* Read and dispose of subprocess output while waiting for timeout to
1660 elapse and/or keyboard input to be available.
1663 timeout in seconds, or
1664 zero for no limit, or
1665 -1 means gobble data immediately available but don't wait for any.
1668 an additional duration to wait, measured in microseconds.
1669 If this is nonzero and time_limit is 0, then the timeout
1670 consists of MICROSECS only.
1672 READ_KBD is a lisp value:
1673 0 to ignore keyboard input, or
1674 1 to return when input is available, or
1675 -1 meaning caller will actually read the input, so don't throw to
1676 the quit handler, or
1677 a cons cell, meaning wait wait until its car is non-nil
1678 (and gobble terminal input into the buffer if any arrives), or
1679 a process object, meaning wait until something arrives from that
1680 process. The return value is true iff we read some input from
1683 DO_DISPLAY != 0 means redisplay should be done to show subprocess
1684 output that arrives.
1686 If READ_KBD is a pointer to a struct Lisp_Process, then the
1687 function returns true iff we received input from that process
1688 before the timeout elapsed.
1689 Otherwise, return true iff we received input from any process. */
1691 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
1692 int time_limit
, microsecs
;
1693 Lisp_Object read_kbd
;
1696 register int channel
, nfds
, m
;
1697 static SELECT_TYPE Available
;
1700 EMACS_TIME timeout
, end_time
, garbage
;
1702 int wait_channel
= -1;
1703 struct Lisp_Process
*wait_proc
= 0;
1704 int got_some_input
= 0;
1705 Lisp_Object
*wait_for_cell
= 0;
1707 FD_ZERO (&Available
);
1709 /* If read_kbd is a process to watch, set wait_proc and wait_channel
1711 if (XTYPE (read_kbd
) == Lisp_Process
)
1713 wait_proc
= XPROCESS (read_kbd
);
1714 wait_channel
= XINT (wait_proc
->infd
);
1715 XFASTINT (read_kbd
) = 0;
1718 /* If waiting for non-nil in a cell, record where. */
1719 if (XTYPE (read_kbd
) == Lisp_Cons
)
1721 wait_for_cell
= &XCONS (read_kbd
)->car
;
1722 XFASTINT (read_kbd
) = 0;
1725 waiting_for_user_input_p
= XINT (read_kbd
);
1727 /* Since we may need to wait several times,
1728 compute the absolute time to return at. */
1729 if (time_limit
|| microsecs
)
1731 EMACS_GET_TIME (end_time
);
1732 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
1733 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
1736 /* It would not be safe to call this below,
1737 where we call redisplay_preserve_echo_area. */
1738 prepare_menu_bars ();
1742 /* If calling from keyboard input, do not quit
1743 since we want to return C-g as an input character.
1744 Otherwise, do pending quit if requested. */
1745 if (XINT (read_kbd
) >= 0)
1748 /* Exit now if the cell we're waiting for became non-nil. */
1749 if (wait_for_cell
&& ! NILP (*wait_for_cell
))
1752 /* Compute time from now till when time limit is up */
1753 /* Exit if already run out */
1754 if (time_limit
== -1)
1756 /* -1 specified for timeout means
1757 gobble output available now
1758 but don't wait at all. */
1760 EMACS_SET_SECS_USECS (timeout
, 0, 0);
1762 else if (time_limit
|| microsecs
)
1764 EMACS_GET_TIME (timeout
);
1765 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
1766 if (EMACS_TIME_NEG_P (timeout
))
1771 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
1774 /* Cause C-g and alarm signals to take immediate action,
1775 and cause input available signals to zero out timeout.
1777 It is important that we do this before checking for process
1778 activity. If we get a SIGCHLD after the explicit checks for
1779 process activity, timeout is the only way we will know. */
1780 if (XINT (read_kbd
) < 0)
1781 set_waiting_for_input (&timeout
);
1783 /* If status of something has changed, and no input is
1784 available, notify the user of the change right away. After
1785 this explicit check, we'll let the SIGCHLD handler zap
1786 timeout to get our attention. */
1787 if (update_tick
!= process_tick
&& do_display
)
1789 Atemp
= input_wait_mask
;
1790 EMACS_SET_SECS_USECS (timeout
, 0, 0);
1791 if (select (MAXDESC
, &Atemp
, 0, 0, &timeout
) <= 0)
1793 /* It's okay for us to do this and then continue with
1794 the loop, since timeout has already been zeroed out. */
1795 clear_waiting_for_input ();
1800 /* Don't wait for output from a non-running process. */
1801 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
1802 update_status (wait_proc
);
1804 && ! EQ (wait_proc
->status
, Qrun
))
1806 clear_waiting_for_input ();
1810 /* Wait till there is something to do */
1812 Available
= input_wait_mask
;
1813 /* We used to have && wait_for_cell == 0
1814 but that led to lossage handling selection_request events:
1815 within one, we would start to handle another. */
1816 if (! XINT (read_kbd
))
1817 FD_CLR (keyboard_descriptor
, &Available
);
1819 /* If frame size has changed or the window is newly mapped,
1820 redisplay now, before we start to wait. There is a race
1821 condition here; if a SIGIO arrives between now and the select
1822 and indicates that a frame is trashed, the select may block
1823 displaying a trashed screen. */
1825 redisplay_preserve_echo_area ();
1827 if (XINT (read_kbd
) && detect_input_pending ())
1830 FD_ZERO (&Available
);
1833 nfds
= select (MAXDESC
, &Available
, 0, 0, &timeout
);
1837 /* Make C-g and alarm signals set flags again */
1838 clear_waiting_for_input ();
1840 /* If we woke up due to SIGWINCH, actually change size now. */
1841 do_pending_window_change ();
1843 if (time_limit
&& nfds
== 0) /* timeout elapsed */
1847 if (xerrno
== EINTR
)
1848 FD_ZERO (&Available
);
1850 /* Ultrix select seems to return ENOMEM when it is
1851 interrupted. Treat it just like EINTR. Bleah. Note
1852 that we want to test for the "ultrix" CPP symbol, not
1853 "__ultrix__"; the latter is only defined under GCC, but
1854 not by DEC's bundled CC. -JimB */
1855 else if (xerrno
== ENOMEM
)
1856 FD_ZERO (&Available
);
1859 /* This happens for no known reason on ALLIANT.
1860 I am guessing that this is the right response. -- RMS. */
1861 else if (xerrno
== EFAULT
)
1862 FD_ZERO (&Available
);
1864 else if (xerrno
== EBADF
)
1867 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
1868 the child's closure of the pts gives the parent a SIGHUP, and
1869 the ptc file descriptor is automatically closed,
1870 yielding EBADF here or at select() call above.
1871 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
1872 in m-ibmrt-aix.h), and here we just ignore the select error.
1873 Cleanup occurs c/o status_notify after SIGCLD. */
1874 FD_ZERO (&Available
); /* Cannot depend on values returned */
1880 error("select error: %s", sys_errlist
[xerrno
]);
1882 #if defined(sun) && !defined(USG5_4)
1883 else if (nfds
> 0 && FD_ISSET (keyboard_descriptor
, &Available
)
1885 /* System sometimes fails to deliver SIGIO.
1887 David J. Mackenzie says that Emacs doesn't compile under
1888 Solaris if this code is enabled, thus the USG5_4 in the CPP
1889 conditional. "I haven't noticed any ill effects so far.
1890 If you find a Solaris expert somewhere, they might know
1892 kill (getpid (), SIGIO
);
1895 /* Check for keyboard input */
1896 /* If there is any, return immediately
1897 to give it higher priority than subprocesses */
1899 /* We used to do his if wait_for_cell,
1900 but that caused infinite recursion in selection request events. */
1901 if ((XINT (read_kbd
))
1902 && detect_input_pending ())
1905 if (detect_input_pending ())
1909 /* Exit now if the cell we're waiting for became non-nil. */
1910 if (wait_for_cell
&& ! NILP (*wait_for_cell
))
1914 /* If we think we have keyboard input waiting, but didn't get SIGIO
1915 go read it. This can happen with X on BSD after logging out.
1916 In that case, there really is no input and no SIGIO,
1917 but select says there is input. */
1919 if (XINT (read_kbd
) && interrupt_input
1920 && (FD_ISSET (keyboard_descriptor
, &Available
)))
1925 got_some_input
|= nfds
> 0;
1927 /* If checking input just got us a size-change event from X,
1928 obey it now if we should. */
1929 if (XINT (read_kbd
) || wait_for_cell
)
1930 do_pending_window_change ();
1932 /* Check for data from a process. */
1933 /* Really FIRST_PROC_DESC should be 0 on Unix,
1934 but this is safer in the short run. */
1935 for (channel
= keyboard_descriptor
== 0 ? FIRST_PROC_DESC
: 0;
1936 channel
< MAXDESC
; channel
++)
1938 if (FD_ISSET (channel
, &Available
))
1942 /* If waiting for this channel, arrange to return as
1943 soon as no more input to be processed. No more
1945 if (wait_channel
== channel
)
1951 proc
= chan_process
[channel
];
1955 /* Read data from the process, starting with our
1956 buffered-ahead character if we have one. */
1958 nread
= read_process_output (proc
, channel
);
1961 /* Since read_process_output can run a filter,
1962 which can call accept-process-output,
1963 don't try to read from any other processes
1964 before doing the select again. */
1965 FD_ZERO (&Available
);
1968 redisplay_preserve_echo_area ();
1971 else if (nread
== -1 && errno
== EWOULDBLOCK
)
1975 else if (nread
== -1 && errno
== EAGAIN
)
1979 else if (nread
== -1 && errno
== EAGAIN
)
1981 /* Note that we cannot distinguish between no input
1982 available now and a closed pipe.
1983 With luck, a closed pipe will be accompanied by
1984 subprocess termination and SIGCHLD. */
1985 else if (nread
== 0 && !NETCONN_P (proc
))
1987 #endif /* O_NDELAY */
1988 #endif /* O_NONBLOCK */
1989 #endif /* EWOULDBLOCK */
1991 /* On some OSs with ptys, when the process on one end of
1992 a pty exits, the other end gets an error reading with
1993 errno = EIO instead of getting an EOF (0 bytes read).
1994 Therefore, if we get an error reading and errno =
1995 EIO, just continue, because the child process has
1996 exited and should clean itself up soon (e.g. when we
1998 else if (nread
== -1 && errno
== EIO
)
2000 #endif /* HAVE_PTYS */
2001 /* If we can detect process termination, don't consider the process
2002 gone just because its pipe is closed. */
2004 else if (nread
== 0 && !NETCONN_P (proc
))
2009 /* Preserve status of processes already terminated. */
2010 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
2011 deactivate_process (proc
);
2012 if (!NILP (XPROCESS (proc
)->raw_status_low
))
2013 update_status (XPROCESS (proc
));
2014 if (EQ (XPROCESS (proc
)->status
, Qrun
))
2015 XPROCESS (proc
)->status
2016 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
2019 } /* end for each file descriptor */
2020 } /* end while exit conditions not met */
2022 /* If calling from keyboard input, do not quit
2023 since we want to return C-g as an input character.
2024 Otherwise, do pending quit if requested. */
2025 if (XINT (read_kbd
) >= 0)
2027 /* Prevent input_pending from remaining set if we quit. */
2028 clear_input_pending ();
2032 return got_some_input
;
2035 /* Read pending output from the process channel,
2036 starting with our buffered-ahead character if we have one.
2037 Yield number of characters read.
2039 This function reads at most 1024 characters.
2040 If you want to read all available subprocess output,
2041 you must call it repeatedly until it returns zero. */
2043 read_process_output (proc
, channel
)
2045 register int channel
;
2047 register int nchars
;
2053 register Lisp_Object outstream
;
2054 register struct buffer
*old
= current_buffer
;
2055 register struct Lisp_Process
*p
= XPROCESS (proc
);
2056 register int opoint
;
2059 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
2061 vs
= get_vms_process_pointer (p
->pid
);
2065 return(0); /* Really weird if it does this */
2066 if (!(vs
->iosb
[0] & 1))
2067 return -1; /* I/O error */
2070 error ("Could not get VMS process pointer");
2071 chars
= vs
->inputBuffer
;
2072 nchars
= clean_vms_buffer (chars
, vs
->iosb
[1]);
2075 start_vms_process_read (vs
); /* Crank up the next read on the process */
2076 return 1; /* Nothing worth printing, say we got 1 */
2080 if (proc_buffered_char
[channel
] < 0)
2081 nchars
= read (channel
, chars
, sizeof chars
);
2084 chars
[0] = proc_buffered_char
[channel
];
2085 proc_buffered_char
[channel
] = -1;
2086 nchars
= read (channel
, chars
+ 1, sizeof chars
- 1);
2090 nchars
= nchars
+ 1;
2092 #endif /* not VMS */
2094 if (nchars
<= 0) return nchars
;
2096 outstream
= p
->filter
;
2097 if (!NILP (outstream
))
2099 /* We inhibit quit here instead of just catching it so that
2100 hitting ^G when a filter happens to be running won't screw
2102 int count
= specpdl_ptr
- specpdl
;
2103 Lisp_Object odeactivate
;
2105 odeactivate
= Vdeactivate_mark
;
2107 specbind (Qinhibit_quit
, Qt
);
2108 call2 (outstream
, proc
, make_string (chars
, nchars
));
2110 /* Handling the process output should not deactivate the mark. */
2111 Vdeactivate_mark
= odeactivate
;
2114 start_vms_process_read (vs
);
2120 /* If no filter, write into buffer if it isn't dead. */
2121 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
2123 Lisp_Object old_read_only
;
2124 Lisp_Object old_begv
, old_zv
;
2125 Lisp_Object odeactivate
;
2127 odeactivate
= Vdeactivate_mark
;
2129 Fset_buffer (p
->buffer
);
2131 old_read_only
= current_buffer
->read_only
;
2132 XFASTINT (old_begv
) = BEGV
;
2133 XFASTINT (old_zv
) = ZV
;
2135 current_buffer
->read_only
= Qnil
;
2137 /* Insert new output into buffer
2138 at the current end-of-output marker,
2139 thus preserving logical ordering of input and output. */
2140 if (XMARKER (p
->mark
)->buffer
)
2141 SET_PT (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
));
2145 /* If the output marker is outside of the visible region, save
2146 the restriction and widen. */
2147 if (! (BEGV
<= point
&& point
<= ZV
))
2150 /* Make sure opoint floats ahead of any new text, just as point
2152 if (point
<= opoint
)
2155 /* Insert after old_begv, but before old_zv. */
2156 if (point
< XFASTINT (old_begv
))
2157 XFASTINT (old_begv
) += nchars
;
2158 if (point
<= XFASTINT (old_zv
))
2159 XFASTINT (old_zv
) += nchars
;
2161 /* Insert before markers in case we are inserting where
2162 the buffer's mark is, and the user's next command is Meta-y. */
2163 insert_before_markers (chars
, nchars
);
2164 Fset_marker (p
->mark
, make_number (point
), p
->buffer
);
2166 update_mode_lines
++;
2168 /* If the restriction isn't what it should be, set it. */
2169 if (XFASTINT (old_begv
) != BEGV
|| XFASTINT (old_zv
) != ZV
)
2170 Fnarrow_to_region (old_begv
, old_zv
);
2172 /* Handling the process output should not deactivate the mark. */
2173 Vdeactivate_mark
= odeactivate
;
2175 current_buffer
->read_only
= old_read_only
;
2177 set_buffer_internal (old
);
2180 start_vms_process_read (vs
);
2185 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
2187 "Returns non-NIL if emacs is waiting for input from the user.\n\
2188 This is intended for use by asynchronous process output filters and sentinels.")
2191 return ((waiting_for_user_input_p
) ? Qt
: Qnil
);
2194 /* Sending data to subprocess */
2196 jmp_buf send_process_frame
;
2199 send_process_trap ()
2205 longjmp (send_process_frame
, 1);
2208 send_process (proc
, buf
, len
)
2213 /* Don't use register vars; longjmp can lose them. */
2215 unsigned char *procname
= XSTRING (XPROCESS (proc
)->name
)->data
;
2219 struct Lisp_Process
*p
= XPROCESS (proc
);
2220 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
2223 if (! NILP (XPROCESS (proc
)->raw_status_low
))
2224 update_status (XPROCESS (proc
));
2225 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
2226 error ("Process %s not running", procname
);
2229 vs
= get_vms_process_pointer (p
->pid
);
2231 error ("Could not find this process: %x", p
->pid
);
2232 else if (write_to_vms_process (vs
, buf
, len
))
2235 if (!setjmp (send_process_frame
))
2239 SIGTYPE (*old_sigpipe
)();
2241 /* Don't send more than 500 bytes at a time. */
2244 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
2245 rv
= write (XINT (XPROCESS (proc
)->outfd
), buf
, this);
2246 signal (SIGPIPE
, old_sigpipe
);
2251 || errno
== EWOULDBLOCK
2258 /* It would be nice to accept process output here,
2259 but that is difficult. For example, it could
2260 garbage what we are sending if that is from a buffer. */
2267 report_file_error ("writing to process", Fcons (proc
, Qnil
));
2271 /* Allow input from processes between bursts of sending.
2272 Otherwise things may get stopped up. */
2277 XFASTINT (zero
) = 0;
2278 wait_reading_process_input (-1, 0, zero
, 0);
2284 XPROCESS (proc
)->raw_status_low
= Qnil
;
2285 XPROCESS (proc
)->raw_status_high
= Qnil
;
2286 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
2287 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
2288 deactivate_process (proc
);
2290 error ("Error writing to process %s; closed it", procname
);
2292 error ("SIGPIPE raised on process %s; closed it", procname
);
2297 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
2299 "Send current contents of region as input to PROCESS.\n\
2300 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2301 nil, indicating the current buffer's process.\n\
2302 Called from program, takes three arguments, PROCESS, START and END.\n\
2303 If the region is more than 500 characters long,\n\
2304 it is sent in several bunches. This may happen even for shorter regions.\n\
2305 Output from processes can arrive in between bunches.")
2306 (process
, start
, end
)
2307 Lisp_Object process
, start
, end
;
2312 proc
= get_process (process
);
2313 validate_region (&start
, &end
);
2315 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
2318 start1
= XINT (start
);
2319 send_process (proc
, &FETCH_CHAR (start1
), XINT (end
) - XINT (start
));
2324 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
2326 "Send PROCESS the contents of STRING as input.\n\
2327 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2328 nil, indicating the current buffer's process.\n\
2329 If STRING is more than 500 characters long,\n\
2330 it is sent in several bunches. This may happen even for shorter strings.\n\
2331 Output from processes can arrive in between bunches.")
2333 Lisp_Object process
, string
;
2336 CHECK_STRING (string
, 1);
2337 proc
= get_process (process
);
2338 send_process (proc
, XSTRING (string
)->data
, XSTRING (string
)->size
);
2342 /* send a signal number SIGNO to PROCESS.
2343 CURRENT_GROUP means send to the process group that currently owns
2344 the terminal being used to communicate with PROCESS.
2345 This is used for various commands in shell mode.
2346 If NOMSG is zero, insert signal-announcements into process's buffers
2349 If we can, we try to signal PROCESS by sending control characters
2350 down the pipe. This allows us to signal inferiors who have changed
2351 their uid, for which killpg would return an EPERM error. */
2354 process_send_signal (process
, signo
, current_group
, nomsg
)
2355 Lisp_Object process
;
2357 Lisp_Object current_group
;
2361 register struct Lisp_Process
*p
;
2365 proc
= get_process (process
);
2366 p
= XPROCESS (proc
);
2368 if (!EQ (p
->childp
, Qt
))
2369 error ("Process %s is not a subprocess",
2370 XSTRING (p
->name
)->data
);
2371 if (XINT (p
->infd
) < 0)
2372 error ("Process %s is not active",
2373 XSTRING (p
->name
)->data
);
2375 if (NILP (p
->pty_flag
))
2376 current_group
= Qnil
;
2378 /* If we are using pgrps, get a pgrp number and make it negative. */
2379 if (!NILP (current_group
))
2381 #ifdef SIGNALS_VIA_CHARACTERS
2382 /* If possible, send signals to the entire pgrp
2383 by sending an input character to it. */
2385 /* TERMIOS is the latest and bestest, and seems most likely to
2386 work. If the system has it, use it. */
2393 tcgetattr (XINT (p
->infd
), &t
);
2394 send_process (proc
, &t
.c_cc
[VINTR
], 1);
2398 tcgetattr (XINT (p
->infd
), &t
);
2399 send_process (proc
, &t
.c_cc
[VQUIT
], 1);
2403 tcgetattr (XINT (p
->infd
), &t
);
2404 #if defined (VSWTCH) && !defined (IRIX5)
2405 send_process (proc
, &t
.c_cc
[VSWTCH
], 1);
2407 send_process (proc
, &t
.c_cc
[VSUSP
], 1);
2412 #else /* ! HAVE_TERMIOS */
2414 /* On Berkeley descendants, the following IOCTL's retrieve the
2415 current control characters. */
2416 #if defined (TIOCGLTC) && defined (TIOCGETC)
2424 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
2425 send_process (proc
, &c
.t_intrc
, 1);
2428 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
2429 send_process (proc
, &c
.t_quitc
, 1);
2433 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
2434 send_process (proc
, &lc
.t_suspc
, 1);
2436 #endif /* ! defined (SIGTSTP) */
2439 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
2441 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
2448 ioctl (XINT (p
->infd
), TCGETA
, &t
);
2449 send_process (proc
, &t
.c_cc
[VINTR
], 1);
2452 ioctl (XINT (p
->infd
), TCGETA
, &t
);
2453 send_process (proc
, &t
.c_cc
[VQUIT
], 1);
2457 ioctl (XINT (p
->infd
), TCGETA
, &t
);
2458 send_process (proc
, &t
.c_cc
[VSWTCH
], 1);
2460 #endif /* ! defined (SIGTSTP) */
2462 #else /* ! defined (TCGETA) */
2463 Your configuration files are messed up
.
2464 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
2465 you'd better be using one of the alternatives above! */
2466 #endif /* ! defined (TCGETA) */
2467 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
2468 #endif /* ! defined HAVE_TERMIOS */
2469 #endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
2472 /* Get the pgrp using the tty itself, if we have that.
2473 Otherwise, use the pty to get the pgrp.
2474 On pfa systems, saka@pfu.fujitsu.co.JP writes:
2475 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
2476 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
2477 His patch indicates that if TIOCGPGRP returns an error, then
2478 we should just assume that p->pid is also the process group id. */
2482 if (!NILP (p
->subtty
))
2483 err
= ioctl (XFASTINT (p
->subtty
), TIOCGPGRP
, &gid
);
2485 err
= ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
);
2489 gid
= - XFASTINT (p
->pid
);
2490 #endif /* ! defined (pfa) */
2496 #else /* ! defined (TIOCGPGRP ) */
2497 /* Can't select pgrps on this system, so we know that
2498 the child itself heads the pgrp. */
2499 gid
= - XFASTINT (p
->pid
);
2500 #endif /* ! defined (TIOCGPGRP ) */
2503 gid
= - XFASTINT (p
->pid
);
2509 p
->raw_status_low
= Qnil
;
2510 p
->raw_status_high
= Qnil
;
2512 XSETINT (p
->tick
, ++process_tick
);
2516 #endif /* ! defined (SIGCONT) */
2519 send_process (proc
, "\003", 1); /* ^C */
2524 send_process (proc
, "\031", 1); /* ^Y */
2529 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
2532 flush_pending_output (XINT (p
->infd
));
2536 /* If we don't have process groups, send the signal to the immediate
2537 subprocess. That isn't really right, but it's better than any
2538 obvious alternative. */
2541 kill (XFASTINT (p
->pid
), signo
);
2545 /* gid may be a pid, or minus a pgrp's number */
2547 if (!NILP (current_group
))
2548 ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
);
2551 gid
= - XFASTINT (p
->pid
);
2554 #else /* ! defined (TIOCSIGSEND) */
2555 EMACS_KILLPG (-gid
, signo
);
2556 #endif /* ! defined (TIOCSIGSEND) */
2559 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
2560 "Interrupt process PROCESS. May be process or name of one.\n\
2561 PROCESS may be a process, a buffer, or the name of a process or buffer.\n\
2562 Nil or no arg means current buffer's process.\n\
2563 Second arg CURRENT-GROUP non-nil means send signal to\n\
2564 the current process-group of the process's controlling terminal\n\
2565 rather than to the process's own process group.\n\
2566 If the process is a shell, this means interrupt current subjob\n\
2567 rather than the shell.")
2568 (process
, current_group
)
2569 Lisp_Object process
, current_group
;
2571 process_send_signal (process
, SIGINT
, current_group
, 0);
2575 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
2576 "Kill process PROCESS. May be process or name of one.\n\
2577 See function `interrupt-process' for more details on usage.")
2578 (process
, current_group
)
2579 Lisp_Object process
, current_group
;
2581 process_send_signal (process
, SIGKILL
, current_group
, 0);
2585 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
2586 "Send QUIT signal to process PROCESS. May be process or name of one.\n\
2587 See function `interrupt-process' for more details on usage.")
2588 (process
, current_group
)
2589 Lisp_Object process
, current_group
;
2591 process_send_signal (process
, SIGQUIT
, current_group
, 0);
2595 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
2596 "Stop process PROCESS. May be process or name of one.\n\
2597 See function `interrupt-process' for more details on usage.")
2598 (process
, current_group
)
2599 Lisp_Object process
, current_group
;
2602 error ("no SIGTSTP support");
2604 process_send_signal (process
, SIGTSTP
, current_group
, 0);
2609 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
2610 "Continue process PROCESS. May be process or name of one.\n\
2611 See function `interrupt-process' for more details on usage.")
2612 (process
, current_group
)
2613 Lisp_Object process
, current_group
;
2616 process_send_signal (process
, SIGCONT
, current_group
, 0);
2618 error ("no SIGCONT support");
2623 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
2624 2, 2, "nProcess number: \nnSignal code: ",
2625 "Send the process with number PID the signal with code CODE.\n\
2626 Both PID and CODE are integers.")
2628 Lisp_Object pid
, sig
;
2630 CHECK_NUMBER (pid
, 0);
2631 CHECK_NUMBER (sig
, 1);
2632 return make_number (kill (XINT (pid
), XINT (sig
)));
2635 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
2636 "Make PROCESS see end-of-file in its input.\n\
2637 Eof comes after any text already sent to it.\n\
2638 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2639 nil, indicating the current buffer's process.")
2641 Lisp_Object process
;
2645 proc
= get_process (process
);
2647 /* Make sure the process is really alive. */
2648 if (! NILP (XPROCESS (proc
)->raw_status_low
))
2649 update_status (XPROCESS (proc
));
2650 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
2651 error ("Process %s not running", XSTRING (XPROCESS (proc
)->name
)->data
);
2653 /* Sending a zero-length record is supposed to mean eof
2654 when TIOCREMOTE is turned on. */
2658 write (XINT (XPROCESS (proc
)->outfd
), buf
, 0);
2660 #else /* did not do TOICREMOTE */
2662 send_process (proc
, "\032", 1); /* ^z */
2664 if (!NILP (XPROCESS (proc
)->pty_flag
))
2665 send_process (proc
, "\004", 1);
2668 close (XINT (XPROCESS (proc
)->outfd
));
2669 XSET (XPROCESS (proc
)->outfd
, Lisp_Int
, open (NULL_DEVICE
, O_WRONLY
));
2672 #endif /* did not do TOICREMOTE */
2676 /* Kill all processes associated with `buffer'.
2677 If `buffer' is nil, kill all processes */
2679 kill_buffer_processes (buffer
)
2682 Lisp_Object tail
, proc
;
2684 for (tail
= Vprocess_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2685 tail
= XCONS (tail
)->cdr
)
2687 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
2688 if (XGCTYPE (proc
) == Lisp_Process
2689 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
2691 if (NETCONN_P (proc
))
2692 deactivate_process (proc
);
2693 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
2694 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
2699 /* On receipt of a signal that a child status has changed,
2700 loop asking about children with changed statuses until
2701 the system says there are no more.
2702 All we do is change the status;
2703 we do not run sentinels or print notifications.
2704 That is saved for the next time keyboard input is done,
2705 in order to avoid timing errors. */
2707 /** WARNING: this can be called during garbage collection.
2708 Therefore, it must not be fooled by the presence of mark bits in
2711 /** USG WARNING: Although it is not obvious from the documentation
2712 in signal(2), on a USG system the SIGCLD handler MUST NOT call
2713 signal() before executing at least one wait(), otherwise the handler
2714 will be called again, resulting in an infinite loop. The relevant
2715 portion of the documentation reads "SIGCLD signals will be queued
2716 and the signal-catching function will be continually reentered until
2717 the queue is empty". Invoking signal() causes the kernel to reexamine
2718 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
2721 sigchld_handler (signo
)
2724 int old_errno
= errno
;
2726 register struct Lisp_Process
*p
;
2727 extern EMACS_TIME
*input_available_clear_time
;
2731 sigheld
|= sigbit (SIGCHLD
);
2743 #endif /* no WUNTRACED */
2744 /* Keep trying to get a status until we get a definitive result. */
2748 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
2750 while (pid
<= 0 && errno
== EINTR
);
2754 /* A real failure. We have done all our job, so return. */
2756 /* USG systems forget handlers when they are used;
2757 must reestablish each time */
2759 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
2762 sigheld
&= ~sigbit (SIGCHLD
);
2770 #endif /* no WNOHANG */
2772 /* Find the process that signaled us, and record its status. */
2775 for (tail
= Vprocess_alist
; XSYMBOL (tail
) != XSYMBOL (Qnil
); tail
= XCONS (tail
)->cdr
)
2777 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
2778 p
= XPROCESS (proc
);
2779 if (EQ (p
->childp
, Qt
) && XFASTINT (p
->pid
) == pid
)
2784 /* Look for an asynchronous process whose pid hasn't been filled
2787 for (tail
= Vprocess_alist
; XSYMBOL (tail
) != XSYMBOL (Qnil
); tail
= XCONS (tail
)->cdr
)
2789 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
2790 p
= XPROCESS (proc
);
2791 if (XTYPE (p
->pid
) == Lisp_Int
&& XINT (p
->pid
) == -1)
2796 /* Change the status of the process that was found. */
2799 union { int i
; WAITTYPE wt
; } u
;
2801 XSETINT (p
->tick
, ++process_tick
);
2803 XFASTINT (p
->raw_status_low
) = u
.i
& 0xffff;
2804 XFASTINT (p
->raw_status_high
) = u
.i
>> 16;
2806 /* If process has terminated, stop waiting for its output. */
2807 if (WIFSIGNALED (w
) || WIFEXITED (w
))
2808 if (XINT (p
->infd
) >= 0)
2809 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
2811 /* Tell wait_reading_process_input that it needs to wake up and
2813 if (input_available_clear_time
)
2814 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
2817 /* There was no asynchronous process found for that id. Check
2818 if we have a synchronous process. */
2821 synch_process_alive
= 0;
2823 /* Report the status of the synchronous process. */
2825 synch_process_retcode
= WRETCODE (w
);
2826 else if (WIFSIGNALED (w
))
2828 synch_process_death
= (char *) sys_siglist
[WTERMSIG (w
)];
2830 synch_process_death
= sys_errlist
[WTERMSIG (w
)];
2833 /* Tell wait_reading_process_input that it needs to wake up and
2835 if (input_available_clear_time
)
2836 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
2839 /* On some systems, we must return right away.
2840 If any more processes want to signal us, we will
2842 Otherwise (on systems that have WNOHANG), loop around
2843 to use up all the processes that have something to tell us. */
2844 #if defined (USG) && ! (defined (HPUX) && defined (WNOHANG))
2846 signal (signo
, sigchld_handler
);
2850 #endif /* USG, but not HPUX with WNOHANG */
2856 exec_sentinel_unwind (data
)
2859 XPROCESS (XCONS (data
)->car
)->sentinel
= XCONS (data
)->cdr
;
2864 exec_sentinel (proc
, reason
)
2865 Lisp_Object proc
, reason
;
2867 Lisp_Object sentinel
;
2868 register struct Lisp_Process
*p
= XPROCESS (proc
);
2869 int count
= specpdl_ptr
- specpdl
;
2871 sentinel
= p
->sentinel
;
2872 if (NILP (sentinel
))
2875 /* Zilch the sentinel while it's running, to avoid recursive invocations;
2876 assure that it gets restored no matter how the sentinel exits. */
2878 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
2879 /* Inhibit quit so that random quits don't screw up a running filter. */
2880 specbind (Qinhibit_quit
, Qt
);
2881 call2 (sentinel
, proc
, reason
);
2885 /* Report all recent events of a change in process status
2886 (either run the sentinel or output a message).
2887 This is done while Emacs is waiting for keyboard input. */
2891 register Lisp_Object proc
, buffer
;
2892 Lisp_Object tail
= Qnil
;
2893 Lisp_Object msg
= Qnil
;
2894 struct gcpro gcpro1
, gcpro2
;
2896 /* We need to gcpro tail; if read_process_output calls a filter
2897 which deletes a process and removes the cons to which tail points
2898 from Vprocess_alist, and then causes a GC, tail is an unprotected
2902 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
2905 register struct Lisp_Process
*p
;
2907 proc
= Fcdr (Fcar (tail
));
2908 p
= XPROCESS (proc
);
2910 if (XINT (p
->tick
) != XINT (p
->update_tick
))
2912 XSETINT (p
->update_tick
, XINT (p
->tick
));
2914 /* If process is still active, read any output that remains. */
2915 if (XINT (p
->infd
) >= 0)
2916 while (! EQ (p
->filter
, Qt
)
2917 && read_process_output (proc
, XINT (p
->infd
)) > 0);
2921 /* Get the text to use for the message. */
2922 if (!NILP (p
->raw_status_low
))
2924 msg
= status_message (p
->status
);
2926 /* If process is terminated, deactivate it or delete it. */
2928 if (XTYPE (p
->status
) == Lisp_Cons
)
2929 symbol
= XCONS (p
->status
)->car
;
2931 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
2932 || EQ (symbol
, Qclosed
))
2934 if (delete_exited_processes
)
2935 remove_process (proc
);
2937 deactivate_process (proc
);
2940 /* Now output the message suitably. */
2941 if (!NILP (p
->sentinel
))
2942 exec_sentinel (proc
, msg
);
2943 /* Don't bother with a message in the buffer
2944 when a process becomes runnable. */
2945 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
2947 Lisp_Object ro
= XBUFFER (buffer
)->read_only
;
2949 struct buffer
*old
= current_buffer
;
2952 /* Avoid error if buffer is deleted
2953 (probably that's why the process is dead, too) */
2954 if (NILP (XBUFFER (buffer
)->name
))
2956 Fset_buffer (buffer
);
2958 /* Insert new output into buffer
2959 at the current end-of-output marker,
2960 thus preserving logical ordering of input and output. */
2961 if (XMARKER (p
->mark
)->buffer
)
2962 SET_PT (marker_position (p
->mark
));
2965 if (point
<= opoint
)
2966 opoint
+= XSTRING (msg
)->size
+ XSTRING (p
->name
)->size
+ 10;
2968 tem
= current_buffer
->read_only
;
2969 current_buffer
->read_only
= Qnil
;
2970 insert_string ("\nProcess ");
2971 Finsert (1, &p
->name
);
2972 insert_string (" ");
2974 current_buffer
->read_only
= tem
;
2975 Fset_marker (p
->mark
, make_number (point
), p
->buffer
);
2978 set_buffer_internal (old
);
2983 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
2984 redisplay_preserve_echo_area ();
2986 update_tick
= process_tick
;
2997 if (! noninteractive
|| initialized
)
2999 signal (SIGCHLD
, sigchld_handler
);
3002 FD_ZERO (&input_wait_mask
);
3004 keyboard_descriptor
= 0;
3005 FD_SET (keyboard_descriptor
, &input_wait_mask
);
3007 Vprocess_alist
= Qnil
;
3008 for (i
= 0; i
< MAXDESC
; i
++)
3010 chan_process
[i
] = Qnil
;
3011 proc_buffered_char
[i
] = -1;
3015 /* From now on, assume keyboard input comes from descriptor DESC. */
3018 change_keyboard_wait_descriptor (desc
)
3021 FD_CLR (keyboard_descriptor
, &input_wait_mask
);
3022 keyboard_descriptor
= desc
;
3023 FD_SET (keyboard_descriptor
, &input_wait_mask
);
3029 stream_process
= intern ("stream");
3031 Qprocessp
= intern ("processp");
3032 staticpro (&Qprocessp
);
3033 Qrun
= intern ("run");
3035 Qstop
= intern ("stop");
3037 Qsignal
= intern ("signal");
3038 staticpro (&Qsignal
);
3040 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
3043 Qexit = intern ("exit");
3044 staticpro (&Qexit); */
3046 Qopen
= intern ("open");
3048 Qclosed
= intern ("closed");
3049 staticpro (&Qclosed
);
3051 staticpro (&Vprocess_alist
);
3053 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
3054 "*Non-nil means delete processes immediately when they exit.\n\
3055 nil means don't delete them until `list-processes' is run.");
3057 delete_exited_processes
= 1;
3059 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
3060 "Control type of device used to communicate with subprocesses.\n\
3061 Values are nil to use a pipe, and t or 'pty for a pty. Note that if\n\
3062 pty's are not available, this variable will be ignored. The value takes\n\
3063 effect when `start-process' is called.");
3064 Vprocess_connection_type
= Qt
;
3066 defsubr (&Sprocessp
);
3067 defsubr (&Sget_process
);
3068 defsubr (&Sget_buffer_process
);
3069 defsubr (&Sdelete_process
);
3070 defsubr (&Sprocess_status
);
3071 defsubr (&Sprocess_exit_status
);
3072 defsubr (&Sprocess_id
);
3073 defsubr (&Sprocess_name
);
3074 defsubr (&Sprocess_command
);
3075 defsubr (&Sset_process_buffer
);
3076 defsubr (&Sprocess_buffer
);
3077 defsubr (&Sprocess_mark
);
3078 defsubr (&Sset_process_filter
);
3079 defsubr (&Sprocess_filter
);
3080 defsubr (&Sset_process_sentinel
);
3081 defsubr (&Sprocess_sentinel
);
3082 defsubr (&Sprocess_kill_without_query
);
3083 defsubr (&Slist_processes
);
3084 defsubr (&Sprocess_list
);
3085 defsubr (&Sstart_process
);
3087 defsubr (&Sopen_network_stream
);
3088 #endif /* HAVE_SOCKETS */
3089 defsubr (&Saccept_process_output
);
3090 defsubr (&Sprocess_send_region
);
3091 defsubr (&Sprocess_send_string
);
3092 defsubr (&Sinterrupt_process
);
3093 defsubr (&Skill_process
);
3094 defsubr (&Squit_process
);
3095 defsubr (&Sstop_process
);
3096 defsubr (&Scontinue_process
);
3097 defsubr (&Sprocess_send_eof
);
3098 defsubr (&Ssignal_process
);
3099 defsubr (&Swaiting_for_user_input_p
);
3100 /* defsubr (&Sprocess_connection); */
3104 #else /* not subprocesses */
3106 #include <sys/types.h>
3110 #include "systime.h"
3111 #include "termopts.h"
3113 extern int frame_garbaged
;
3116 /* As described above, except assuming that there are no subprocesses:
3118 Wait for timeout to elapse and/or keyboard input to be available.
3121 timeout in seconds, or
3122 zero for no limit, or
3123 -1 means gobble data immediately available but don't wait for any.
3125 read_kbd is a Lisp_Object:
3126 0 to ignore keyboard input, or
3127 1 to return when input is available, or
3128 -1 means caller will actually read the input, so don't throw to
3130 We know that read_kbd will never be a Lisp_Process, since
3131 `subprocesses' isn't defined.
3133 do_display != 0 means redisplay should be done to show subprocess
3134 output that arrives. This version of the function ignores it.
3136 Return true iff we received input from any process. */
3139 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
3140 int time_limit
, microsecs
;
3141 Lisp_Object read_kbd
;
3144 EMACS_TIME end_time
, timeout
, *timeout_p
;
3147 /* What does time_limit really mean? */
3148 if (time_limit
|| microsecs
)
3150 /* It's not infinite. */
3151 timeout_p
= &timeout
;
3153 if (time_limit
== -1)
3154 /* In fact, it's zero. */
3155 EMACS_SET_SECS_USECS (timeout
, 0, 0);
3157 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
3159 /* How far in the future is that? */
3160 EMACS_GET_TIME (end_time
);
3161 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
3164 /* It's infinite. */
3167 /* This must come before stop_polling. */
3168 prepare_menu_bars ();
3170 /* Turn off periodic alarms (in case they are in use)
3171 because the select emulator uses alarms. */
3178 waitchannels
= XINT (read_kbd
) ? 1 : 0;
3180 /* If calling from keyboard input, do not quit
3181 since we want to return C-g as an input character.
3182 Otherwise, do pending quit if requested. */
3183 if (XINT (read_kbd
) >= 0)
3188 EMACS_GET_TIME (*timeout_p
);
3189 EMACS_SUB_TIME (*timeout_p
, end_time
, *timeout_p
);
3190 if (EMACS_TIME_NEG_P (*timeout_p
))
3194 /* Cause C-g and alarm signals to take immediate action,
3195 and cause input available signals to zero out timeout. */
3196 if (XINT (read_kbd
) < 0)
3197 set_waiting_for_input (&timeout
);
3199 /* If a frame has been newly mapped and needs updating,
3200 reprocess its display stuff. */
3202 redisplay_preserve_echo_area ();
3204 if (XINT (read_kbd
) && detect_input_pending ())
3207 nfds
= select (1, &waitchannels
, 0, 0, timeout_p
);
3209 /* Make C-g and alarm signals set flags again */
3210 clear_waiting_for_input ();
3212 /* If we woke up due to SIGWINCH, actually change size now. */
3213 do_pending_window_change ();
3217 /* If the system call was interrupted, then go around the
3223 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
3224 /* System sometimes fails to deliver SIGIO. */
3225 kill (getpid (), SIGIO
);
3228 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
3232 /* If we have timed out (nfds == 0) or found some input (nfds > 0),
3244 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
3245 /* Don't confused make-docfile by having two doc strings for this function.
3246 make-docfile does not pay attention to #if, for good reason! */
3249 register Lisp_Object name
;
3254 /* Kill all processes associated with `buffer'.
3255 If `buffer' is nil, kill all processes.
3256 Since we have no subprocesses, this does nothing. */
3258 kill_buffer_processes (buffer
)
3269 defsubr (&Sget_buffer_process
);
3273 #endif /* not subprocesses */