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 Qprocessp
;
77 Lisp_Object Qrun
, Qstop
, Qsignal
, Qopen
, Qclosed
;
78 /* Qexit is declared and initialized in eval.c. */
80 /* a process object is a network connection when its childp field is neither
81 Qt nor Qnil but is instead a string (name of foreign host we
82 are connected to + name of port we are connected to) */
85 static Lisp_Object stream_process
;
87 #define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String)
89 #define NETCONN_P(p) 0
90 #endif /* HAVE_SOCKETS */
92 /* Define first descriptor number available for subprocesses. */
94 #define FIRST_PROC_DESC 1
96 #define FIRST_PROC_DESC 3
99 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
102 #if !defined (SIGCHLD) && defined (SIGCLD)
103 #define SIGCHLD SIGCLD
106 #include "syssignal.h"
112 extern char *sys_errlist
[];
117 extern char *sys_siglist
[];
120 char *sys_siglist
[] =
126 "illegal instruction",
130 "floating point exception",
133 "segmentation violation",
134 "bad argument to system call",
135 "write on a pipe with no one to read it",
137 "software termination signal from kill",
139 "sendable stop signal not from tty",
140 "stop signal from tty",
141 "continue a stopped process",
142 "child status has changed",
143 "background read attempted from control tty",
144 "background write attempted from control tty",
145 "input record available at control tty",
146 "exceeded CPU time limit",
147 "exceeded file size limit"
152 /* t means use pty, nil means use a pipe,
153 maybe other values to come. */
154 static Lisp_Object Vprocess_connection_type
;
158 #include <sys/socket.h>
162 /* Number of events of change of status of a process. */
163 static int process_tick
;
165 /* Number of events for which the user or sentinel has been notified. */
166 static int update_tick
;
169 /* We could get this from param.h, but better not to depend on finding that.
170 And better not to risk that it might define other symbols used in this
173 #define MAXDESC FD_SETSIZE
177 #define SELECT_TYPE fd_set
178 #else /* no FD_SET */
180 #define SELECT_TYPE int
182 /* Define the macros to access a single-int bitmap of descriptors. */
183 #define FD_SET(n, p) (*(p) |= (1 << (n)))
184 #define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
185 #define FD_ISSET(n, p) (*(p) & (1 << (n)))
186 #define FD_ZERO(p) (*(p) = 0)
187 #endif /* no FD_SET */
189 /* Mask of bits indicating the descriptors that we wait for input on */
191 static SELECT_TYPE input_wait_mask
;
193 /* Descriptor to use for keyboard input. */
194 static int keyboard_descriptor
;
196 /* Nonzero means delete a process right away if it exits. */
197 static int delete_exited_processes
;
199 /* Indexed by descriptor, gives the process (if any) for that descriptor */
200 static Lisp_Object chan_process
[MAXDESC
];
202 /* Alist of elements (NAME . PROCESS) */
203 static Lisp_Object Vprocess_alist
;
205 /* Buffered-ahead input char from process, indexed by channel.
206 -1 means empty (no char is buffered).
207 Used on sys V where the only way to tell if there is any
208 output from the process is to read at least one char.
209 Always -1 on systems that support FIONREAD. */
211 static int proc_buffered_char
[MAXDESC
];
213 static Lisp_Object
get_process ();
215 /* Compute the Lisp form of the process status, p->status, from
216 the numeric status that was returned by `wait'. */
218 Lisp_Object
status_convert ();
221 struct Lisp_Process
*p
;
223 union { int i
; WAITTYPE wt
; } u
;
224 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
225 p
->status
= status_convert (u
.wt
);
226 p
->raw_status_low
= Qnil
;
227 p
->raw_status_high
= Qnil
;
230 /* Convert a process status word in Unix format to
231 the list that we use internally. */
238 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
239 else if (WIFEXITED (w
))
240 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
241 WCOREDUMP (w
) ? Qt
: Qnil
));
242 else if (WIFSIGNALED (w
))
243 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
244 WCOREDUMP (w
) ? Qt
: Qnil
));
249 /* Given a status-list, extract the three pieces of information
250 and store them individually through the three pointers. */
253 decode_status (l
, symbol
, code
, coredump
)
261 if (XTYPE (l
) == Lisp_Symbol
)
269 *symbol
= XCONS (l
)->car
;
270 tem
= XCONS (l
)->cdr
;
271 *code
= XFASTINT (XCONS (tem
)->car
);
272 tem
= XCONS (tem
)->cdr
;
273 *coredump
= !NILP (tem
);
277 /* Return a string describing a process status list. */
280 status_message (status
)
285 Lisp_Object string
, string2
;
287 decode_status (status
, &symbol
, &code
, &coredump
);
289 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
292 string
= build_string (code
< NSIG
? sys_siglist
[code
] : "unknown");
294 string
= build_string (code
< NSIG
? sys_errlist
[code
] : "unknown");
296 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
297 XSTRING (string
)->data
[0] = DOWNCASE (XSTRING (string
)->data
[0]);
298 return concat2 (string
, string2
);
300 else if (EQ (symbol
, Qexit
))
303 return build_string ("finished\n");
304 string
= Fnumber_to_string (make_number (code
));
305 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
306 return concat2 (build_string ("exited abnormally with code "),
307 concat2 (string
, string2
));
310 return Fcopy_sequence (Fsymbol_name (symbol
));
315 /* Open an available pty, returning a file descriptor.
316 Return -1 on failure.
317 The file name of the terminal corresponding to the pty
318 is left in the variable pty_name. */
329 /* Some systems name their pseudoterminals so that there are gaps in
330 the usual sequence - for example, on HP9000/S700 systems, there
331 are no pseudoterminals with names ending in 'f'. So we wait for
332 three failures in a row before deciding that we've reached the
334 int failed_count
= 0;
339 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
340 for (i
= 0; i
< 16; i
++)
343 #ifdef PTY_NAME_SPRINTF
346 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
347 #endif /* no PTY_NAME_SPRINTF */
351 #else /* no PTY_OPEN */
353 /* Unusual IRIS code */
354 *ptyv
= open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
357 if (fstat (fd
, &stb
) < 0)
360 if (stat (pty_name
, &stb
) < 0)
363 if (failed_count
>= 3)
369 fd
= open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
371 fd
= open (pty_name
, O_RDWR
| O_NDELAY
, 0);
373 #endif /* not IRIS */
374 #endif /* no PTY_OPEN */
378 /* check to make certain that both sides are available
379 this avoids a nasty yet stupid bug in rlogins */
380 #ifdef PTY_TTY_NAME_SPRINTF
383 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
384 #endif /* no PTY_TTY_NAME_SPRINTF */
386 if (access (pty_name
, 6) != 0)
389 #if !defined(IRIS) && !defined(__sgi)
395 #endif /* not UNIPLUS */
402 #endif /* HAVE_PTYS */
408 register Lisp_Object val
, tem
, name1
;
409 register struct Lisp_Process
*p
;
413 /* size of process structure includes the vector header,
414 so deduct for that. But struct Lisp_Vector includes the first
415 element, thus deducts too much, so add it back. */
416 val
= Fmake_vector (make_number ((sizeof (struct Lisp_Process
)
417 - sizeof (struct Lisp_Vector
)
418 + sizeof (Lisp_Object
))
419 / sizeof (Lisp_Object
)),
421 XSETTYPE (val
, Lisp_Process
);
424 XFASTINT (p
->infd
) = 0;
425 XFASTINT (p
->outfd
) = 0;
426 XFASTINT (p
->pid
) = 0;
427 XFASTINT (p
->tick
) = 0;
428 XFASTINT (p
->update_tick
) = 0;
429 p
->raw_status_low
= Qnil
;
430 p
->raw_status_high
= Qnil
;
432 p
->mark
= Fmake_marker ();
434 /* If name is already in use, modify it until it is unused. */
439 tem
= Fget_process (name1
);
440 if (NILP (tem
)) break;
441 sprintf (suffix
, "<%d>", i
);
442 name1
= concat2 (name
, build_string (suffix
));
446 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
450 remove_process (proc
)
451 register Lisp_Object proc
;
453 register Lisp_Object pair
;
455 pair
= Frassq (proc
, Vprocess_alist
);
456 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
457 Fset_marker (XPROCESS (proc
)->mark
, Qnil
, Qnil
);
459 deactivate_process (proc
);
462 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
463 "Return t if OBJECT is a process.")
467 return XTYPE (obj
) == Lisp_Process
? Qt
: Qnil
;
470 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
471 "Return the process named NAME, or nil if there is none.")
473 register Lisp_Object name
;
475 if (XTYPE (name
) == Lisp_Process
)
477 CHECK_STRING (name
, 0);
478 return Fcdr (Fassoc (name
, Vprocess_alist
));
481 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
482 "Return the (or, a) process associated with BUFFER.\n\
483 BUFFER may be a buffer or the name of one.")
485 register Lisp_Object name
;
487 register Lisp_Object buf
, tail
, proc
;
489 if (NILP (name
)) return Qnil
;
490 buf
= Fget_buffer (name
);
491 if (NILP (buf
)) return Qnil
;
493 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
495 proc
= Fcdr (Fcar (tail
));
496 if (XTYPE (proc
) == Lisp_Process
&& EQ (XPROCESS (proc
)->buffer
, buf
))
502 /* This is how commands for the user decode process arguments. It
503 accepts a process, a process name, a buffer, a buffer name, or nil.
504 Buffers denote the first process in the buffer, and nil denotes the
509 register Lisp_Object name
;
511 register Lisp_Object proc
;
513 proc
= Fget_buffer_process (Fcurrent_buffer ());
516 proc
= Fget_process (name
);
518 proc
= Fget_buffer_process (Fget_buffer (name
));
525 error ("Current buffer has no process");
527 error ("Process %s does not exist", XSTRING (name
)->data
);
531 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
532 "Delete PROCESS: kill it and forget about it immediately.\n\
533 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
534 nil, indicating the current buffer's process.")
536 register Lisp_Object proc
;
538 proc
= get_process (proc
);
539 XPROCESS (proc
)->raw_status_low
= Qnil
;
540 XPROCESS (proc
)->raw_status_high
= Qnil
;
541 if (NETCONN_P (proc
))
543 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
544 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
546 else if (XFASTINT (XPROCESS (proc
)->infd
))
548 Fkill_process (proc
, Qnil
);
549 /* Do this now, since remove_process will make sigchld_handler do nothing. */
550 XPROCESS (proc
)->status
551 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
552 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
555 remove_process (proc
);
559 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
560 "Return the status of PROCESS: a symbol, one of these:\n\
561 run -- for a process that is running.\n\
562 stop -- for a process stopped but continuable.\n\
563 exit -- for a process that has exited.\n\
564 signal -- for a process that has got a fatal signal.\n\
565 open -- for a network stream connection that is open.\n\
566 closed -- for a network stream connection that is closed.\n\
567 nil -- if arg is a process name and no such process exists.\n\
568 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
569 nil, indicating the current buffer's process.")
571 register Lisp_Object proc
;
573 register struct Lisp_Process
*p
;
574 register Lisp_Object status
;
575 proc
= Fget_process (proc
);
579 if (!NILP (p
->raw_status_low
))
582 if (XTYPE (status
) == Lisp_Cons
)
583 status
= XCONS (status
)->car
;
584 if (NETCONN_P (proc
))
586 if (EQ (status
, Qrun
))
588 else if (EQ (status
, Qexit
))
594 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
596 "Return the exit status of PROCESS or the signal number that killed it.\n\
597 If PROCESS has not yet exited or died, return 0.")
599 register Lisp_Object proc
;
601 CHECK_PROCESS (proc
, 0);
602 if (!NILP (XPROCESS (proc
)->raw_status_low
))
603 update_status (XPROCESS (proc
));
604 if (XTYPE (XPROCESS (proc
)->status
) == Lisp_Cons
)
605 return XCONS (XCONS (XPROCESS (proc
)->status
)->cdr
)->car
;
606 return make_number (0);
609 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
610 "Return the process id of PROCESS.\n\
611 This is the pid of the Unix process which PROCESS uses or talks to.\n\
612 For a network connection, this value is nil.")
614 register Lisp_Object proc
;
616 CHECK_PROCESS (proc
, 0);
617 return XPROCESS (proc
)->pid
;
620 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
621 "Return the name of PROCESS, as a string.\n\
622 This is the name of the program invoked in PROCESS,\n\
623 possibly modified to make it unique among process names.")
625 register Lisp_Object proc
;
627 CHECK_PROCESS (proc
, 0);
628 return XPROCESS (proc
)->name
;
631 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
632 "Return the command that was executed to start PROCESS.\n\
633 This is a list of strings, the first string being the program executed\n\
634 and the rest of the strings being the arguments given to it.\n\
635 For a non-child channel, this is nil.")
637 register Lisp_Object proc
;
639 CHECK_PROCESS (proc
, 0);
640 return XPROCESS (proc
)->command
;
643 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
645 "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
647 register Lisp_Object proc
, buffer
;
649 CHECK_PROCESS (proc
, 0);
651 CHECK_BUFFER (buffer
, 1);
652 XPROCESS (proc
)->buffer
= buffer
;
656 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
658 "Return the buffer PROCESS is associated with.\n\
659 Output from PROCESS is inserted in this buffer\n\
660 unless PROCESS has a filter.")
662 register Lisp_Object proc
;
664 CHECK_PROCESS (proc
, 0);
665 return XPROCESS (proc
)->buffer
;
668 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
670 "Return the marker for the end of the last output from PROCESS.")
672 register Lisp_Object proc
;
674 CHECK_PROCESS (proc
, 0);
675 return XPROCESS (proc
)->mark
;
678 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
680 "Give PROCESS the filter function FILTER; nil means no filter.\n\
681 When a process has a filter, each time it does output\n\
682 the entire string of output is passed to the filter.\n\
683 The filter gets two arguments: the process and the string of output.\n\
684 If the process has a filter, its buffer is not used for output.")
686 register Lisp_Object proc
, filter
;
688 CHECK_PROCESS (proc
, 0);
689 XPROCESS (proc
)->filter
= filter
;
693 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
695 "Returns the filter function of PROCESS; nil if none.\n\
696 See `set-process-filter' for more info on filter functions.")
698 register Lisp_Object proc
;
700 CHECK_PROCESS (proc
, 0);
701 return XPROCESS (proc
)->filter
;
704 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
706 "Give PROCESS the sentinel SENTINEL; nil for none.\n\
707 The sentinel is called as a function when the process changes state.\n\
708 It gets two arguments: the process, and a string describing the change.")
710 register Lisp_Object proc
, sentinel
;
712 CHECK_PROCESS (proc
, 0);
713 XPROCESS (proc
)->sentinel
= sentinel
;
717 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
719 "Return the sentinel of PROCESS; nil if none.\n\
720 See `set-process-sentinel' for more info on sentinels.")
722 register Lisp_Object proc
;
724 CHECK_PROCESS (proc
, 0);
725 return XPROCESS (proc
)->sentinel
;
728 DEFUN ("process-kill-without-query", Fprocess_kill_without_query
,
729 Sprocess_kill_without_query
, 1, 2, 0,
730 "Say no query needed if PROCESS is running when Emacs is exited.\n\
731 Optional second argument if non-nill says to require a query.\n\
732 Value is t if a query was formerly required.")
734 register Lisp_Object proc
, value
;
738 CHECK_PROCESS (proc
, 0);
739 tem
= XPROCESS (proc
)->kill_without_query
;
740 XPROCESS (proc
)->kill_without_query
= Fnull (value
);
745 #if 0 /* Turned off because we don't currently record this info
746 in the process. Perhaps add it. */
747 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
748 "Return the connection type of `PROCESS'.\n\
749 The value is `nil' for a pipe,\n\
750 `t' or `pty' for a pty, or `stream' for a socket connection.")
754 return XPROCESS (process
)->type
;
761 register Lisp_Object tail
, tem
;
762 Lisp_Object proc
, minspace
, tem1
;
763 register struct buffer
*old
= current_buffer
;
764 register struct Lisp_Process
*p
;
768 XFASTINT (minspace
) = 1;
770 set_buffer_internal (XBUFFER (Vstandard_output
));
771 Fbuffer_disable_undo (Vstandard_output
);
773 current_buffer
->truncate_lines
= Qt
;
776 Proc Status Buffer Command\n\
777 ---- ------ ------ -------\n", -1);
779 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
783 proc
= Fcdr (Fcar (tail
));
785 if (NILP (p
->childp
))
788 Finsert (1, &p
->name
);
789 Findent_to (make_number (13), minspace
);
791 if (!NILP (p
->raw_status_low
))
794 if (XTYPE (p
->status
) == Lisp_Cons
)
795 symbol
= XCONS (p
->status
)->car
;
798 if (EQ (symbol
, Qsignal
))
801 tem
= Fcar (Fcdr (p
->status
));
803 if (XINT (tem
) < NSIG
)
804 write_string (sys_errlist
[XINT (tem
)], -1);
807 Fprinc (symbol
, Qnil
);
809 else if (NETCONN_P (proc
))
811 if (EQ (symbol
, Qrun
))
812 write_string ("open", -1);
813 else if (EQ (symbol
, Qexit
))
814 write_string ("closed", -1);
816 Fprinc (symbol
, Qnil
);
819 Fprinc (symbol
, Qnil
);
821 if (EQ (symbol
, Qexit
))
824 tem
= Fcar (Fcdr (p
->status
));
827 sprintf (tembuf
, " %d", XFASTINT (tem
));
828 write_string (tembuf
, -1);
832 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
833 remove_process (proc
);
835 Findent_to (make_number (22), minspace
);
836 if (NILP (p
->buffer
))
837 insert_string ("(none)");
838 else if (NILP (XBUFFER (p
->buffer
)->name
))
839 insert_string ("(Killed)");
841 Finsert (1, &XBUFFER (p
->buffer
)->name
);
843 Findent_to (make_number (37), minspace
);
845 if (NETCONN_P (proc
))
847 sprintf (tembuf
, "(network stream connection to %s)\n",
848 XSTRING (p
->childp
)->data
);
849 insert_string (tembuf
);
863 insert_string ("\n");
869 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 0, "",
870 "Display a list of all processes.\n\
871 \(Any processes listed as Exited or Signaled are actually eliminated\n\
872 after the listing is made.)")
875 internal_with_output_to_temp_buffer ("*Process List*",
876 list_processes_1
, Qnil
);
880 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
881 "Return a list of all processes.")
884 return Fmapcar (Qcdr
, Vprocess_alist
);
887 /* Starting asynchronous inferior processes. */
889 static Lisp_Object
start_process_unwind ();
891 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
892 "Start a program in a subprocess. Return the process object for it.\n\
893 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
894 NAME is name for process. It is modified if necessary to make it unique.\n\
895 BUFFER is the buffer or (buffer-name) to associate with the process.\n\
896 Process output goes at end of that buffer, unless you specify\n\
897 an output stream or filter function to handle the output.\n\
898 BUFFER may be also nil, meaning that this process is not associated\n\
900 Third arg is program file name. It is searched for as in the shell.\n\
901 Remaining arguments are strings to give program as arguments.")
904 register Lisp_Object
*args
;
906 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
908 register unsigned char *new_argv
;
911 register unsigned char **new_argv
;
914 int count
= specpdl_ptr
- specpdl
;
918 buffer
= Fget_buffer_create (buffer
);
920 /* Make sure that the child will be able to chdir to the current
921 buffer's current directory, or its unhandled equivalent. We
922 can't just have the child check for an error when it does the
923 chdir, since it's in a vfork.
925 We have to GCPRO around this because Fexpand_file_name and
926 Funhandled_file_name_directory might call a file name handling
927 function. The argument list is protected by the caller, so all
928 we really have to worry about is buffer. */
930 struct gcpro gcpro1
, gcpro2
;
932 current_dir
= current_buffer
->directory
;
934 GCPRO2 (buffer
, current_dir
);
937 expand_and_dir_to_file
938 (Funhandled_file_name_directory (current_dir
), Qnil
);
939 if (NILP (Ffile_accessible_directory_p (current_dir
)))
940 report_file_error ("Setting current directory",
941 Fcons (current_buffer
->directory
, Qnil
));
947 CHECK_STRING (name
, 0);
951 CHECK_STRING (program
, 2);
954 /* Make a one member argv with all args concatenated
955 together separated by a blank. */
956 len
= XSTRING (program
)->size
+ 2;
957 for (i
= 3; i
< nargs
; i
++)
960 CHECK_STRING (tem
, i
);
961 len
+= XSTRING (tem
)->size
+ 1; /* count the blank */
963 new_argv
= (unsigned char *) alloca (len
);
964 strcpy (new_argv
, XSTRING (program
)->data
);
965 for (i
= 3; i
< nargs
; i
++)
968 CHECK_STRING (tem
, i
);
969 strcat (new_argv
, " ");
970 strcat (new_argv
, XSTRING (tem
)->data
);
972 /* Need to add code here to check for program existence on VMS */
975 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
977 for (i
= 3; i
< nargs
; i
++)
980 CHECK_STRING (tem
, i
);
981 new_argv
[i
- 2] = XSTRING (tem
)->data
;
984 new_argv
[0] = XSTRING (program
)->data
;
986 /* If program file name is not absolute, search our path for it */
987 if (new_argv
[0][0] != '/')
990 openp (Vexec_path
, program
, EXEC_SUFFIXES
, &tem
, 1);
992 report_file_error ("Searching for program", Fcons (program
, Qnil
));
993 new_argv
[0] = XSTRING (tem
)->data
;
997 proc
= make_process (name
);
998 /* If an error occurs and we can't start the process, we want to
999 remove it from the process list. This means that each error
1000 check in create_process doesn't need to call remove_process
1001 itself; it's all taken care of here. */
1002 record_unwind_protect (start_process_unwind
, proc
);
1004 XPROCESS (proc
)->childp
= Qt
;
1005 XPROCESS (proc
)->command_channel_p
= Qnil
;
1006 XPROCESS (proc
)->buffer
= buffer
;
1007 XPROCESS (proc
)->sentinel
= Qnil
;
1008 XPROCESS (proc
)->filter
= Qnil
;
1009 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1011 create_process (proc
, new_argv
, current_dir
);
1013 return unbind_to (count
, proc
);
1016 /* This function is the unwind_protect form for Fstart_process. If
1017 PROC doesn't have its pid set, then we know someone has signalled
1018 an error and the process wasn't started successfully, so we should
1019 remove it from the process list. */
1021 start_process_unwind (proc
)
1024 if (XTYPE (proc
) != Lisp_Process
)
1027 /* Was PROC started successfully? */
1028 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1029 remove_process (proc
);
1036 create_process_1 (signo
)
1040 /* USG systems forget handlers when they are used;
1041 must reestablish each time */
1042 signal (signo
, create_process_1
);
1046 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1049 /* Mimic blocking of signals on system V, which doesn't really have it. */
1051 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1052 int sigchld_deferred
;
1055 create_process_sigchld ()
1057 signal (SIGCHLD
, create_process_sigchld
);
1059 sigchld_deferred
= 1;
1065 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1066 create_process (process
, new_argv
, current_dir
)
1067 Lisp_Object process
;
1069 Lisp_Object current_dir
;
1071 int pid
, inchannel
, outchannel
, forkin
, forkout
;
1074 SIGTYPE (*sigchld
)();
1077 extern char **environ
;
1079 inchannel
= outchannel
= -1;
1082 if (EQ (Vprocess_connection_type
, Qt
))
1083 outchannel
= inchannel
= allocate_pty ();
1088 /* On USG systems it does not work to open the pty's tty here
1089 and then close and reopen it in the child. */
1091 /* Don't let this terminal become our controlling terminal
1092 (in case we don't have one). */
1093 forkout
= forkin
= open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1095 forkout
= forkin
= open (pty_name
, O_RDWR
, 0);
1098 report_file_error ("Opening pty", Qnil
);
1100 forkin
= forkout
= -1;
1101 #endif /* not USG */
1105 #endif /* HAVE_PTYS */
1108 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1109 report_file_error ("Opening socketpair", Qnil
);
1110 outchannel
= inchannel
= sv
[0];
1111 forkout
= forkin
= sv
[1];
1113 #else /* not SKTPAIR */
1122 #endif /* not SKTPAIR */
1125 /* Replaced by close_process_descs */
1126 set_exclusive_use (inchannel
);
1127 set_exclusive_use (outchannel
);
1130 /* Stride people say it's a mystery why this is needed
1131 as well as the O_NDELAY, but that it fails without this. */
1132 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1135 ioctl (inchannel
, FIONBIO
, &one
);
1140 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1143 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1147 /* Record this as an active process, with its channels.
1148 As a result, child_setup will close Emacs's side of the pipes. */
1149 chan_process
[inchannel
] = process
;
1150 XFASTINT (XPROCESS (process
)->infd
) = inchannel
;
1151 XFASTINT (XPROCESS (process
)->outfd
) = outchannel
;
1152 /* Record the tty descriptor used in the subprocess. */
1154 XPROCESS (process
)->subtty
= Qnil
;
1156 XFASTINT (XPROCESS (process
)->subtty
) = forkin
;
1157 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1158 XPROCESS (process
)->status
= Qrun
;
1160 /* Delay interrupts until we have a chance to store
1161 the new fork's pid in its process structure */
1165 #else /* not BSD4_1 */
1166 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1167 sigsetmask (sigmask (SIGCHLD
));
1168 #else /* ordinary USG */
1170 sigchld_deferred
= 0;
1171 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1173 #endif /* ordinary USG */
1174 #endif /* not BSD4_1 */
1175 #endif /* SIGCHLD */
1177 /* Until we store the proper pid, enable sigchld_handler
1178 to recognize an unknown pid as standing for this process.
1179 It is very important not to let this `marker' value stay
1180 in the table after this function has returned; if it does
1181 it might cause call-process to hang and subsequent asynchronous
1182 processes to get their return values scrambled. */
1183 XSETINT (XPROCESS (process
)->pid
, -1);
1186 /* child_setup must clobber environ on systems with true vfork.
1187 Protect it from permanent change. */
1188 char **save_environ
= environ
;
1193 int xforkin
= forkin
;
1194 int xforkout
= forkout
;
1196 #if 0 /* This was probably a mistake--it duplicates code later on,
1197 but fails to handle all the cases. */
1198 /* Make sure SIGCHLD is not blocked in the child. */
1199 sigsetmask (SIGEMPTYMASK
);
1202 /* Make the pty be the controlling terminal of the process. */
1204 /* First, disconnect its current controlling terminal. */
1208 /* Make the pty's terminal the controlling terminal. */
1210 /* We ignore the return value
1211 because faith@cs.unc.edu says that is necessary on Linux. */
1212 ioctl (xforkin
, TIOCSCTTY
, 0);
1214 #else /* not HAVE_SETSID */
1215 #if defined (USG) && !defined (IRIX)
1216 /* It's very important to call setpgrp() here and no time
1217 afterwards. Otherwise, we lose our controlling tty which
1218 is set when we open the pty. */
1221 #endif /* not HAVE_SETSID */
1223 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1224 can do TIOCSPGRP only to the process's controlling tty. */
1227 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1228 I can't test it since I don't have 4.3. */
1229 int j
= open ("/dev/tty", O_RDWR
, 0);
1230 ioctl (j
, TIOCNOTTY
, 0);
1233 /* In order to get a controlling terminal on some versions
1234 of BSD, it is necessary to put the process in pgrp 0
1235 before it opens the terminal. */
1239 #endif /* TIOCNOTTY */
1241 #if !defined (RTU) && !defined (UNIPLUS)
1242 /*** There is a suggestion that this ought to be a
1243 conditional on TIOCSPGRP. */
1244 /* Now close the pty (if we had it open) and reopen it.
1245 This makes the pty the controlling terminal of the subprocess. */
1248 /* I wonder if close (open (pty_name, ...)) would work? */
1251 xforkout
= xforkin
= open (pty_name
, O_RDWR
, 0);
1256 #endif /* not UNIPLUS and not RTU */
1257 #ifdef SETUP_SLAVE_PTY
1259 #endif /* SETUP_SLAVE_PTY */
1261 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1262 Now reenable it in the child, so it will die when we want it to. */
1264 signal (SIGHUP
, SIG_DFL
);
1266 #endif /* HAVE_PTYS */
1271 #else /* not BSD4_1 */
1272 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1273 sigsetmask (SIGEMPTYMASK
);
1274 #else /* ordinary USG */
1276 signal (SIGCHLD
, sigchld
);
1278 #endif /* ordinary USG */
1279 #endif /* not BSD4_1 */
1280 #endif /* SIGCHLD */
1282 child_setup_tty (xforkout
);
1283 child_setup (xforkin
, xforkout
, xforkout
,
1284 new_argv
, 1, current_dir
);
1286 environ
= save_environ
;
1290 report_file_error ("Doing vfork", Qnil
);
1292 XFASTINT (XPROCESS (process
)->pid
) = pid
;
1294 FD_SET (inchannel
, &input_wait_mask
);
1296 /* If the subfork execv fails, and it exits,
1297 this close hangs. I don't know why.
1298 So have an interrupt jar it loose. */
1300 signal (SIGALRM
, create_process_1
);
1303 /* OK to close only if it's not a pty. Otherwise we need to leave
1304 it open for ioctl to get pgrp when signals are sent, or to send
1305 the interrupt characters through if that's how we're signalling
1306 subprocesses. Alternately if you are concerned about running out
1307 of file descriptors, you could just save the tty name and open
1308 just to do the ioctl. */
1309 if (NILP (XFASTINT (XPROCESS (process
)->pty_flag
)))
1312 XPROCESS (process
)->subtty
= Qnil
;
1318 if (forkin
!= forkout
&& forkout
>= 0)
1324 #else /* not BSD4_1 */
1325 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1326 sigsetmask (SIGEMPTYMASK
);
1327 #else /* ordinary USG */
1329 signal (SIGCHLD
, sigchld
);
1330 /* Now really handle any of these signals
1331 that came in during this function. */
1332 if (sigchld_deferred
)
1333 kill (getpid (), SIGCHLD
);
1335 #endif /* ordinary USG */
1336 #endif /* not BSD4_1 */
1337 #endif /* SIGCHLD */
1339 #endif /* not VMS */
1343 /* open a TCP network connection to a given HOST/SERVICE. Treated
1344 exactly like a normal process when reading and writing. Only
1345 differences are in status display and process deletion. A network
1346 connection has no PID; you cannot signal it. All you can do is
1347 deactivate and close it via delete-process */
1349 DEFUN ("open-network-stream", Fopen_network_stream
, Sopen_network_stream
,
1351 "Open a TCP connection for a service to a host.\n\
1352 Returns a subprocess-object to represent the connection.\n\
1353 Input and output work as for subprocesses; `delete-process' closes it.\n\
1354 Args are NAME BUFFER HOST SERVICE.\n\
1355 NAME is name for process. It is modified if necessary to make it unique.\n\
1356 BUFFER is the buffer (or buffer-name) to associate with the process.\n\
1357 Process output goes at end of that buffer, unless you specify\n\
1358 an output stream or filter function to handle the output.\n\
1359 BUFFER may be also nil, meaning that this process is not associated\n\
1361 Third arg is name of the host to connect to, or its IP address.\n\
1362 Fourth arg SERVICE is name of the service desired, or an integer\n\
1363 specifying a port number to connect to.")
1364 (name
, buffer
, host
, service
)
1365 Lisp_Object name
, buffer
, host
, service
;
1369 struct sockaddr_in address
;
1370 struct servent
*svc_info
;
1371 struct hostent
*host_info_ptr
, host_info
;
1372 char *(addr_list
[2]);
1373 unsigned long numeric_addr
;
1377 struct hostent host_info_fixed
;
1378 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1380 GCPRO4 (name
, buffer
, host
, service
);
1381 CHECK_STRING (name
, 0);
1382 CHECK_STRING (host
, 0);
1383 if (XTYPE(service
) == Lisp_Int
)
1384 port
= htons ((unsigned short) XINT (service
));
1387 CHECK_STRING (service
, 0);
1388 svc_info
= getservbyname (XSTRING (service
)->data
, "tcp");
1390 error ("Unknown service \"%s\"", XSTRING (service
)->data
);
1391 port
= svc_info
->s_port
;
1394 host_info_ptr
= gethostbyname (XSTRING (host
)->data
);
1395 if (host_info_ptr
== 0)
1396 /* Attempt to interpret host as numeric inet address */
1398 numeric_addr
= inet_addr (XSTRING (host
)->data
);
1399 if (numeric_addr
== -1)
1400 error ("Unknown host \"%s\"", XSTRING (host
)->data
);
1402 host_info_ptr
= &host_info
;
1403 host_info
.h_name
= 0;
1404 host_info
.h_aliases
= 0;
1405 host_info
.h_addrtype
= AF_INET
;
1407 /* Older machines have only one address slot called h_addr.
1408 Newer machines have h_addr_list, but #define h_addr to
1409 be its first element. */
1410 host_info
.h_addr_list
= &(addr_list
[0]);
1412 host_info
.h_addr
= (char*)(&numeric_addr
);
1414 host_info
.h_length
= strlen (addr_list
[0]);
1417 bzero (&address
, sizeof address
);
1418 bcopy (host_info_ptr
->h_addr
, (char *) &address
.sin_addr
,
1419 host_info_ptr
->h_length
);
1420 address
.sin_family
= host_info_ptr
->h_addrtype
;
1421 address
.sin_port
= port
;
1423 s
= socket (host_info_ptr
->h_addrtype
, SOCK_STREAM
, 0);
1425 report_file_error ("error creating socket", Fcons (name
, Qnil
));
1428 if (connect (s
, (struct sockaddr
*) &address
, sizeof address
) == -1)
1435 report_file_error ("connection failed",
1436 Fcons (host
, Fcons (name
, Qnil
)));
1442 report_file_error ("error duplicating socket", Fcons (name
, Qnil
));
1445 buffer
= Fget_buffer_create (buffer
);
1446 proc
= make_process (name
);
1448 chan_process
[inch
] = proc
;
1451 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
1454 fcntl (inch
, F_SETFL
, O_NDELAY
);
1458 XPROCESS (proc
)->childp
= host
;
1459 XPROCESS (proc
)->command_channel_p
= Qnil
;
1460 XPROCESS (proc
)->buffer
= buffer
;
1461 XPROCESS (proc
)->sentinel
= Qnil
;
1462 XPROCESS (proc
)->filter
= Qnil
;
1463 XPROCESS (proc
)->command
= Qnil
;
1464 XPROCESS (proc
)->pid
= Qnil
;
1465 XFASTINT (XPROCESS (proc
)->infd
) = s
;
1466 XFASTINT (XPROCESS (proc
)->outfd
) = outch
;
1467 XPROCESS (proc
)->status
= Qrun
;
1468 FD_SET (inch
, &input_wait_mask
);
1473 #endif /* HAVE_SOCKETS */
1475 deactivate_process (proc
)
1478 register int inchannel
, outchannel
;
1479 register struct Lisp_Process
*p
= XPROCESS (proc
);
1481 inchannel
= XFASTINT (p
->infd
);
1482 outchannel
= XFASTINT (p
->outfd
);
1486 /* Beware SIGCHLD hereabouts. */
1487 flush_pending_output (inchannel
);
1490 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
1491 sys$
dassgn (outchannel
);
1492 vs
= get_vms_process_pointer (p
->pid
);
1494 give_back_vms_process_stuff (vs
);
1498 if (outchannel
&& outchannel
!= inchannel
)
1502 XFASTINT (p
->infd
) = 0;
1503 XFASTINT (p
->outfd
) = 0;
1504 chan_process
[inchannel
] = Qnil
;
1505 FD_CLR (inchannel
, &input_wait_mask
);
1509 /* Close all descriptors currently in use for communication
1510 with subprocess. This is used in a newly-forked subprocess
1511 to get rid of irrelevant descriptors. */
1513 close_process_descs ()
1516 for (i
= 0; i
< MAXDESC
; i
++)
1518 Lisp_Object process
;
1519 process
= chan_process
[i
];
1520 if (!NILP (process
))
1522 int in
= XFASTINT (XPROCESS (process
)->infd
);
1523 int out
= XFASTINT (XPROCESS (process
)->outfd
);
1526 if (out
&& in
!= out
)
1532 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
1534 "Allow any pending output from subprocesses to be read by Emacs.\n\
1535 It is read into the process' buffers or given to their filter functions.\n\
1536 Non-nil arg PROCESS means do not return until some output has been received\n\
1538 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\
1539 seconds and microseconds to wait; return after that much time whether\n\
1540 or not there is input.\n\
1541 Return non-nil iff we received any output before the timeout expired.")
1542 (proc
, timeout
, timeout_msecs
)
1543 register Lisp_Object proc
, timeout
, timeout_msecs
;
1548 if (! NILP (timeout_msecs
))
1550 CHECK_NUMBER (timeout_msecs
, 2);
1551 useconds
= XINT (timeout_msecs
);
1552 if (XTYPE (timeout
) != Lisp_Int
)
1553 XSET (timeout
, Lisp_Int
, 0);
1556 int carry
= useconds
/ 1000000;
1558 XSETINT (timeout
, XINT (timeout
) + carry
);
1559 useconds
-= carry
* 1000000;
1561 /* I think this clause is necessary because C doesn't
1562 guarantee a particular rounding direction for negative
1566 XSETINT (timeout
, XINT (timeout
) - 1);
1567 useconds
+= 1000000;
1574 if (! NILP (timeout
))
1576 CHECK_NUMBER (timeout
, 1);
1577 seconds
= XINT (timeout
);
1590 XFASTINT (proc
) = 0;
1593 (wait_reading_process_input (seconds
, useconds
, proc
, 0)
1597 /* This variable is different from waiting_for_input in keyboard.c.
1598 It is used to communicate to a lisp process-filter/sentinel (via the
1599 function Fwaiting_for_user_input_p below) whether emacs was waiting
1600 for user-input when that process-filter was called.
1601 waiting_for_input cannot be used as that is by definition 0 when
1602 lisp code is being evalled */
1603 static int waiting_for_user_input_p
;
1605 /* Read and dispose of subprocess output while waiting for timeout to
1606 elapse and/or keyboard input to be available.
1609 timeout in seconds, or
1610 zero for no limit, or
1611 -1 means gobble data immediately available but don't wait for any.
1614 an additional duration to wait, measured in microseconds.
1615 If this is nonzero and time_limit is 0, then the timeout
1616 consists of MICROSECS only.
1618 READ_KBD is a lisp value:
1619 0 to ignore keyboard input, or
1620 1 to return when input is available, or
1621 -1 meaning caller will actually read the input, so don't throw to
1622 the quit handler, or
1623 a cons cell, meaning wait wait until its car is non-nil
1624 (and gobble terminal input into the buffer if any arrives), or
1625 a process object, meaning wait until something arrives from that
1626 process. The return value is true iff we read some input from
1629 DO_DISPLAY != 0 means redisplay should be done to show subprocess
1630 output that arrives.
1632 If READ_KBD is a pointer to a struct Lisp_Process, then the
1633 function returns true iff we received input from that process
1634 before the timeout elapsed.
1635 Otherwise, return true iff we received input from any process. */
1637 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
1638 int time_limit
, microsecs
;
1639 Lisp_Object read_kbd
;
1642 register int channel
, nfds
, m
;
1643 static SELECT_TYPE Available
;
1646 EMACS_TIME timeout
, end_time
, garbage
;
1648 int wait_channel
= 0;
1649 struct Lisp_Process
*wait_proc
= 0;
1650 int got_some_input
= 0;
1651 Lisp_Object
*wait_for_cell
= 0;
1653 FD_ZERO (&Available
);
1655 /* If read_kbd is a process to watch, set wait_proc and wait_channel
1657 if (XTYPE (read_kbd
) == Lisp_Process
)
1659 wait_proc
= XPROCESS (read_kbd
);
1660 wait_channel
= XFASTINT (wait_proc
->infd
);
1661 XFASTINT (read_kbd
) = 0;
1664 /* If waiting for non-nil in a cell, record where. */
1665 if (XTYPE (read_kbd
) == Lisp_Cons
)
1667 wait_for_cell
= &XCONS (read_kbd
)->car
;
1668 XFASTINT (read_kbd
) = 0;
1671 waiting_for_user_input_p
= XINT (read_kbd
);
1673 /* Since we may need to wait several times,
1674 compute the absolute time to return at. */
1675 if (time_limit
|| microsecs
)
1677 EMACS_GET_TIME (end_time
);
1678 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
1679 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
1684 /* If calling from keyboard input, do not quit
1685 since we want to return C-g as an input character.
1686 Otherwise, do pending quit if requested. */
1687 if (XINT (read_kbd
) >= 0)
1690 /* Exit now if the cell we're waiting for became non-nil. */
1691 if (wait_for_cell
&& ! NILP (*wait_for_cell
))
1694 /* Compute time from now till when time limit is up */
1695 /* Exit if already run out */
1696 if (time_limit
== -1)
1698 /* -1 specified for timeout means
1699 gobble output available now
1700 but don't wait at all. */
1702 EMACS_SET_SECS_USECS (timeout
, 0, 0);
1704 else if (time_limit
|| microsecs
)
1706 EMACS_GET_TIME (timeout
);
1707 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
1708 if (EMACS_TIME_NEG_P (timeout
))
1713 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
1716 /* Cause C-g and alarm signals to take immediate action,
1717 and cause input available signals to zero out timeout.
1719 It is important that we do this before checking for process
1720 activity. If we get a SIGCHLD after the explicit checks for
1721 process activity, timeout is the only way we will know. */
1722 if (XINT (read_kbd
) < 0)
1723 set_waiting_for_input (&timeout
);
1725 /* If status of something has changed, and no input is
1726 available, notify the user of the change right away. After
1727 this explicit check, we'll let the SIGCHLD handler zap
1728 timeout to get our attention. */
1729 if (update_tick
!= process_tick
&& do_display
)
1731 Atemp
= input_wait_mask
;
1732 EMACS_SET_SECS_USECS (timeout
, 0, 0);
1733 if (select (MAXDESC
, &Atemp
, 0, 0, &timeout
) <= 0)
1735 /* It's okay for us to do this and then continue with
1736 the loop, since timeout has already been zeroed out. */
1737 clear_waiting_for_input ();
1742 /* Don't wait for output from a non-running process. */
1743 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
1744 update_status (wait_proc
);
1746 && ! EQ (wait_proc
->status
, Qrun
))
1748 clear_waiting_for_input ();
1752 /* Wait till there is something to do */
1754 Available
= input_wait_mask
;
1755 /* We used to have && wait_for_cell == 0
1756 but that led to lossage handling selection_request events:
1757 within one, we would start to handle another. */
1758 if (! XINT (read_kbd
))
1759 FD_CLR (keyboard_descriptor
, &Available
);
1761 /* If frame size has changed or the window is newly mapped,
1762 redisplay now, before we start to wait. There is a race
1763 condition here; if a SIGIO arrives between now and the select
1764 and indicates that a frame is trashed, the select may block
1765 displaying a trashed screen. */
1767 redisplay_preserve_echo_area ();
1769 if (XINT (read_kbd
) && detect_input_pending ())
1772 nfds
= select (MAXDESC
, &Available
, 0, 0, &timeout
);
1776 /* Make C-g and alarm signals set flags again */
1777 clear_waiting_for_input ();
1779 /* If we woke up due to SIGWINCH, actually change size now. */
1780 do_pending_window_change ();
1782 if (time_limit
&& nfds
== 0) /* timeout elapsed */
1786 if (xerrno
== EINTR
)
1787 FD_ZERO (&Available
);
1789 /* Ultrix select seems to return ENOMEM when it is
1790 interrupted. Treat it just like EINTR. Bleah. Note
1791 that we want to test for the "ultrix" CPP symbol, not
1792 "__ultrix__"; the latter is only defined under GCC, but
1793 not by DEC's bundled CC. -JimB */
1794 else if (xerrno
== ENOMEM
)
1795 FD_ZERO (&Available
);
1798 /* This happens for no known reason on ALLIANT.
1799 I am guessing that this is the right response. -- RMS. */
1800 else if (xerrno
== EFAULT
)
1801 FD_ZERO (&Available
);
1803 else if (xerrno
== EBADF
)
1806 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
1807 the child's closure of the pts gives the parent a SIGHUP, and
1808 the ptc file descriptor is automatically closed,
1809 yielding EBADF here or at select() call above.
1810 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
1811 in m-ibmrt-aix.h), and here we just ignore the select error.
1812 Cleanup occurs c/o status_notify after SIGCLD. */
1813 FD_ZERO (&Available
); /* Cannot depend on values returned */
1819 error("select error: %s", sys_errlist
[xerrno
]);
1821 #if defined(sun) && !defined(USG5_4)
1822 else if (nfds
> 0 && FD_ISSET (keyboard_descriptor
, &Available
)
1824 /* System sometimes fails to deliver SIGIO.
1826 David J. Mackenzie says that Emacs doesn't compile under
1827 Solaris if this code is enabled, thus the USG5_4 in the CPP
1828 conditional. "I haven't noticed any ill effects so far.
1829 If you find a Solaris expert somewhere, they might know
1831 kill (getpid (), SIGIO
);
1834 /* Check for keyboard input */
1835 /* If there is any, return immediately
1836 to give it higher priority than subprocesses */
1838 /* We used to do his if wait_for_cell,
1839 but that caused infinite recursion in selection request events. */
1840 if ((XINT (read_kbd
))
1841 && detect_input_pending ())
1844 if (detect_input_pending ())
1848 /* Exit now if the cell we're waiting for became non-nil. */
1849 if (wait_for_cell
&& ! NILP (*wait_for_cell
))
1853 /* If we think we have keyboard input waiting, but didn't get SIGIO
1854 go read it. This can happen with X on BSD after logging out.
1855 In that case, there really is no input and no SIGIO,
1856 but select says there is input. */
1858 if (XINT (read_kbd
) && interrupt_input
1859 && (FD_ISSET (keyboard_descriptor
, &Available
)))
1864 got_some_input
|= nfds
> 0;
1866 /* If checking input just got us a size-change event from X,
1867 obey it now if we should. */
1868 if (XINT (read_kbd
) || wait_for_cell
)
1869 do_pending_window_change ();
1871 /* Check for data from a process or a command channel */
1872 for (channel
= FIRST_PROC_DESC
; channel
< MAXDESC
; channel
++)
1874 if (FD_ISSET (channel
, &Available
))
1878 /* If waiting for this channel, arrange to return as
1879 soon as no more input to be processed. No more
1881 if (wait_channel
== channel
)
1887 proc
= chan_process
[channel
];
1891 /* Read data from the process, starting with our
1892 buffered-ahead character if we have one. */
1894 nread
= read_process_output (proc
, channel
);
1897 /* Since read_process_output can run a filter,
1898 which can call accept-process-output,
1899 don't try to read from any other processes
1900 before doing the select again. */
1901 FD_ZERO (&Available
);
1904 redisplay_preserve_echo_area ();
1907 else if (nread
== -1 && errno
== EWOULDBLOCK
)
1911 else if (nread
== -1 && errno
== EAGAIN
)
1915 else if (nread
== -1 && errno
== EAGAIN
)
1917 /* Note that we cannot distinguish between no input
1918 available now and a closed pipe.
1919 With luck, a closed pipe will be accompanied by
1920 subprocess termination and SIGCHLD. */
1921 else if (nread
== 0 && !NETCONN_P (proc
))
1923 #endif /* O_NDELAY */
1924 #endif /* O_NONBLOCK */
1925 #endif /* EWOULDBLOCK */
1927 /* On some OSs with ptys, when the process on one end of
1928 a pty exits, the other end gets an error reading with
1929 errno = EIO instead of getting an EOF (0 bytes read).
1930 Therefore, if we get an error reading and errno =
1931 EIO, just continue, because the child process has
1932 exited and should clean itself up soon (e.g. when we
1934 else if (nread
== -1 && errno
== EIO
)
1936 #endif /* HAVE_PTYS */
1937 /* If we can detect process termination, don't consider the process
1938 gone just because its pipe is closed. */
1940 else if (nread
== 0 && !NETCONN_P (proc
))
1945 /* Preserve status of processes already terminated. */
1946 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
1947 deactivate_process (proc
);
1948 if (!NILP (XPROCESS (proc
)->raw_status_low
))
1949 update_status (XPROCESS (proc
));
1950 if (EQ (XPROCESS (proc
)->status
, Qrun
))
1951 XPROCESS (proc
)->status
1952 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
1955 } /* end for each file descriptor */
1956 } /* end while exit conditions not met */
1958 /* If calling from keyboard input, do not quit
1959 since we want to return C-g as an input character.
1960 Otherwise, do pending quit if requested. */
1961 if (XINT (read_kbd
) >= 0)
1963 /* Prevent input_pending from remaining set if we quit. */
1964 clear_input_pending ();
1968 return got_some_input
;
1971 /* Read pending output from the process channel,
1972 starting with our buffered-ahead character if we have one.
1973 Yield number of characters read.
1975 This function reads at most 1024 characters.
1976 If you want to read all available subprocess output,
1977 you must call it repeatedly until it returns zero. */
1979 read_process_output (proc
, channel
)
1981 register int channel
;
1983 register int nchars
;
1989 register Lisp_Object outstream
;
1990 register struct buffer
*old
= current_buffer
;
1991 register struct Lisp_Process
*p
= XPROCESS (proc
);
1992 register int opoint
;
1995 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
1997 vs
= get_vms_process_pointer (p
->pid
);
2001 return(0); /* Really weird if it does this */
2002 if (!(vs
->iosb
[0] & 1))
2003 return -1; /* I/O error */
2006 error ("Could not get VMS process pointer");
2007 chars
= vs
->inputBuffer
;
2008 nchars
= clean_vms_buffer (chars
, vs
->iosb
[1]);
2011 start_vms_process_read (vs
); /* Crank up the next read on the process */
2012 return 1; /* Nothing worth printing, say we got 1 */
2016 if (proc_buffered_char
[channel
] < 0)
2017 nchars
= read (channel
, chars
, sizeof chars
);
2020 chars
[0] = proc_buffered_char
[channel
];
2021 proc_buffered_char
[channel
] = -1;
2022 nchars
= read (channel
, chars
+ 1, sizeof chars
- 1);
2026 nchars
= nchars
+ 1;
2028 #endif /* not VMS */
2030 if (nchars
<= 0) return nchars
;
2032 outstream
= p
->filter
;
2033 if (!NILP (outstream
))
2035 /* We inhibit quit here instead of just catching it so that
2036 hitting ^G when a filter happens to be running won't screw
2038 int count
= specpdl_ptr
- specpdl
;
2039 Lisp_Object odeactivate
;
2041 odeactivate
= Vdeactivate_mark
;
2043 specbind (Qinhibit_quit
, Qt
);
2044 call2 (outstream
, proc
, make_string (chars
, nchars
));
2046 /* Handling the process output should not deactivate the mark. */
2047 Vdeactivate_mark
= odeactivate
;
2050 start_vms_process_read (vs
);
2056 /* If no filter, write into buffer if it isn't dead. */
2057 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
2059 Lisp_Object old_read_only
;
2060 Lisp_Object old_begv
, old_zv
;
2061 Lisp_Object odeactivate
;
2063 odeactivate
= Vdeactivate_mark
;
2065 Fset_buffer (p
->buffer
);
2067 old_read_only
= current_buffer
->read_only
;
2068 XFASTINT (old_begv
) = BEGV
;
2069 XFASTINT (old_zv
) = ZV
;
2071 current_buffer
->read_only
= Qnil
;
2073 /* Insert new output into buffer
2074 at the current end-of-output marker,
2075 thus preserving logical ordering of input and output. */
2076 if (XMARKER (p
->mark
)->buffer
)
2077 SET_PT (marker_position (p
->mark
));
2081 /* If the output marker is outside of the visible region, save
2082 the restriction and widen. */
2083 if (! (BEGV
<= point
&& point
<= ZV
))
2086 /* Make sure opoint floats ahead of any new text, just as point
2088 if (point
<= opoint
)
2091 /* Insert after old_begv, but before old_zv. */
2092 if (point
< XFASTINT (old_begv
))
2093 XFASTINT (old_begv
) += nchars
;
2094 if (point
<= XFASTINT (old_zv
))
2095 XFASTINT (old_zv
) += nchars
;
2097 /* Insert before markers in case we are inserting where
2098 the buffer's mark is, and the user's next command is Meta-y. */
2099 insert_before_markers (chars
, nchars
);
2100 Fset_marker (p
->mark
, make_number (point
), p
->buffer
);
2102 update_mode_lines
++;
2104 /* If the restriction isn't what it should be, set it. */
2105 if (XFASTINT (old_begv
) != BEGV
|| XFASTINT (old_zv
) != ZV
)
2106 Fnarrow_to_region (old_begv
, old_zv
);
2108 /* Handling the process output should not deactivate the mark. */
2109 Vdeactivate_mark
= odeactivate
;
2111 current_buffer
->read_only
= old_read_only
;
2113 set_buffer_internal (old
);
2116 start_vms_process_read (vs
);
2121 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
2123 "Returns non-NIL if emacs is waiting for input from the user.\n\
2124 This is intended for use by asynchronous process output filters and sentinels.")
2127 return ((waiting_for_user_input_p
) ? Qt
: Qnil
);
2130 /* Sending data to subprocess */
2132 jmp_buf send_process_frame
;
2135 send_process_trap ()
2141 longjmp (send_process_frame
, 1);
2144 send_process (proc
, buf
, len
)
2149 /* Don't use register vars; longjmp can lose them. */
2151 unsigned char *procname
= XSTRING (XPROCESS (proc
)->name
)->data
;
2155 struct Lisp_Process
*p
= XPROCESS (proc
);
2156 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
2159 if (! NILP (XPROCESS (proc
)->raw_status_low
))
2160 update_status (XPROCESS (proc
));
2161 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
2162 error ("Process %s not running", procname
);
2165 vs
= get_vms_process_pointer (p
->pid
);
2167 error ("Could not find this process: %x", p
->pid
);
2168 else if (write_to_vms_process (vs
, buf
, len
))
2171 if (!setjmp (send_process_frame
))
2175 SIGTYPE (*old_sigpipe
)();
2177 /* Don't send more than 500 bytes at a time. */
2180 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
2181 rv
= write (XFASTINT (XPROCESS (proc
)->outfd
), buf
, this);
2182 signal (SIGPIPE
, old_sigpipe
);
2187 || errno
== EWOULDBLOCK
2194 /* It would be nice to accept process output here,
2195 but that is difficult. For example, it could
2196 garbage what we are sending if that is from a buffer. */
2203 report_file_error ("writing to process", Fcons (proc
, Qnil
));
2207 /* Allow input from processes between bursts of sending.
2208 Otherwise things may get stopped up. */
2213 XFASTINT (zero
) = 0;
2214 wait_reading_process_input (-1, 0, zero
, 0);
2220 XPROCESS (proc
)->raw_status_low
= Qnil
;
2221 XPROCESS (proc
)->raw_status_high
= Qnil
;
2222 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
2223 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
2224 deactivate_process (proc
);
2226 error ("Error writing to process %s; closed it", procname
);
2228 error ("SIGPIPE raised on process %s; closed it", procname
);
2233 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
2235 "Send current contents of region as input to PROCESS.\n\
2236 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2237 nil, indicating the current buffer's process.\n\
2238 Called from program, takes three arguments, PROCESS, START and END.\n\
2239 If the region is more than 500 characters long,\n\
2240 it is sent in several bunches. This may happen even for shorter regions.\n\
2241 Output from processes can arrive in between bunches.")
2242 (process
, start
, end
)
2243 Lisp_Object process
, start
, end
;
2248 proc
= get_process (process
);
2249 validate_region (&start
, &end
);
2251 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
2254 start1
= XINT (start
);
2255 send_process (proc
, &FETCH_CHAR (start1
), XINT (end
) - XINT (start
));
2260 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
2262 "Send PROCESS the contents of STRING as input.\n\
2263 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2264 nil, indicating the current buffer's process.\n\
2265 If STRING is more than 500 characters long,\n\
2266 it is sent in several bunches. This may happen even for shorter strings.\n\
2267 Output from processes can arrive in between bunches.")
2269 Lisp_Object process
, string
;
2272 CHECK_STRING (string
, 1);
2273 proc
= get_process (process
);
2274 send_process (proc
, XSTRING (string
)->data
, XSTRING (string
)->size
);
2278 /* send a signal number SIGNO to PROCESS.
2279 CURRENT_GROUP means send to the process group that currently owns
2280 the terminal being used to communicate with PROCESS.
2281 This is used for various commands in shell mode.
2282 If NOMSG is zero, insert signal-announcements into process's buffers
2285 If we can, we try to signal PROCESS by sending control characters
2286 down the pipe. This allows us to signal inferiors who have changed
2287 their uid, for which killpg would return an EPERM error. */
2290 process_send_signal (process
, signo
, current_group
, nomsg
)
2291 Lisp_Object process
;
2293 Lisp_Object current_group
;
2297 register struct Lisp_Process
*p
;
2301 proc
= get_process (process
);
2302 p
= XPROCESS (proc
);
2304 if (!EQ (p
->childp
, Qt
))
2305 error ("Process %s is not a subprocess",
2306 XSTRING (p
->name
)->data
);
2307 if (!XFASTINT (p
->infd
))
2308 error ("Process %s is not active",
2309 XSTRING (p
->name
)->data
);
2311 if (NILP (p
->pty_flag
))
2312 current_group
= Qnil
;
2314 /* If we are using pgrps, get a pgrp number and make it negative. */
2315 if (!NILP (current_group
))
2317 #ifdef SIGNALS_VIA_CHARACTERS
2318 /* If possible, send signals to the entire pgrp
2319 by sending an input character to it. */
2321 /* TERMIOS is the latest and bestest, and seems most likely to
2322 work. If the system has it, use it. */
2329 tcgetattr (XFASTINT (p
->infd
), &t
);
2330 send_process (proc
, &t
.c_cc
[VINTR
], 1);
2334 tcgetattr (XFASTINT (p
->infd
), &t
);
2335 send_process (proc
, &t
.c_cc
[VQUIT
], 1);
2339 tcgetattr (XFASTINT (p
->infd
), &t
);
2341 send_process (proc
, &t
.c_cc
[VSWTCH
], 1);
2343 send_process (proc
, &t
.c_cc
[VSUSP
], 1);
2348 #else /* ! HAVE_TERMIOS */
2350 /* On Berkeley descendants, the following IOCTL's retrieve the
2351 current control characters. */
2352 #if defined (TIOCGLTC) && defined (TIOCGETC)
2360 ioctl (XFASTINT (p
->infd
), TIOCGETC
, &c
);
2361 send_process (proc
, &c
.t_intrc
, 1);
2364 ioctl (XFASTINT (p
->infd
), TIOCGETC
, &c
);
2365 send_process (proc
, &c
.t_quitc
, 1);
2369 ioctl (XFASTINT (p
->infd
), TIOCGLTC
, &lc
);
2370 send_process (proc
, &lc
.t_suspc
, 1);
2372 #endif /* ! defined (SIGTSTP) */
2375 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
2377 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
2384 ioctl (XFASTINT (p
->infd
), TCGETA
, &t
);
2385 send_process (proc
, &t
.c_cc
[VINTR
], 1);
2388 ioctl (XFASTINT (p
->infd
), TCGETA
, &t
);
2389 send_process (proc
, &t
.c_cc
[VQUIT
], 1);
2393 ioctl (XFASTINT (p
->infd
), TCGETA
, &t
);
2394 send_process (proc
, &t
.c_cc
[VSWTCH
], 1);
2396 #endif /* ! defined (SIGTSTP) */
2398 #else /* ! defined (TCGETA) */
2399 Your configuration files are messed up
.
2400 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
2401 you'd better be using one of the alternatives above! */
2402 #endif /* ! defined (TCGETA) */
2403 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
2404 #endif /* ! defined HAVE_TERMIOS */
2405 #endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
2408 /* Get the pgrp using the tty itself, if we have that.
2409 Otherwise, use the pty to get the pgrp.
2410 On pfa systems, saka@pfu.fujitsu.co.JP writes:
2411 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
2412 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
2413 His patch indicates that if TIOCGPGRP returns an error, then
2414 we should just assume that p->pid is also the process group id. */
2418 if (!NILP (p
->subtty
))
2419 err
= ioctl (XFASTINT (p
->subtty
), TIOCGPGRP
, &gid
);
2421 err
= ioctl (XFASTINT (p
->infd
), TIOCGPGRP
, &gid
);
2425 gid
= - XFASTINT (p
->pid
);
2426 #endif /* ! defined (pfa) */
2432 #else /* ! defined (TIOCGPGRP ) */
2433 /* Can't select pgrps on this system, so we know that
2434 the child itself heads the pgrp. */
2435 gid
= - XFASTINT (p
->pid
);
2436 #endif /* ! defined (TIOCGPGRP ) */
2439 gid
= - XFASTINT (p
->pid
);
2445 p
->raw_status_low
= Qnil
;
2446 p
->raw_status_high
= Qnil
;
2448 XSETINT (p
->tick
, ++process_tick
);
2452 #endif /* ! defined (SIGCONT) */
2455 send_process (proc
, "\003", 1); /* ^C */
2460 send_process (proc
, "\031", 1); /* ^Y */
2465 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
2468 flush_pending_output (XFASTINT (p
->infd
));
2472 /* If we don't have process groups, send the signal to the immediate
2473 subprocess. That isn't really right, but it's better than any
2474 obvious alternative. */
2477 kill (XFASTINT (p
->pid
), signo
);
2481 /* gid may be a pid, or minus a pgrp's number */
2483 if (!NILP (current_group
))
2484 ioctl (XFASTINT (p
->infd
), TIOCSIGSEND
, signo
);
2487 gid
= - XFASTINT (p
->pid
);
2490 #else /* ! defined (TIOCSIGSEND) */
2491 EMACS_KILLPG (-gid
, signo
);
2492 #endif /* ! defined (TIOCSIGSEND) */
2495 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
2496 "Interrupt process PROCESS. May be process or name of one.\n\
2497 PROCESS may be a process, a buffer, or the name of a process or buffer.\n\
2498 Nil or no arg means current buffer's process.\n\
2499 Second arg CURRENT-GROUP non-nil means send signal to\n\
2500 the current process-group of the process's controlling terminal\n\
2501 rather than to the process's own process group.\n\
2502 If the process is a shell, this means interrupt current subjob\n\
2503 rather than the shell.")
2504 (process
, current_group
)
2505 Lisp_Object process
, current_group
;
2507 process_send_signal (process
, SIGINT
, current_group
, 0);
2511 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
2512 "Kill process PROCESS. May be process or name of one.\n\
2513 See function `interrupt-process' for more details on usage.")
2514 (process
, current_group
)
2515 Lisp_Object process
, current_group
;
2517 process_send_signal (process
, SIGKILL
, current_group
, 0);
2521 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
2522 "Send QUIT signal to process PROCESS. May be process or name of one.\n\
2523 See function `interrupt-process' for more details on usage.")
2524 (process
, current_group
)
2525 Lisp_Object process
, current_group
;
2527 process_send_signal (process
, SIGQUIT
, current_group
, 0);
2531 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
2532 "Stop process PROCESS. May be process or name of one.\n\
2533 See function `interrupt-process' for more details on usage.")
2534 (process
, current_group
)
2535 Lisp_Object process
, current_group
;
2538 error ("no SIGTSTP support");
2540 process_send_signal (process
, SIGTSTP
, current_group
, 0);
2545 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
2546 "Continue process PROCESS. May be process or name of one.\n\
2547 See function `interrupt-process' for more details on usage.")
2548 (process
, current_group
)
2549 Lisp_Object process
, current_group
;
2552 process_send_signal (process
, SIGCONT
, current_group
, 0);
2554 error ("no SIGCONT support");
2559 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
2560 2, 2, "nProcess number: \nnSignal code: ",
2561 "Send the process with number PID the signal with code CODE.\n\
2562 Both PID and CODE are integers.")
2564 Lisp_Object pid
, sig
;
2566 CHECK_NUMBER (pid
, 0);
2567 CHECK_NUMBER (sig
, 1);
2568 return make_number (kill (XINT (pid
), XINT (sig
)));
2571 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
2572 "Make PROCESS see end-of-file in its input.\n\
2573 Eof comes after any text already sent to it.\n\
2574 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2575 nil, indicating the current buffer's process.")
2577 Lisp_Object process
;
2581 proc
= get_process (process
);
2583 /* Make sure the process is really alive. */
2584 if (! NILP (XPROCESS (proc
)->raw_status_low
))
2585 update_status (XPROCESS (proc
));
2586 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
2587 error ("Process %s not running", XSTRING (XPROCESS (proc
)->name
)->data
);
2589 /* Sending a zero-length record is supposed to mean eof
2590 when TIOCREMOTE is turned on. */
2594 write (XFASTINT (XPROCESS (proc
)->outfd
), buf
, 0);
2596 #else /* did not do TOICREMOTE */
2598 send_process (proc
, "\032", 1); /* ^z */
2600 if (!NILP (XPROCESS (proc
)->pty_flag
))
2601 send_process (proc
, "\004", 1);
2604 close (XPROCESS (proc
)->outfd
);
2605 XFASTINT (XPROCESS (proc
)->outfd
) = open (NULL_DEVICE
, O_WRONLY
);
2608 #endif /* did not do TOICREMOTE */
2612 /* Kill all processes associated with `buffer'.
2613 If `buffer' is nil, kill all processes */
2615 kill_buffer_processes (buffer
)
2618 Lisp_Object tail
, proc
;
2620 for (tail
= Vprocess_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2621 tail
= XCONS (tail
)->cdr
)
2623 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
2624 if (XGCTYPE (proc
) == Lisp_Process
2625 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
2627 if (NETCONN_P (proc
))
2628 deactivate_process (proc
);
2629 else if (XFASTINT (XPROCESS (proc
)->infd
))
2630 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
2635 /* On receipt of a signal that a child status has changed,
2636 loop asking about children with changed statuses until
2637 the system says there are no more.
2638 All we do is change the status;
2639 we do not run sentinels or print notifications.
2640 That is saved for the next time keyboard input is done,
2641 in order to avoid timing errors. */
2643 /** WARNING: this can be called during garbage collection.
2644 Therefore, it must not be fooled by the presence of mark bits in
2647 /** USG WARNING: Although it is not obvious from the documentation
2648 in signal(2), on a USG system the SIGCLD handler MUST NOT call
2649 signal() before executing at least one wait(), otherwise the handler
2650 will be called again, resulting in an infinite loop. The relevant
2651 portion of the documentation reads "SIGCLD signals will be queued
2652 and the signal-catching function will be continually reentered until
2653 the queue is empty". Invoking signal() causes the kernel to reexamine
2654 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
2657 sigchld_handler (signo
)
2660 int old_errno
= errno
;
2662 register struct Lisp_Process
*p
;
2663 extern EMACS_TIME
*input_available_clear_time
;
2667 sigheld
|= sigbit (SIGCHLD
);
2679 #endif /* no WUNTRACED */
2680 /* Keep trying to get a status until we get a definitive result. */
2684 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
2686 while (pid
<= 0 && errno
== EINTR
);
2690 /* A real failure. We have done all our job, so return. */
2692 /* USG systems forget handlers when they are used;
2693 must reestablish each time */
2695 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
2698 sigheld
&= ~sigbit (SIGCHLD
);
2706 #endif /* no WNOHANG */
2708 /* Find the process that signaled us, and record its status. */
2711 for (tail
= Vprocess_alist
; XSYMBOL (tail
) != XSYMBOL (Qnil
); tail
= XCONS (tail
)->cdr
)
2713 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
2714 p
= XPROCESS (proc
);
2715 if (EQ (p
->childp
, Qt
) && XFASTINT (p
->pid
) == pid
)
2720 /* Look for an asynchronous process whose pid hasn't been filled
2723 for (tail
= Vprocess_alist
; XSYMBOL (tail
) != XSYMBOL (Qnil
); tail
= XCONS (tail
)->cdr
)
2725 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
2726 p
= XPROCESS (proc
);
2727 if (XTYPE (p
->pid
) == Lisp_Int
&& XINT (p
->pid
) == -1)
2732 /* Change the status of the process that was found. */
2735 union { int i
; WAITTYPE wt
; } u
;
2737 XSETINT (p
->tick
, ++process_tick
);
2739 XFASTINT (p
->raw_status_low
) = u
.i
& 0xffff;
2740 XFASTINT (p
->raw_status_high
) = u
.i
>> 16;
2742 /* If process has terminated, stop waiting for its output. */
2743 if (WIFSIGNALED (w
) || WIFEXITED (w
))
2744 if (XFASTINT (p
->infd
))
2745 FD_CLR (XFASTINT (p
->infd
), &input_wait_mask
);
2747 /* Tell wait_reading_process_input that it needs to wake up and
2749 if (input_available_clear_time
)
2750 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
2753 /* There was no asynchronous process found for that id. Check
2754 if we have a synchronous process. */
2757 synch_process_alive
= 0;
2759 /* Report the status of the synchronous process. */
2761 synch_process_retcode
= WRETCODE (w
);
2762 else if (WIFSIGNALED (w
))
2764 synch_process_death
= (char *) sys_siglist
[WTERMSIG (w
)];
2766 synch_process_death
= sys_errlist
[WTERMSIG (w
)];
2769 /* Tell wait_reading_process_input that it needs to wake up and
2771 if (input_available_clear_time
)
2772 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
2775 /* On some systems, we must return right away.
2776 If any more processes want to signal us, we will
2778 Otherwise (on systems that have WNOHANG), loop around
2779 to use up all the processes that have something to tell us. */
2780 #if defined (USG) && ! (defined (HPUX) && defined (WNOHANG))
2782 signal (signo
, sigchld_handler
);
2786 #endif /* USG, but not HPUX with WNOHANG */
2792 exec_sentinel_unwind (data
)
2795 XPROCESS (XCONS (data
)->car
)->sentinel
= XCONS (data
)->cdr
;
2800 exec_sentinel (proc
, reason
)
2801 Lisp_Object proc
, reason
;
2803 Lisp_Object sentinel
;
2804 register struct Lisp_Process
*p
= XPROCESS (proc
);
2805 int count
= specpdl_ptr
- specpdl
;
2807 sentinel
= p
->sentinel
;
2808 if (NILP (sentinel
))
2811 /* Zilch the sentinel while it's running, to avoid recursive invocations;
2812 assure that it gets restored no matter how the sentinel exits. */
2814 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
2815 /* Inhibit quit so that random quits don't screw up a running filter. */
2816 specbind (Qinhibit_quit
, Qt
);
2817 call2 (sentinel
, proc
, reason
);
2821 /* Report all recent events of a change in process status
2822 (either run the sentinel or output a message).
2823 This is done while Emacs is waiting for keyboard input. */
2827 register Lisp_Object proc
, buffer
;
2828 Lisp_Object tail
= Qnil
;
2829 Lisp_Object msg
= Qnil
;
2830 struct gcpro gcpro1
, gcpro2
;
2832 /* We need to gcpro tail; if read_process_output calls a filter
2833 which deletes a process and removes the cons to which tail points
2834 from Vprocess_alist, and then causes a GC, tail is an unprotected
2838 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
2841 register struct Lisp_Process
*p
;
2843 proc
= Fcdr (Fcar (tail
));
2844 p
= XPROCESS (proc
);
2846 if (XINT (p
->tick
) != XINT (p
->update_tick
))
2848 XSETINT (p
->update_tick
, XINT (p
->tick
));
2850 /* If process is still active, read any output that remains. */
2851 if (XFASTINT (p
->infd
))
2852 while (read_process_output (proc
, XFASTINT (p
->infd
)) > 0);
2856 /* Get the text to use for the message. */
2857 if (!NILP (p
->raw_status_low
))
2859 msg
= status_message (p
->status
);
2861 /* If process is terminated, deactivate it or delete it. */
2863 if (XTYPE (p
->status
) == Lisp_Cons
)
2864 symbol
= XCONS (p
->status
)->car
;
2866 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
2867 || EQ (symbol
, Qclosed
))
2869 if (delete_exited_processes
)
2870 remove_process (proc
);
2872 deactivate_process (proc
);
2875 /* Now output the message suitably. */
2876 if (!NILP (p
->sentinel
))
2877 exec_sentinel (proc
, msg
);
2878 /* Don't bother with a message in the buffer
2879 when a process becomes runnable. */
2880 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
2882 Lisp_Object ro
= XBUFFER (buffer
)->read_only
;
2884 struct buffer
*old
= current_buffer
;
2887 /* Avoid error if buffer is deleted
2888 (probably that's why the process is dead, too) */
2889 if (NILP (XBUFFER (buffer
)->name
))
2891 Fset_buffer (buffer
);
2893 /* Insert new output into buffer
2894 at the current end-of-output marker,
2895 thus preserving logical ordering of input and output. */
2896 if (XMARKER (p
->mark
)->buffer
)
2897 SET_PT (marker_position (p
->mark
));
2900 if (point
<= opoint
)
2901 opoint
+= XSTRING (msg
)->size
+ XSTRING (p
->name
)->size
+ 10;
2903 tem
= current_buffer
->read_only
;
2904 current_buffer
->read_only
= Qnil
;
2905 insert_string ("\nProcess ");
2906 Finsert (1, &p
->name
);
2907 insert_string (" ");
2909 current_buffer
->read_only
= tem
;
2910 Fset_marker (p
->mark
, make_number (point
), p
->buffer
);
2913 set_buffer_internal (old
);
2918 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
2919 redisplay_preserve_echo_area ();
2921 update_tick
= process_tick
;
2932 if (! noninteractive
|| initialized
)
2934 signal (SIGCHLD
, sigchld_handler
);
2937 FD_ZERO (&input_wait_mask
);
2939 keyboard_descriptor
= 0;
2940 FD_SET (keyboard_descriptor
, &input_wait_mask
);
2942 Vprocess_alist
= Qnil
;
2943 for (i
= 0; i
< MAXDESC
; i
++)
2945 chan_process
[i
] = Qnil
;
2946 proc_buffered_char
[i
] = -1;
2950 /* From now on, assume keyboard input comes from descriptor DESC. */
2953 change_keyboard_wait_descriptor (desc
)
2956 FD_CLR (keyboard_descriptor
, &input_wait_mask
);
2957 keyboard_descriptor
= desc
;
2958 FD_SET (keyboard_descriptor
, &input_wait_mask
);
2964 stream_process
= intern ("stream");
2966 Qprocessp
= intern ("processp");
2967 staticpro (&Qprocessp
);
2968 Qrun
= intern ("run");
2970 Qstop
= intern ("stop");
2972 Qsignal
= intern ("signal");
2973 staticpro (&Qsignal
);
2975 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
2978 Qexit = intern ("exit");
2979 staticpro (&Qexit); */
2981 Qopen
= intern ("open");
2983 Qclosed
= intern ("closed");
2984 staticpro (&Qclosed
);
2986 staticpro (&Vprocess_alist
);
2988 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
2989 "*Non-nil means delete processes immediately when they exit.\n\
2990 nil means don't delete them until `list-processes' is run.");
2992 delete_exited_processes
= 1;
2994 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
2995 "Control type of device used to communicate with subprocesses.\n\
2996 Values are nil to use a pipe, and t or 'pty for a pty. Note that if\n\
2997 pty's are not available, this variable will be ignored. The value takes\n\
2998 effect when `start-process' is called.");
2999 Vprocess_connection_type
= Qt
;
3001 defsubr (&Sprocessp
);
3002 defsubr (&Sget_process
);
3003 defsubr (&Sget_buffer_process
);
3004 defsubr (&Sdelete_process
);
3005 defsubr (&Sprocess_status
);
3006 defsubr (&Sprocess_exit_status
);
3007 defsubr (&Sprocess_id
);
3008 defsubr (&Sprocess_name
);
3009 defsubr (&Sprocess_command
);
3010 defsubr (&Sset_process_buffer
);
3011 defsubr (&Sprocess_buffer
);
3012 defsubr (&Sprocess_mark
);
3013 defsubr (&Sset_process_filter
);
3014 defsubr (&Sprocess_filter
);
3015 defsubr (&Sset_process_sentinel
);
3016 defsubr (&Sprocess_sentinel
);
3017 defsubr (&Sprocess_kill_without_query
);
3018 defsubr (&Slist_processes
);
3019 defsubr (&Sprocess_list
);
3020 defsubr (&Sstart_process
);
3022 defsubr (&Sopen_network_stream
);
3023 #endif /* HAVE_SOCKETS */
3024 defsubr (&Saccept_process_output
);
3025 defsubr (&Sprocess_send_region
);
3026 defsubr (&Sprocess_send_string
);
3027 defsubr (&Sinterrupt_process
);
3028 defsubr (&Skill_process
);
3029 defsubr (&Squit_process
);
3030 defsubr (&Sstop_process
);
3031 defsubr (&Scontinue_process
);
3032 defsubr (&Sprocess_send_eof
);
3033 defsubr (&Ssignal_process
);
3034 defsubr (&Swaiting_for_user_input_p
);
3035 /* defsubr (&Sprocess_connection); */
3039 #else /* not subprocesses */
3041 #include <sys/types.h>
3045 #include "systime.h"
3046 #include "termopts.h"
3048 extern int frame_garbaged
;
3051 /* As described above, except assuming that there are no subprocesses:
3053 Wait for timeout to elapse and/or keyboard input to be available.
3056 timeout in seconds, or
3057 zero for no limit, or
3058 -1 means gobble data immediately available but don't wait for any.
3060 read_kbd is a Lisp_Object:
3061 0 to ignore keyboard input, or
3062 1 to return when input is available, or
3063 -1 means caller will actually read the input, so don't throw to
3065 We know that read_kbd will never be a Lisp_Process, since
3066 `subprocesses' isn't defined.
3068 do_display != 0 means redisplay should be done to show subprocess
3069 output that arrives. This version of the function ignores it.
3071 Return true iff we received input from any process. */
3074 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
3075 int time_limit
, microsecs
;
3076 Lisp_Object read_kbd
;
3079 EMACS_TIME end_time
, timeout
, *timeout_p
;
3082 /* What does time_limit really mean? */
3083 if (time_limit
|| microsecs
)
3085 /* It's not infinite. */
3086 timeout_p
= &timeout
;
3088 if (time_limit
== -1)
3089 /* In fact, it's zero. */
3090 EMACS_SET_SECS_USECS (timeout
, 0, 0);
3092 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
3094 /* How far in the future is that? */
3095 EMACS_GET_TIME (end_time
);
3096 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
3099 /* It's infinite. */
3102 /* Turn off periodic alarms (in case they are in use)
3103 because the select emulator uses alarms. */
3110 waitchannels
= XINT (read_kbd
) ? 1 : 0;
3112 /* If calling from keyboard input, do not quit
3113 since we want to return C-g as an input character.
3114 Otherwise, do pending quit if requested. */
3115 if (XINT (read_kbd
) >= 0)
3120 EMACS_GET_TIME (*timeout_p
);
3121 EMACS_SUB_TIME (*timeout_p
, end_time
, *timeout_p
);
3122 if (EMACS_TIME_NEG_P (*timeout_p
))
3126 /* Cause C-g and alarm signals to take immediate action,
3127 and cause input available signals to zero out timeout. */
3128 if (XINT (read_kbd
) < 0)
3129 set_waiting_for_input (&timeout
);
3131 /* If a frame has been newly mapped and needs updating,
3132 reprocess its display stuff. */
3134 redisplay_preserve_echo_area ();
3136 if (XINT (read_kbd
) && detect_input_pending ())
3139 nfds
= select (1, &waitchannels
, 0, 0, timeout_p
);
3141 /* Make C-g and alarm signals set flags again */
3142 clear_waiting_for_input ();
3144 /* If we woke up due to SIGWINCH, actually change size now. */
3145 do_pending_window_change ();
3149 /* If the system call was interrupted, then go around the
3155 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
3156 /* System sometimes fails to deliver SIGIO. */
3157 kill (getpid (), SIGIO
);
3160 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
3164 /* If we have timed out (nfds == 0) or found some input (nfds > 0),
3176 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
3177 /* Don't confused make-docfile by having two doc strings for this function.
3178 make-docfile does not pay attention to #if, for good reason! */
3181 register Lisp_Object name
;
3186 /* Kill all processes associated with `buffer'.
3187 If `buffer' is nil, kill all processes.
3188 Since we have no subprocesses, this does nothing. */
3190 kill_buffer_processes (buffer
)
3201 defsubr (&Sget_buffer_process
);
3205 #endif /* not subprocesses */