1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
25 /* This file is split into two parts by the following preprocessor
26 conditional. The 'then' clause contains all of the support for
27 asynchronous subprocesses. The 'else' clause contains stub
28 versions of some of the asynchronous subprocess routines that are
29 often called elsewhere in Emacs, so we don't have to #ifdef the
30 sections that call them. */
38 #include <sys/types.h> /* some typedefs are used in sys/file.h */
42 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
43 #include <sys/socket.h>
45 #include <netinet/in.h>
46 #include <arpa/inet.h>
47 #endif /* HAVE_SOCKETS */
49 #if defined(BSD) || defined(STRIDE)
50 #include <sys/ioctl.h>
51 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
53 #endif /* HAVE_PTYS and no O_NDELAY */
54 #endif /* BSD or STRIDE */
61 #include <sys/sysmacros.h> /* for "minor" */
71 #include "termhooks.h"
76 Lisp_Object Qrun
, Qstop
, Qsignal
, Qopen
, Qclosed
;
77 /* Qexit is declared and initialized in eval.c. */
79 /* a process object is a network connection when its childp field is neither
80 Qt nor Qnil but is instead a string (name of foreign host we
81 are connected to + name of port we are connected to) */
84 static Lisp_Object stream_process
;
86 #define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String)
88 #define NETCONN_P(p) 0
89 #endif /* HAVE_SOCKETS */
91 /* Define first descriptor number available for subprocesses. */
93 #define FIRST_PROC_DESC 1
95 #define FIRST_PROC_DESC 3
98 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
101 #if !defined (SIGCHLD) && defined (SIGCLD)
102 #define SIGCHLD SIGCLD
105 #include "syssignal.h"
107 /* Define the structure that the wait system call stores.
108 On many systems, there is a structure defined for this.
109 But on vanilla-ish USG systems there is not. */
113 #if (!defined (BSD) && !defined (UNIPLUS) && !defined (STRIDE) && !(defined (HPUX) && !defined (NOMULTIPLEJOBS)) && !defined (HAVE_WAIT_HEADER)) || defined (LINUX)
115 #define WIFSTOPPED(w) ((w&0377) == 0177)
116 #define WIFSIGNALED(w) ((w&0377) != 0177 && (w&~0377) == 0)
117 #define WIFEXITED(w) ((w&0377) == 0)
118 #define WRETCODE(w) (w >> 8)
119 #define WSTOPSIG(w) (w >> 8)
120 #define WTERMSIG(w) (w & 0377)
122 #define WCOREDUMP(w) ((w&0200) != 0)
128 #include <sys/wait.h>
129 #endif /* not BSD 4.1 */
131 #define WAITTYPE union wait
132 #define WRETCODE(w) w.w_retcode
133 #define WCOREDUMP(w) w.w_coredump
136 /* HPUX version 7 has broken definitions of these. */
145 #define WTERMSIG(w) w.w_termsig
148 #define WSTOPSIG(w) w.w_stopsig
151 #define WIFSTOPPED(w) (WTERMSIG (w) == 0177)
154 #define WIFSIGNALED(w) (WTERMSIG (w) != 0177 && (WSTOPSIG (w)) == 0)
157 #define WIFEXITED(w) (WTERMSIG (w) == 0)
159 #endif /* BSD or UNIPLUS or STRIDE */
160 #endif /* no WAITTYPE */
163 #define WIFSTOPPED(w) 0
164 #define WIFSIGNALED(w) 0
165 #define WIFEXITED(w) ((w) != -1)
166 #define WRETCODE(w) (w)
167 #define WSTOPSIG(w) (w)
168 #define WCOREDUMP(w) 0
169 #define WTERMSIG(w) (w)
178 extern char *sys_errlist
[];
183 extern char *sys_siglist
[];
186 char *sys_siglist
[] =
192 "illegal instruction",
196 "floating point exception",
199 "segmentation violation",
200 "bad argument to system call",
201 "write on a pipe with no one to read it",
203 "software termination signal from kill",
205 "sendable stop signal not from tty",
206 "stop signal from tty",
207 "continue a stopped process",
208 "child status has changed",
209 "background read attempted from control tty",
210 "background write attempted from control tty",
211 "input record available at control tty",
212 "exceeded CPU time limit",
213 "exceeded file size limit"
218 /* t means use pty, nil means use a pipe,
219 maybe other values to come. */
220 Lisp_Object Vprocess_connection_type
;
224 #include <sys/socket.h>
228 /* Number of events of change of status of a process. */
231 /* Number of events for which the user or sentinel has been notified. */
235 /* We could get this from param.h, but better not to depend on finding that.
236 And better not to risk that it might define other symbols used in this
239 #define SELECT_TYPE fd_set
240 #else /* no FD_SET */
242 #define SELECT_TYPE int
244 /* Define the macros to access a single-int bitmap of descriptors. */
245 #define FD_SET(n, p) (*(p) |= (1 << (n)))
246 #define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
247 #define FD_ISSET(n, p) (*(p) & (1 << (n)))
248 #define FD_ZERO(p) (*(p) = 0)
249 #endif /* no FD_SET */
251 /* Mask of bits indicating the descriptors that we wait for input on */
253 SELECT_TYPE input_wait_mask
;
255 int delete_exited_processes
;
257 /* Indexed by descriptor, gives the process (if any) for that descriptor */
258 Lisp_Object chan_process
[MAXDESC
];
260 /* Alist of elements (NAME . PROCESS) */
261 Lisp_Object Vprocess_alist
;
263 Lisp_Object Qprocessp
;
265 Lisp_Object
get_process ();
267 /* Buffered-ahead input char from process, indexed by channel.
268 -1 means empty (no char is buffered).
269 Used on sys V where the only way to tell if there is any
270 output from the process is to read at least one char.
271 Always -1 on systems that support FIONREAD. */
273 int proc_buffered_char
[MAXDESC
];
275 /* Compute the Lisp form of the process status, p->status, from
276 the numeric status that was returned by `wait'. */
278 Lisp_Object
status_convert ();
281 struct Lisp_Process
*p
;
283 union { int i
; WAITTYPE wt
; } u
;
284 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
285 p
->status
= status_convert (u
.wt
);
286 p
->raw_status_low
= Qnil
;
287 p
->raw_status_high
= Qnil
;
290 /* Convert a process status work in Unix format to
291 the list that we use internally. */
298 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
299 else if (WIFEXITED (w
))
300 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
301 WCOREDUMP (w
) ? Qt
: Qnil
));
302 else if (WIFSIGNALED (w
))
303 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
304 WCOREDUMP (w
) ? Qt
: Qnil
));
309 /* Given a status-list, extract the three pieces of information
310 and store them individually through the three pointers. */
313 decode_status (l
, symbol
, code
, coredump
)
321 if (XTYPE (l
) == Lisp_Symbol
)
329 *symbol
= XCONS (l
)->car
;
330 tem
= XCONS (l
)->cdr
;
331 *code
= XFASTINT (XCONS (tem
)->car
);
332 tem
= XCONS (tem
)->cdr
;
333 *coredump
= !NILP (tem
);
337 /* Return a string describing a process status list. */
340 status_message (status
)
345 Lisp_Object string
, string2
;
347 decode_status (status
, &symbol
, &code
, &coredump
);
349 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
352 string
= build_string (code
< NSIG
? sys_siglist
[code
] : "unknown");
354 string
= build_string (code
< NSIG
? sys_errlist
[code
] : "unknown");
356 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
357 XSTRING (string
)->data
[0] = DOWNCASE (XSTRING (string
)->data
[0]);
358 return concat2 (string
, string2
);
360 else if (EQ (symbol
, Qexit
))
363 return build_string ("finished\n");
364 string
= Fnumber_to_string (make_number (code
));
365 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
366 return concat2 (build_string ("exited abnormally with code "),
367 concat2 (string
, string2
));
370 return Fcopy_sequence (Fsymbol_name (symbol
));
375 /* Open an available pty, returning a file descriptor.
376 Return -1 on failure.
377 The file name of the terminal corresponding to the pty
378 is left in the variable pty_name. */
389 /* Some systems name their pseudoterminals so that there are gaps in
390 the usual sequence - for example, on HP9000/S700 systems, there
391 are no pseudoterminals with names ending in 'f'. So we wait for
392 three failures in a row before deciding that we've reached the
394 int failed_count
= 0;
399 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
400 for (i
= 0; i
< 16; i
++)
403 #ifdef PTY_NAME_SPRINTF
406 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
407 #endif /* no PTY_NAME_SPRINTF */
411 #else /* no PTY_OPEN */
413 /* Unusual IRIS code */
414 *ptyv
= open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
417 if (fstat (fd
, &stb
) < 0)
420 if (stat (pty_name
, &stb
) < 0)
423 if (failed_count
>= 3)
429 fd
= open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
431 fd
= open (pty_name
, O_RDWR
| O_NDELAY
, 0);
433 #endif /* not IRIS */
434 #endif /* no PTY_OPEN */
438 /* check to make certain that both sides are available
439 this avoids a nasty yet stupid bug in rlogins */
440 #ifdef PTY_TTY_NAME_SPRINTF
443 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
444 #endif /* no PTY_TTY_NAME_SPRINTF */
446 if (access (pty_name
, 6) != 0)
449 #if !defined(IRIS) && !defined(__sgi)
455 #endif /* not UNIPLUS */
462 #endif /* HAVE_PTYS */
468 register Lisp_Object val
, tem
, name1
;
469 register struct Lisp_Process
*p
;
473 /* size of process structure includes the vector header,
474 so deduct for that. But struct Lisp_Vector includes the first
475 element, thus deducts too much, so add it back. */
476 val
= Fmake_vector (make_number ((sizeof (struct Lisp_Process
)
477 - sizeof (struct Lisp_Vector
)
478 + sizeof (Lisp_Object
))
479 / sizeof (Lisp_Object
)),
481 XSETTYPE (val
, Lisp_Process
);
484 XFASTINT (p
->infd
) = 0;
485 XFASTINT (p
->outfd
) = 0;
486 XFASTINT (p
->pid
) = 0;
487 XFASTINT (p
->tick
) = 0;
488 XFASTINT (p
->update_tick
) = 0;
489 p
->raw_status_low
= Qnil
;
490 p
->raw_status_high
= Qnil
;
492 p
->mark
= Fmake_marker ();
494 /* If name is already in use, modify it until it is unused. */
499 tem
= Fget_process (name1
);
500 if (NILP (tem
)) break;
501 sprintf (suffix
, "<%d>", i
);
502 name1
= concat2 (name
, build_string (suffix
));
506 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
510 remove_process (proc
)
511 register Lisp_Object proc
;
513 register Lisp_Object pair
;
515 pair
= Frassq (proc
, Vprocess_alist
);
516 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
517 Fset_marker (XPROCESS (proc
)->mark
, Qnil
, Qnil
);
519 deactivate_process (proc
);
522 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
523 "Return t if OBJECT is a process.")
527 return XTYPE (obj
) == Lisp_Process
? Qt
: Qnil
;
530 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
531 "Return the process named NAME, or nil if there is none.")
533 register Lisp_Object name
;
535 if (XTYPE (name
) == Lisp_Process
)
537 CHECK_STRING (name
, 0);
538 return Fcdr (Fassoc (name
, Vprocess_alist
));
541 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
542 "Return the (or, a) process associated with BUFFER.\n\
543 BUFFER may be a buffer or the name of one.")
545 register Lisp_Object name
;
547 register Lisp_Object buf
, tail
, proc
;
549 if (NILP (name
)) return Qnil
;
550 buf
= Fget_buffer (name
);
551 if (NILP (buf
)) return Qnil
;
553 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
555 proc
= Fcdr (Fcar (tail
));
556 if (XTYPE (proc
) == Lisp_Process
&& EQ (XPROCESS (proc
)->buffer
, buf
))
562 /* This is how commands for the user decode process arguments. It
563 accepts a process, a process name, a buffer, a buffer name, or nil.
564 Buffers denote the first process in the buffer, and nil denotes the
569 register Lisp_Object name
;
571 register Lisp_Object proc
;
573 proc
= Fget_buffer_process (Fcurrent_buffer ());
576 proc
= Fget_process (name
);
578 proc
= Fget_buffer_process (Fget_buffer (name
));
585 error ("Current buffer has no process");
587 error ("Process %s does not exist", XSTRING (name
)->data
);
591 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
592 "Delete PROCESS: kill it and forget about it immediately.\n\
593 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
594 nil, indicating the current buffer's process.")
596 register Lisp_Object proc
;
598 proc
= get_process (proc
);
599 XPROCESS (proc
)->raw_status_low
= Qnil
;
600 XPROCESS (proc
)->raw_status_high
= Qnil
;
601 if (NETCONN_P (proc
))
603 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
604 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
606 else if (XFASTINT (XPROCESS (proc
)->infd
))
608 Fkill_process (proc
, Qnil
);
609 /* Do this now, since remove_process will make sigchld_handler do nothing. */
610 XPROCESS (proc
)->status
611 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
612 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
615 remove_process (proc
);
619 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
620 "Return the status of PROCESS: a symbol, one of these:\n\
621 run -- for a process that is running.\n\
622 stop -- for a process stopped but continuable.\n\
623 exit -- for a process that has exited.\n\
624 signal -- for a process that has got a fatal signal.\n\
625 open -- for a network stream connection that is open.\n\
626 closed -- for a network stream connection that is closed.\n\
627 nil -- if arg is a process name and no such process exists.\n\
628 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
629 nil, indicating the current buffer's process.")
630 /* command -- for a command channel opened to Emacs by another process.\n\
631 external -- for an i/o channel opened to Emacs by another process.\n\ */
633 register Lisp_Object proc
;
635 register struct Lisp_Process
*p
;
636 register Lisp_Object status
;
637 proc
= get_process (proc
);
641 if (!NILP (p
->raw_status_low
))
644 if (XTYPE (status
) == Lisp_Cons
)
645 status
= XCONS (status
)->car
;
646 if (NETCONN_P (proc
))
648 if (EQ (status
, Qrun
))
650 else if (EQ (status
, Qexit
))
656 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
658 "Return the exit status of PROCESS or the signal number that killed it.\n\
659 If PROCESS has not yet exited or died, return 0.")
661 register Lisp_Object proc
;
663 CHECK_PROCESS (proc
, 0);
664 if (!NILP (XPROCESS (proc
)->raw_status_low
))
665 update_status (XPROCESS (proc
));
666 if (XTYPE (XPROCESS (proc
)->status
) == Lisp_Cons
)
667 return XCONS (XCONS (XPROCESS (proc
)->status
)->cdr
)->car
;
668 return make_number (0);
671 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
672 "Return the process id of PROCESS.\n\
673 This is the pid of the Unix process which PROCESS uses or talks to.\n\
674 For a network connection, this value is nil.")
676 register Lisp_Object proc
;
678 CHECK_PROCESS (proc
, 0);
679 return XPROCESS (proc
)->pid
;
682 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
683 "Return the name of PROCESS, as a string.\n\
684 This is the name of the program invoked in PROCESS,\n\
685 possibly modified to make it unique among process names.")
687 register Lisp_Object proc
;
689 CHECK_PROCESS (proc
, 0);
690 return XPROCESS (proc
)->name
;
693 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
694 "Return the command that was executed to start PROCESS.\n\
695 This is a list of strings, the first string being the program executed\n\
696 and the rest of the strings being the arguments given to it.\n\
697 For a non-child channel, this is nil.")
699 register Lisp_Object proc
;
701 CHECK_PROCESS (proc
, 0);
702 return XPROCESS (proc
)->command
;
705 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
707 "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
709 register Lisp_Object proc
, buffer
;
711 CHECK_PROCESS (proc
, 0);
713 CHECK_BUFFER (buffer
, 1);
714 XPROCESS (proc
)->buffer
= buffer
;
718 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
720 "Return the buffer PROCESS is associated with.\n\
721 Output from PROCESS is inserted in this buffer\n\
722 unless PROCESS has a filter.")
724 register Lisp_Object proc
;
726 CHECK_PROCESS (proc
, 0);
727 return XPROCESS (proc
)->buffer
;
730 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
732 "Return the marker for the end of the last output from PROCESS.")
734 register Lisp_Object proc
;
736 CHECK_PROCESS (proc
, 0);
737 return XPROCESS (proc
)->mark
;
740 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
742 "Give PROCESS the filter function FILTER; nil means no filter.\n\
743 When a process has a filter, each time it does output\n\
744 the entire string of output is passed to the filter.\n\
745 The filter gets two arguments: the process and the string of output.\n\
746 If the process has a filter, its buffer is not used for output.")
748 register Lisp_Object proc
, filter
;
750 CHECK_PROCESS (proc
, 0);
751 XPROCESS (proc
)->filter
= filter
;
755 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
757 "Returns the filter function of PROCESS; nil if none.\n\
758 See `set-process-filter' for more info on filter functions.")
760 register Lisp_Object proc
;
762 CHECK_PROCESS (proc
, 0);
763 return XPROCESS (proc
)->filter
;
766 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
768 "Give PROCESS the sentinel SENTINEL; nil for none.\n\
769 The sentinel is called as a function when the process changes state.\n\
770 It gets two arguments: the process, and a string describing the change.")
772 register Lisp_Object proc
, sentinel
;
774 CHECK_PROCESS (proc
, 0);
775 XPROCESS (proc
)->sentinel
= sentinel
;
779 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
781 "Return the sentinel of PROCESS; nil if none.\n\
782 See `set-process-sentinel' for more info on sentinels.")
784 register Lisp_Object proc
;
786 CHECK_PROCESS (proc
, 0);
787 return XPROCESS (proc
)->sentinel
;
790 DEFUN ("process-kill-without-query", Fprocess_kill_without_query
,
791 Sprocess_kill_without_query
, 1, 2, 0,
792 "Say no query needed if PROCESS is running when Emacs is exited.\n\
793 Optional second argument if non-nill says to require a query.\n\
794 Value is t if a query was formerly required.")
796 register Lisp_Object proc
, value
;
800 CHECK_PROCESS (proc
, 0);
801 tem
= XPROCESS (proc
)->kill_without_query
;
802 XPROCESS (proc
)->kill_without_query
= Fnull (value
);
810 register Lisp_Object tail
, tem
;
811 Lisp_Object proc
, minspace
, tem1
;
812 register struct buffer
*old
= current_buffer
;
813 register struct Lisp_Process
*p
;
817 XFASTINT (minspace
) = 1;
819 set_buffer_internal (XBUFFER (Vstandard_output
));
820 Fbuffer_disable_undo (Vstandard_output
);
822 current_buffer
->truncate_lines
= Qt
;
825 Proc Status Buffer Command\n\
826 ---- ------ ------ -------\n", -1);
828 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
832 proc
= Fcdr (Fcar (tail
));
834 if (NILP (p
->childp
))
837 Finsert (1, &p
->name
);
838 Findent_to (make_number (13), minspace
);
840 if (!NILP (p
->raw_status_low
))
843 if (XTYPE (p
->status
) == Lisp_Cons
)
844 symbol
= XCONS (p
->status
)->car
;
847 if (EQ (symbol
, Qsignal
))
850 tem
= Fcar (Fcdr (p
->status
));
852 if (XINT (tem
) < NSIG
)
853 write_string (sys_errlist
[XINT (tem
)], -1);
856 Fprinc (symbol
, Qnil
);
858 else if (NETCONN_P (proc
))
860 if (EQ (symbol
, Qrun
))
861 write_string ("open", -1);
862 else if (EQ (symbol
, Qexit
))
863 write_string ("closed", -1);
865 Fprinc (symbol
, Qnil
);
868 Fprinc (symbol
, Qnil
);
870 if (EQ (symbol
, Qexit
))
873 tem
= Fcar (Fcdr (p
->status
));
876 sprintf (tembuf
, " %d", XFASTINT (tem
));
877 write_string (tembuf
, -1);
881 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
882 remove_process (proc
);
884 Findent_to (make_number (22), minspace
);
885 if (NILP (p
->buffer
))
886 insert_string ("(none)");
887 else if (NILP (XBUFFER (p
->buffer
)->name
))
888 insert_string ("(Killed)");
890 Finsert (1, &XBUFFER (p
->buffer
)->name
);
892 Findent_to (make_number (37), minspace
);
894 if (NETCONN_P (proc
))
896 sprintf (tembuf
, "(network stream connection to %s)\n",
897 XSTRING (p
->childp
)->data
);
898 insert_string (tembuf
);
912 insert_string ("\n");
918 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 0, "",
919 "Display a list of all processes.\n\
920 \(Any processes listed as Exited or Signaled are actually eliminated\n\
921 after the listing is made.)")
924 internal_with_output_to_temp_buffer ("*Process List*",
925 list_processes_1
, Qnil
);
929 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
930 "Return a list of all processes.")
933 return Fmapcar (Qcdr
, Vprocess_alist
);
936 /* Starting asynchronous inferior processes. */
938 static Lisp_Object
start_process_unwind ();
940 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
941 "Start a program in a subprocess. Return the process object for it.\n\
942 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
943 NAME is name for process. It is modified if necessary to make it unique.\n\
944 BUFFER is the buffer or (buffer-name) to associate with the process.\n\
945 Process output goes at end of that buffer, unless you specify\n\
946 an output stream or filter function to handle the output.\n\
947 BUFFER may be also nil, meaning that this process is not associated\n\
949 Third arg is program file name. It is searched for as in the shell.\n\
950 Remaining arguments are strings to give program as arguments.")
953 register Lisp_Object
*args
;
955 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
957 register unsigned char *new_argv
;
960 register unsigned char **new_argv
;
963 int count
= specpdl_ptr
- specpdl
;
967 buffer
= Fget_buffer_create (buffer
);
969 /* Make sure that the child will be able to chdir to the current
970 buffer's current directory, or its unhandled equivalent. We
971 can't just have the child check for an error when it does the
972 chdir, since it's in a vfork.
974 We have to GCPRO around this because Fexpand_file_name and
975 Funhandled_file_name_directory might call a file name handling
976 function. The argument list is protected by the caller, so all
977 we really have to worry about is buffer. */
979 struct gcpro gcpro1
, gcpro2
;
981 current_dir
= current_buffer
->directory
;
983 GCPRO2 (buffer
, current_dir
);
986 expand_and_dir_to_file
987 (Funhandled_file_name_directory (current_dir
), Qnil
);
988 if (NILP (Ffile_accessible_directory_p (current_dir
)))
989 report_file_error ("Setting current directory",
990 Fcons (current_buffer
->directory
, Qnil
));
996 CHECK_STRING (name
, 0);
1000 CHECK_STRING (program
, 2);
1003 /* Make a one member argv with all args concatenated
1004 together separated by a blank. */
1005 len
= XSTRING (program
)->size
+ 2;
1006 for (i
= 3; i
< nargs
; i
++)
1009 CHECK_STRING (tem
, i
);
1010 len
+= XSTRING (tem
)->size
+ 1; /* count the blank */
1012 new_argv
= (unsigned char *) alloca (len
);
1013 strcpy (new_argv
, XSTRING (program
)->data
);
1014 for (i
= 3; i
< nargs
; i
++)
1017 CHECK_STRING (tem
, i
);
1018 strcat (new_argv
, " ");
1019 strcat (new_argv
, XSTRING (tem
)->data
);
1021 /* Need to add code here to check for program existence on VMS */
1024 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1026 for (i
= 3; i
< nargs
; i
++)
1029 CHECK_STRING (tem
, i
);
1030 new_argv
[i
- 2] = XSTRING (tem
)->data
;
1032 new_argv
[i
- 2] = 0;
1033 new_argv
[0] = XSTRING (program
)->data
;
1035 /* If program file name is not absolute, search our path for it */
1036 if (new_argv
[0][0] != '/')
1039 openp (Vexec_path
, program
, EXEC_SUFFIXES
, &tem
, 1);
1041 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1042 new_argv
[0] = XSTRING (tem
)->data
;
1044 #endif /* not VMS */
1046 proc
= make_process (name
);
1047 /* If an error occurs and we can't start the process, we want to
1048 remove it from the process list. This means that each error
1049 check in create_process doesn't need to call remove_process
1050 itself; it's all taken care of here. */
1051 record_unwind_protect (start_process_unwind
, proc
);
1053 XPROCESS (proc
)->childp
= Qt
;
1054 XPROCESS (proc
)->command_channel_p
= Qnil
;
1055 XPROCESS (proc
)->buffer
= buffer
;
1056 XPROCESS (proc
)->sentinel
= Qnil
;
1057 XPROCESS (proc
)->filter
= Qnil
;
1058 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1060 create_process (proc
, new_argv
, current_dir
);
1062 return unbind_to (count
, proc
);
1065 /* This function is the unwind_protect form for Fstart_process. If
1066 PROC doesn't have its pid set, then we know someone has signalled
1067 an error and the process wasn't started successfully, so we should
1068 remove it from the process list. */
1070 start_process_unwind (proc
)
1073 if (XTYPE (proc
) != Lisp_Process
)
1076 /* Was PROC started successfully? */
1077 if (XPROCESS (proc
)->pid
<= 0)
1078 remove_process (proc
);
1085 create_process_1 (signo
)
1089 /* USG systems forget handlers when they are used;
1090 must reestablish each time */
1091 signal (signo
, create_process_1
);
1095 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1098 /* Mimic blocking of signals on system V, which doesn't really have it. */
1100 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1101 int sigchld_deferred
;
1104 create_process_sigchld ()
1106 signal (SIGCHLD
, create_process_sigchld
);
1108 sigchld_deferred
= 1;
1114 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1115 create_process (process
, new_argv
, current_dir
)
1116 Lisp_Object process
;
1118 Lisp_Object current_dir
;
1120 int pid
, inchannel
, outchannel
, forkin
, forkout
;
1123 SIGTYPE (*sigchld
)();
1126 extern char **environ
;
1128 inchannel
= outchannel
= -1;
1131 if (EQ (Vprocess_connection_type
, Qt
))
1132 outchannel
= inchannel
= allocate_pty ();
1137 /* On USG systems it does not work to open the pty's tty here
1138 and then close and reopen it in the child. */
1140 /* Don't let this terminal become our controlling terminal
1141 (in case we don't have one). */
1142 forkout
= forkin
= open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1144 forkout
= forkin
= open (pty_name
, O_RDWR
, 0);
1147 report_file_error ("Opening pty", Qnil
);
1149 forkin
= forkout
= -1;
1150 #endif /* not USG */
1154 #endif /* HAVE_PTYS */
1157 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1158 report_file_error ("Opening socketpair", Qnil
);
1159 outchannel
= inchannel
= sv
[0];
1160 forkout
= forkin
= sv
[1];
1162 #else /* not SKTPAIR */
1171 #endif /* not SKTPAIR */
1174 /* Replaced by close_process_descs */
1175 set_exclusive_use (inchannel
);
1176 set_exclusive_use (outchannel
);
1179 /* Stride people say it's a mystery why this is needed
1180 as well as the O_NDELAY, but that it fails without this. */
1181 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1184 ioctl (inchannel
, FIONBIO
, &one
);
1189 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1192 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1196 /* Record this as an active process, with its channels.
1197 As a result, child_setup will close Emacs's side of the pipes. */
1198 chan_process
[inchannel
] = process
;
1199 XFASTINT (XPROCESS (process
)->infd
) = inchannel
;
1200 XFASTINT (XPROCESS (process
)->outfd
) = outchannel
;
1201 /* Record the tty descriptor used in the subprocess. */
1203 XPROCESS (process
)->subtty
= Qnil
;
1205 XFASTINT (XPROCESS (process
)->subtty
) = forkin
;
1206 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1207 XPROCESS (process
)->status
= Qrun
;
1209 /* Delay interrupts until we have a chance to store
1210 the new fork's pid in its process structure */
1214 #else /* not BSD4_1 */
1215 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1216 sigsetmask (sigmask (SIGCHLD
));
1217 #else /* ordinary USG */
1219 sigchld_deferred
= 0;
1220 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1222 #endif /* ordinary USG */
1223 #endif /* not BSD4_1 */
1224 #endif /* SIGCHLD */
1226 /* Until we store the proper pid, enable sigchld_handler
1227 to recognize an unknown pid as standing for this process.
1228 It is very important not to let this `marker' value stay
1229 in the table after this function has returned; if it does
1230 it might cause call-process to hang and subsequent asynchronous
1231 processes to get their return values scrambled. */
1232 XSETINT (XPROCESS (process
)->pid
, -1);
1235 /* child_setup must clobber environ on systems with true vfork.
1236 Protect it from permanent change. */
1237 char **save_environ
= environ
;
1242 int xforkin
= forkin
;
1243 int xforkout
= forkout
;
1245 #if 0 /* This was probably a mistake--it duplicates code later on,
1246 but fails to handle all the cases. */
1247 /* Make sure SIGCHLD is not blocked in the child. */
1248 sigsetmask (SIGEMPTYMASK
);
1251 /* Make the pty be the controlling terminal of the process. */
1253 /* First, disconnect its current controlling terminal. */
1257 /* Make the pty's terminal the controlling terminal. */
1259 /* We ignore the return value
1260 because faith@cs.unc.edu says that is necessary on Linux. */
1261 ioctl (xforkin
, TIOCSCTTY
, 0);
1263 #else /* not HAVE_SETSID */
1265 /* It's very important to call setpgrp() here and no time
1266 afterwards. Otherwise, we lose our controlling tty which
1267 is set when we open the pty. */
1270 #endif /* not HAVE_SETSID */
1272 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1273 can do TIOCSPGRP only to the process's controlling tty. */
1276 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1277 I can't test it since I don't have 4.3. */
1278 int j
= open ("/dev/tty", O_RDWR
, 0);
1279 ioctl (j
, TIOCNOTTY
, 0);
1282 /* In order to get a controlling terminal on some versions
1283 of BSD, it is necessary to put the process in pgrp 0
1284 before it opens the terminal. */
1288 #endif /* TIOCNOTTY */
1290 #if !defined (RTU) && !defined (UNIPLUS)
1291 /*** There is a suggestion that this ought to be a
1292 conditional on TIOCSPGRP. */
1293 /* Now close the pty (if we had it open) and reopen it.
1294 This makes the pty the controlling terminal of the subprocess. */
1297 /* I wonder if close (open (pty_name, ...)) would work? */
1300 xforkout
= xforkin
= open (pty_name
, O_RDWR
, 0);
1305 #endif /* not UNIPLUS and not RTU */
1306 #ifdef SETUP_SLAVE_PTY
1308 #endif /* SETUP_SLAVE_PTY */
1310 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1311 Now reenable it in the child, so it will die when we want it to. */
1313 signal (SIGHUP
, SIG_DFL
);
1315 #endif /* HAVE_PTYS */
1320 #else /* not BSD4_1 */
1321 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1322 sigsetmask (SIGEMPTYMASK
);
1323 #else /* ordinary USG */
1325 signal (SIGCHLD
, sigchld
);
1327 #endif /* ordinary USG */
1328 #endif /* not BSD4_1 */
1329 #endif /* SIGCHLD */
1331 child_setup_tty (xforkout
);
1332 child_setup (xforkin
, xforkout
, xforkout
,
1333 new_argv
, 1, current_dir
);
1335 environ
= save_environ
;
1339 report_file_error ("Doing vfork", Qnil
);
1341 XFASTINT (XPROCESS (process
)->pid
) = pid
;
1343 FD_SET (inchannel
, &input_wait_mask
);
1345 /* If the subfork execv fails, and it exits,
1346 this close hangs. I don't know why.
1347 So have an interrupt jar it loose. */
1349 signal (SIGALRM
, create_process_1
);
1352 /* OK to close only if it's not a pty. Otherwise we need to leave
1353 it open for ioctl to get pgrp when signals are sent, or to send
1354 the interrupt characters through if that's how we're signalling
1355 subprocesses. Alternately if you are concerned about running out
1356 of file descriptors, you could just save the tty name and open
1357 just to do the ioctl. */
1358 if (NILP (XFASTINT (XPROCESS (process
)->pty_flag
)))
1361 XPROCESS (process
)->subtty
= Qnil
;
1367 if (forkin
!= forkout
&& forkout
>= 0)
1373 #else /* not BSD4_1 */
1374 #if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1375 sigsetmask (SIGEMPTYMASK
);
1376 #else /* ordinary USG */
1378 signal (SIGCHLD
, sigchld
);
1379 /* Now really handle any of these signals
1380 that came in during this function. */
1381 if (sigchld_deferred
)
1382 kill (getpid (), SIGCHLD
);
1384 #endif /* ordinary USG */
1385 #endif /* not BSD4_1 */
1386 #endif /* SIGCHLD */
1388 #endif /* not VMS */
1392 /* open a TCP network connection to a given HOST/SERVICE. Treated
1393 exactly like a normal process when reading and writing. Only
1394 differences are in status display and process deletion. A network
1395 connection has no PID; you cannot signal it. All you can do is
1396 deactivate and close it via delete-process */
1398 DEFUN ("open-network-stream", Fopen_network_stream
, Sopen_network_stream
,
1400 "Open a TCP connection for a service to a host.\n\
1401 Returns a subprocess-object to represent the connection.\n\
1402 Input and output work as for subprocesses; `delete-process' closes it.\n\
1403 Args are NAME BUFFER HOST SERVICE.\n\
1404 NAME is name for process. It is modified if necessary to make it unique.\n\
1405 BUFFER is the buffer (or buffer-name) to associate with the process.\n\
1406 Process output goes at end of that buffer, unless you specify\n\
1407 an output stream or filter function to handle the output.\n\
1408 BUFFER may be also nil, meaning that this process is not associated\n\
1410 Third arg is name of the host to connect to, or its IP address.\n\
1411 Fourth arg SERVICE is name of the service desired, or an integer\n\
1412 specifying a port number to connect to.")
1413 (name
, buffer
, host
, service
)
1414 Lisp_Object name
, buffer
, host
, service
;
1418 struct sockaddr_in address
;
1419 struct servent
*svc_info
;
1420 struct hostent
*host_info_ptr
, host_info
;
1421 char *(addr_list
[2]);
1422 unsigned long numeric_addr
;
1426 struct hostent host_info_fixed
;
1427 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1429 GCPRO4 (name
, buffer
, host
, service
);
1430 CHECK_STRING (name
, 0);
1431 CHECK_STRING (host
, 0);
1432 if (XTYPE(service
) == Lisp_Int
)
1433 port
= htons ((unsigned short) XINT (service
));
1436 CHECK_STRING (service
, 0);
1437 svc_info
= getservbyname (XSTRING (service
)->data
, "tcp");
1439 error ("Unknown service \"%s\"", XSTRING (service
)->data
);
1440 port
= svc_info
->s_port
;
1443 host_info_ptr
= gethostbyname (XSTRING (host
)->data
);
1444 if (host_info_ptr
== 0)
1445 /* Attempt to interpret host as numeric inet address */
1447 numeric_addr
= inet_addr (XSTRING (host
)->data
);
1448 if (numeric_addr
== -1)
1449 error ("Unknown host \"%s\"", XSTRING (host
)->data
);
1451 host_info_ptr
= &host_info
;
1452 host_info
.h_name
= 0;
1453 host_info
.h_aliases
= 0;
1454 host_info
.h_addrtype
= AF_INET
;
1456 /* Older machines have only one address slot called h_addr.
1457 Newer machines have h_addr_list, but #define h_addr to
1458 be its first element. */
1459 host_info
.h_addr_list
= &(addr_list
[0]);
1461 host_info
.h_addr
= (char*)(&numeric_addr
);
1463 host_info
.h_length
= strlen (addr_list
[0]);
1466 bzero (&address
, sizeof address
);
1467 bcopy (host_info_ptr
->h_addr
, (char *) &address
.sin_addr
,
1468 host_info_ptr
->h_length
);
1469 address
.sin_family
= host_info_ptr
->h_addrtype
;
1470 address
.sin_port
= port
;
1472 s
= socket (host_info_ptr
->h_addrtype
, SOCK_STREAM
, 0);
1474 report_file_error ("error creating socket", Fcons (name
, Qnil
));
1477 if (connect (s
, &address
, sizeof address
) == -1)
1484 report_file_error ("connection failed",
1485 Fcons (host
, Fcons (name
, Qnil
)));
1491 report_file_error ("error duplicating socket", Fcons (name
, Qnil
));
1494 buffer
= Fget_buffer_create (buffer
);
1495 proc
= make_process (name
);
1497 chan_process
[inch
] = proc
;
1500 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
1503 fcntl (inch
, F_SETFL
, O_NDELAY
);
1507 XPROCESS (proc
)->childp
= host
;
1508 XPROCESS (proc
)->command_channel_p
= Qnil
;
1509 XPROCESS (proc
)->buffer
= buffer
;
1510 XPROCESS (proc
)->sentinel
= Qnil
;
1511 XPROCESS (proc
)->filter
= Qnil
;
1512 XPROCESS (proc
)->command
= Qnil
;
1513 XPROCESS (proc
)->pid
= Qnil
;
1514 XFASTINT (XPROCESS (proc
)->infd
) = s
;
1515 XFASTINT (XPROCESS (proc
)->outfd
) = outch
;
1516 XPROCESS (proc
)->status
= Qrun
;
1517 FD_SET (inch
, &input_wait_mask
);
1522 #endif /* HAVE_SOCKETS */
1524 deactivate_process (proc
)
1527 register int inchannel
, outchannel
;
1528 register struct Lisp_Process
*p
= XPROCESS (proc
);
1530 inchannel
= XFASTINT (p
->infd
);
1531 outchannel
= XFASTINT (p
->outfd
);
1535 /* Beware SIGCHLD hereabouts. */
1536 flush_pending_output (inchannel
);
1539 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
1540 sys$
dassgn (outchannel
);
1541 vs
= get_vms_process_pointer (p
->pid
);
1543 give_back_vms_process_stuff (vs
);
1547 if (outchannel
&& outchannel
!= inchannel
)
1551 XFASTINT (p
->infd
) = 0;
1552 XFASTINT (p
->outfd
) = 0;
1553 chan_process
[inchannel
] = Qnil
;
1554 FD_CLR (inchannel
, &input_wait_mask
);
1558 /* Close all descriptors currently in use for communication
1559 with subprocess. This is used in a newly-forked subprocess
1560 to get rid of irrelevant descriptors. */
1562 close_process_descs ()
1565 for (i
= 0; i
< MAXDESC
; i
++)
1567 Lisp_Object process
;
1568 process
= chan_process
[i
];
1569 if (!NILP (process
))
1571 int in
= XFASTINT (XPROCESS (process
)->infd
);
1572 int out
= XFASTINT (XPROCESS (process
)->outfd
);
1575 if (out
&& in
!= out
)
1581 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
1583 "Allow any pending output from subprocesses to be read by Emacs.\n\
1584 It is read into the process' buffers or given to their filter functions.\n\
1585 Non-nil arg PROCESS means do not return until some output has been received\n\
1587 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\
1588 seconds and microseconds to wait; return after that much time whether\n\
1589 or not there is input.\n\
1590 Return non-nil iff we received any output before the timeout expired.")
1591 (proc
, timeout
, timeout_msecs
)
1592 register Lisp_Object proc
, timeout
, timeout_msecs
;
1597 if (! NILP (timeout_msecs
))
1599 CHECK_NUMBER (timeout_msecs
, 2);
1600 useconds
= XINT (timeout_msecs
);
1601 if (XTYPE (timeout
) != Lisp_Int
)
1602 XSET (timeout
, Lisp_Int
, 0);
1605 int carry
= useconds
/ 1000000;
1607 XSETINT (timeout
, XINT (timeout
) + carry
);
1608 useconds
-= carry
* 1000000;
1610 /* I think this clause is necessary because C doesn't
1611 guarantee a particular rounding direction for negative
1615 XSETINT (timeout
, XINT (timeout
) - 1);
1616 useconds
+= 1000000;
1623 if (! NILP (timeout
))
1625 CHECK_NUMBER (timeout
, 1);
1626 seconds
= XINT (timeout
);
1639 XFASTINT (proc
) = 0;
1642 (wait_reading_process_input (seconds
, useconds
, proc
, 0)
1646 /* This variable is different from waiting_for_input in keyboard.c.
1647 It is used to communicate to a lisp process-filter/sentinel (via the
1648 function Fwaiting_for_user_input_p below) whether emacs was waiting
1649 for user-input when that process-filter was called.
1650 waiting_for_input cannot be used as that is by definition 0 when
1651 lisp code is being evalled */
1652 static int waiting_for_user_input_p
;
1654 /* Read and dispose of subprocess output while waiting for timeout to
1655 elapse and/or keyboard input to be available.
1658 timeout in seconds, or
1659 zero for no limit, or
1660 -1 means gobble data immediately available but don't wait for any.
1663 an additional duration to wait (if time_limit is greater than
1664 zero), specified in millisec.
1666 read_kbd is a lisp value:
1667 0 to ignore keyboard input, or
1668 1 to return when input is available, or
1669 -1 meaning caller will actually read the input, so don't throw to
1670 the quit handler, or
1671 a cons cell, meaning wait wait until its car is non-nil, or
1672 a process object, meaning wait until something arrives from that
1673 process. The return value is true iff we read some input from
1676 do_display != 0 means redisplay should be done to show subprocess
1677 output that arrives.
1679 If read_kbd is a pointer to a struct Lisp_Process, then the
1680 function returns true iff we received input from that process
1681 before the timeout elapsed.
1682 Otherwise, return true iff we recieved input from any process. */
1684 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
1685 int time_limit
, microsecs
;
1686 Lisp_Object read_kbd
;
1689 register int channel
, nfds
, m
;
1690 static SELECT_TYPE Available
;
1693 EMACS_TIME timeout
, end_time
, garbage
;
1695 int wait_channel
= 0;
1696 struct Lisp_Process
*wait_proc
= 0;
1697 int got_some_input
= 0;
1698 Lisp_Object
*wait_for_cell
= 0;
1700 FD_ZERO (&Available
);
1702 /* If read_kbd is a process to watch, set wait_proc and wait_channel
1704 if (XTYPE (read_kbd
) == Lisp_Process
)
1706 wait_proc
= XPROCESS (read_kbd
);
1707 wait_channel
= XFASTINT (wait_proc
->infd
);
1708 XFASTINT (read_kbd
) = 0;
1711 /* If waiting for non-nil in a cell, record where. */
1712 if (XTYPE (read_kbd
) == Lisp_Cons
)
1714 wait_for_cell
= &XCONS (read_kbd
)->car
;
1715 XFASTINT (read_kbd
) = 0;
1718 waiting_for_user_input_p
= XINT (read_kbd
);
1720 /* Since we may need to wait several times,
1721 compute the absolute time to return at. */
1722 if (time_limit
|| microsecs
)
1724 EMACS_GET_TIME (end_time
);
1725 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
1726 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
1731 /* If calling from keyboard input, do not quit
1732 since we want to return C-g as an input character.
1733 Otherwise, do pending quit if requested. */
1734 if (XINT (read_kbd
) >= 0)
1737 /* Compute time from now till when time limit is up */
1738 /* Exit if already run out */
1739 if (time_limit
== -1)
1741 /* -1 specified for timeout means
1742 gobble output available now
1743 but don't wait at all. */
1745 EMACS_SET_SECS_USECS (timeout
, 0, 0);
1747 else if (time_limit
|| microsecs
)
1749 EMACS_GET_TIME (timeout
);
1750 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
1751 if (EMACS_TIME_NEG_P (timeout
))
1756 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
1759 /* Cause C-g and alarm signals to take immediate action,
1760 and cause input available signals to zero out timeout.
1762 It is important that we do this before checking for process
1763 activity. If we get a SIGCHLD after the explicit checks for
1764 process activity, timeout is the only way we will know. */
1765 if (XINT (read_kbd
) < 0)
1766 set_waiting_for_input (&timeout
);
1768 /* If status of something has changed, and no input is
1769 available, notify the user of the change right away. After
1770 this explicit check, we'll let the SIGCHLD handler zap
1771 timeout to get our attention. */
1772 if (update_tick
!= process_tick
&& do_display
)
1774 Atemp
= input_wait_mask
;
1775 EMACS_SET_SECS_USECS (timeout
, 0, 0);
1776 if (select (MAXDESC
, &Atemp
, 0, 0, &timeout
) <= 0)
1778 /* It's okay for us to do this and then continue with
1779 the loop, since timeout has already been zeroed out. */
1780 clear_waiting_for_input ();
1785 /* Don't wait for output from a non-running process. */
1786 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
1787 update_status (wait_proc
);
1789 && ! EQ (wait_proc
->status
, Qrun
))
1791 clear_waiting_for_input ();
1795 /* Wait till there is something to do */
1797 Available
= input_wait_mask
;
1798 if (! XINT (read_kbd
))
1799 FD_CLR (0, &Available
);
1801 /* If frame size has changed or the window is newly mapped,
1802 redisplay now, before we start to wait. There is a race
1803 condition here; if a SIGIO arrives between now and the select
1804 and indicates that a frame is trashed, the select may block
1805 displaying a trashed screen. */
1807 redisplay_preserve_echo_area ();
1809 if (XINT (read_kbd
) && detect_input_pending ())
1812 nfds
= select (MAXDESC
, &Available
, 0, 0, &timeout
);
1816 /* Make C-g and alarm signals set flags again */
1817 clear_waiting_for_input ();
1819 /* If we woke up due to SIGWINCH, actually change size now. */
1820 do_pending_window_change ();
1822 if (time_limit
&& nfds
== 0) /* timeout elapsed */
1826 if (xerrno
== EINTR
)
1827 FD_ZERO (&Available
);
1829 /* Ultrix select seems to return ENOMEM when it is
1830 interrupted. Treat it just like EINTR. Bleah. Note
1831 that we want to test for the "ultrix" CPP symbol, not
1832 "__ultrix__"; the latter is only defined under GCC, but
1833 not by DEC's bundled CC. -JimB */
1834 else if (xerrno
== ENOMEM
)
1835 FD_ZERO (&Available
);
1838 /* This happens for no known reason on ALLIANT.
1839 I am guessing that this is the right response. -- RMS. */
1840 else if (xerrno
== EFAULT
)
1841 FD_ZERO (&Available
);
1843 else if (xerrno
== EBADF
)
1846 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
1847 the child's closure of the pts gives the parent a SIGHUP, and
1848 the ptc file descriptor is automatically closed,
1849 yielding EBADF here or at select() call above.
1850 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
1851 in m-ibmrt-aix.h), and here we just ignore the select error.
1852 Cleanup occurs c/o status_notify after SIGCLD. */
1853 FD_ZERO (&Available
); /* Cannot depend on values returned */
1859 error("select error: %s", sys_errlist
[xerrno
]);
1861 #if defined(sun) && !defined(USG5_4)
1862 else if (nfds
> 0 && FD_ISSET (0, &Available
) && interrupt_input
)
1863 /* System sometimes fails to deliver SIGIO.
1865 David J. Mackenzie says that Emacs doesn't compile under
1866 Solaris if this code is enabled, thus the USG5_4 in the CPP
1867 conditional. "I haven't noticed any ill effects so far.
1868 If you find a Solaris expert somewhere, they might know
1870 kill (getpid (), SIGIO
);
1873 /* Check for keyboard input */
1874 /* If there is any, return immediately
1875 to give it higher priority than subprocesses */
1877 if (XINT (read_kbd
) && detect_input_pending ())
1880 if (detect_input_pending ())
1884 /* Exit now if the cell we're waiting for became non-nil. */
1885 if (wait_for_cell
&& ! NILP (*wait_for_cell
))
1889 /* If we think we have keyboard input waiting, but didn't get SIGIO
1890 go read it. This can happen with X on BSD after logging out.
1891 In that case, there really is no input and no SIGIO,
1892 but select says there is input. */
1894 if (XINT (read_kbd
) && interrupt_input
&& (FD_ISSET (fileno (stdin
), &Available
)))
1899 got_some_input
|= nfds
> 0;
1901 /* If checking input just got us a size-change event from X,
1902 obey it now if we should. */
1903 if (XINT (read_kbd
))
1904 do_pending_window_change ();
1906 /* Check for data from a process or a command channel */
1907 for (channel
= FIRST_PROC_DESC
; channel
< MAXDESC
; channel
++)
1909 if (FD_ISSET (channel
, &Available
))
1913 /* If waiting for this channel, arrange to return as
1914 soon as no more input to be processed. No more
1916 if (wait_channel
== channel
)
1922 proc
= chan_process
[channel
];
1926 /* Read data from the process, starting with our
1927 buffered-ahead character if we have one. */
1929 nread
= read_process_output (proc
, channel
);
1932 /* Since read_process_output can run a filter,
1933 which can call accept-process-output,
1934 don't try to read from any other processes
1935 before doing the select again. */
1936 FD_ZERO (&Available
);
1939 redisplay_preserve_echo_area ();
1942 else if (nread
== -1 && errno
== EWOULDBLOCK
)
1946 else if (nread
== -1 && errno
== EAGAIN
)
1950 else if (nread
== -1 && errno
== EAGAIN
)
1952 /* Note that we cannot distinguish between no input
1953 available now and a closed pipe.
1954 With luck, a closed pipe will be accompanied by
1955 subprocess termination and SIGCHLD. */
1956 else if (nread
== 0 && !NETCONN_P (proc
))
1958 #endif /* O_NDELAY */
1959 #endif /* O_NONBLOCK */
1960 #endif /* EWOULDBLOCK */
1962 /* On some OSs with ptys, when the process on one end of
1963 a pty exits, the other end gets an error reading with
1964 errno = EIO instead of getting an EOF (0 bytes read).
1965 Therefore, if we get an error reading and errno =
1966 EIO, just continue, because the child process has
1967 exited and should clean itself up soon (e.g. when we
1969 else if (nread
== -1 && errno
== EIO
)
1971 #endif /* HAVE_PTYS */
1972 /* If we can detect process termination, don't consider the process
1973 gone just because its pipe is closed. */
1975 else if (nread
== 0 && !NETCONN_P (proc
))
1980 /* Preserve status of processes already terminated. */
1981 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
1982 deactivate_process (proc
);
1983 if (!NILP (XPROCESS (proc
)->raw_status_low
))
1984 update_status (XPROCESS (proc
));
1985 if (EQ (XPROCESS (proc
)->status
, Qrun
))
1986 XPROCESS (proc
)->status
1987 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
1990 } /* end for each file descriptor */
1991 } /* end while exit conditions not met */
1993 /* If calling from keyboard input, do not quit
1994 since we want to return C-g as an input character.
1995 Otherwise, do pending quit if requested. */
1996 if (XINT (read_kbd
) >= 0)
1998 /* Prevent input_pending from remaining set if we quit. */
1999 clear_input_pending ();
2003 return got_some_input
;
2006 /* Read pending output from the process channel,
2007 starting with our buffered-ahead character if we have one.
2008 Yield number of characters read.
2010 This function reads at most 1024 characters.
2011 If you want to read all available subprocess output,
2012 you must call it repeatedly until it returns zero. */
2014 read_process_output (proc
, channel
)
2016 register int channel
;
2018 register int nchars
;
2024 register Lisp_Object outstream
;
2025 register struct buffer
*old
= current_buffer
;
2026 register struct Lisp_Process
*p
= XPROCESS (proc
);
2027 register int opoint
;
2030 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
2032 vs
= get_vms_process_pointer (p
->pid
);
2036 return(0); /* Really weird if it does this */
2037 if (!(vs
->iosb
[0] & 1))
2038 return -1; /* I/O error */
2041 error ("Could not get VMS process pointer");
2042 chars
= vs
->inputBuffer
;
2043 nchars
= clean_vms_buffer (chars
, vs
->iosb
[1]);
2046 start_vms_process_read (vs
); /* Crank up the next read on the process */
2047 return 1; /* Nothing worth printing, say we got 1 */
2051 if (proc_buffered_char
[channel
] < 0)
2052 nchars
= read (channel
, chars
, sizeof chars
);
2055 chars
[0] = proc_buffered_char
[channel
];
2056 proc_buffered_char
[channel
] = -1;
2057 nchars
= read (channel
, chars
+ 1, sizeof chars
- 1);
2061 nchars
= nchars
+ 1;
2063 #endif /* not VMS */
2065 if (nchars
<= 0) return nchars
;
2067 outstream
= p
->filter
;
2068 if (!NILP (outstream
))
2070 /* We inhibit quit here instead of just catching it so that
2071 hitting ^G when a filter happens to be running won't screw
2073 int count
= specpdl_ptr
- specpdl
;
2074 specbind (Qinhibit_quit
, Qt
);
2075 call2 (outstream
, proc
, make_string (chars
, nchars
));
2078 start_vms_process_read (vs
);
2084 /* If no filter, write into buffer if it isn't dead. */
2085 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
2087 Lisp_Object old_read_only
;
2088 Lisp_Object old_begv
, old_zv
;
2090 Fset_buffer (p
->buffer
);
2092 old_read_only
= current_buffer
->read_only
;
2093 XFASTINT (old_begv
) = BEGV
;
2094 XFASTINT (old_zv
) = ZV
;
2096 current_buffer
->read_only
= Qnil
;
2098 /* Insert new output into buffer
2099 at the current end-of-output marker,
2100 thus preserving logical ordering of input and output. */
2101 if (XMARKER (p
->mark
)->buffer
)
2102 SET_PT (marker_position (p
->mark
));
2106 /* If the output marker is outside of the visible region, save
2107 the restriction and widen. */
2108 if (! (BEGV
<= point
&& point
<= ZV
))
2111 /* Make sure opoint floats ahead of any new text, just as point
2113 if (point
<= opoint
)
2116 /* Insert after old_begv, but before old_zv. */
2117 if (point
< XFASTINT (old_begv
))
2118 XFASTINT (old_begv
) += nchars
;
2119 if (point
<= XFASTINT (old_zv
))
2120 XFASTINT (old_zv
) += nchars
;
2122 /* Insert before markers in case we are inserting where
2123 the buffer's mark is, and the user's next command is Meta-y. */
2124 insert_before_markers (chars
, nchars
);
2125 Fset_marker (p
->mark
, make_number (point
), p
->buffer
);
2127 update_mode_lines
++;
2129 /* If the restriction isn't what it should be, set it. */
2130 if (XFASTINT (old_begv
) != BEGV
|| XFASTINT (old_zv
) != ZV
)
2131 Fnarrow_to_region (old_begv
, old_zv
);
2133 current_buffer
->read_only
= old_read_only
;
2135 set_buffer_internal (old
);
2138 start_vms_process_read (vs
);
2143 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
2145 "Returns non-NIL if emacs is waiting for input from the user.\n\
2146 This is intended for use by asynchronous process output filters and sentinels.")
2149 return ((waiting_for_user_input_p
) ? Qt
: Qnil
);
2152 /* Sending data to subprocess */
2154 jmp_buf send_process_frame
;
2157 send_process_trap ()
2163 longjmp (send_process_frame
, 1);
2166 send_process (proc
, buf
, len
)
2171 /* Don't use register vars; longjmp can lose them. */
2173 unsigned char *procname
= XSTRING (XPROCESS (proc
)->name
)->data
;
2177 struct Lisp_Process
*p
= XPROCESS (proc
);
2178 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
2181 if (! NILP (XPROCESS (proc
)->raw_status_low
))
2182 update_status (XPROCESS (proc
));
2183 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
2184 error ("Process %s not running", procname
);
2187 vs
= get_vms_process_pointer (p
->pid
);
2189 error ("Could not find this process: %x", p
->pid
);
2190 else if (write_to_vms_process (vs
, buf
, len
))
2193 if (!setjmp (send_process_frame
))
2197 SIGTYPE (*old_sigpipe
)();
2199 /* Don't send more than 500 bytes at a time. */
2202 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
2203 rv
= write (XFASTINT (XPROCESS (proc
)->outfd
), buf
, this);
2204 signal (SIGPIPE
, old_sigpipe
);
2209 || errno
== EWOULDBLOCK
2216 /* It would be nice to accept process output here,
2217 but that is difficult. For example, it could
2218 garbage what we are sending if that is from a buffer. */
2225 report_file_error ("writing to process", Fcons (proc
, Qnil
));
2229 /* Allow input from processes between bursts of sending.
2230 Otherwise things may get stopped up. */
2235 XFASTINT (zero
) = 0;
2236 wait_reading_process_input (-1, 0, zero
, 0);
2242 XPROCESS (proc
)->raw_status_low
= Qnil
;
2243 XPROCESS (proc
)->raw_status_high
= Qnil
;
2244 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
2245 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
2246 deactivate_process (proc
);
2248 error ("Error writing to process %s; closed it", procname
);
2250 error ("SIGPIPE raised on process %s; closed it", procname
);
2255 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
2257 "Send current contents of region as input to PROCESS.\n\
2258 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2259 nil, indicating the current buffer's process.\n\
2260 Called from program, takes three arguments, PROCESS, START and END.\n\
2261 If the region is more than 500 characters long,\n\
2262 it is sent in several bunches. This may happen even for shorter regions.\n\
2263 Output from processes can arrive in between bunches.")
2264 (process
, start
, end
)
2265 Lisp_Object process
, start
, end
;
2270 proc
= get_process (process
);
2271 validate_region (&start
, &end
);
2273 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
2276 start1
= XINT (start
);
2277 send_process (proc
, &FETCH_CHAR (start1
), XINT (end
) - XINT (start
));
2282 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
2284 "Send PROCESS the contents of STRING as input.\n\
2285 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2286 nil, indicating the current buffer's process.\n\
2287 If STRING is more than 500 characters long,\n\
2288 it is sent in several bunches. This may happen even for shorter strings.\n\
2289 Output from processes can arrive in between bunches.")
2291 Lisp_Object process
, string
;
2294 CHECK_STRING (string
, 1);
2295 proc
= get_process (process
);
2296 send_process (proc
, XSTRING (string
)->data
, XSTRING (string
)->size
);
2300 /* send a signal number SIGNO to PROCESS.
2301 CURRENT_GROUP means send to the process group that currently owns
2302 the terminal being used to communicate with PROCESS.
2303 This is used for various commands in shell mode.
2304 If NOMSG is zero, insert signal-announcements into process's buffers
2307 If we can, we try to signal PROCESS by sending control characters
2308 down the pipe. This allows us to signal inferiors who have changed
2309 their uid, for which killpg would return an EPERM error. */
2312 process_send_signal (process
, signo
, current_group
, nomsg
)
2313 Lisp_Object process
;
2315 Lisp_Object current_group
;
2319 register struct Lisp_Process
*p
;
2323 proc
= get_process (process
);
2324 p
= XPROCESS (proc
);
2326 if (!EQ (p
->childp
, Qt
))
2327 error ("Process %s is not a subprocess",
2328 XSTRING (p
->name
)->data
);
2329 if (!XFASTINT (p
->infd
))
2330 error ("Process %s is not active",
2331 XSTRING (p
->name
)->data
);
2333 if (NILP (p
->pty_flag
))
2334 current_group
= Qnil
;
2336 /* If we are using pgrps, get a pgrp number and make it negative. */
2337 if (!NILP (current_group
))
2339 #ifdef SIGNALS_VIA_CHARACTERS
2340 /* If possible, send signals to the entire pgrp
2341 by sending an input character to it. */
2343 /* TERMIOS is the latest and bestest, and seems most likely to
2344 work. If the system has it, use it. */
2351 tcgetattr (XFASTINT (p
->infd
), &t
);
2352 send_process (proc
, &t
.c_cc
[VINTR
], 1);
2356 tcgetattr (XFASTINT (p
->infd
), &t
);
2357 send_process (proc
, &t
.c_cc
[VQUIT
], 1);
2361 tcgetattr (XFASTINT (p
->infd
), &t
);
2363 send_process (proc
, &t
.c_cc
[VSWTCH
], 1);
2365 send_process (proc
, &t
.c_cc
[VSUSP
], 1);
2370 #else /* ! HAVE_TERMIOS */
2372 /* On Berkeley descendants, the following IOCTL's retrieve the
2373 current control characters. */
2374 #if defined (TIOCGLTC) && defined (TIOCGETC)
2382 ioctl (XFASTINT (p
->infd
), TIOCGETC
, &c
);
2383 send_process (proc
, &c
.t_intrc
, 1);
2386 ioctl (XFASTINT (p
->infd
), TIOCGETC
, &c
);
2387 send_process (proc
, &c
.t_quitc
, 1);
2391 ioctl (XFASTINT (p
->infd
), TIOCGLTC
, &lc
);
2392 send_process (proc
, &lc
.t_suspc
, 1);
2394 #endif /* ! defined (SIGTSTP) */
2397 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
2399 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
2406 ioctl (XFASTINT (p
->infd
), TCGETA
, &t
);
2407 send_process (proc
, &t
.c_cc
[VINTR
], 1);
2410 ioctl (XFASTINT (p
->infd
), TCGETA
, &t
);
2411 send_process (proc
, &t
.c_cc
[VQUIT
], 1);
2415 ioctl (XFASTINT (p
->infd
), TCGETA
, &t
);
2416 send_process (proc
, &t
.c_cc
[VSWTCH
], 1);
2418 #endif /* ! defined (SIGTSTP) */
2420 #else /* ! defined (TCGETA) */
2421 Your configuration files are messed up
.
2422 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
2423 you'd better be using one of the alternatives above! */
2424 #endif /* ! defined (TCGETA) */
2425 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
2426 #endif /* ! defined HAVE_TERMIOS */
2427 #endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
2430 /* Get the pgrp using the tty itself, if we have that.
2431 Otherwise, use the pty to get the pgrp.
2432 On pfa systems, saka@pfu.fujitsu.co.JP writes:
2433 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
2434 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
2435 His patch indicates that if TIOCGPGRP returns an error, then
2436 we should just assume that p->pid is also the process group id. */
2440 if (!NILP (p
->subtty
))
2441 err
= ioctl (XFASTINT (p
->subtty
), TIOCGPGRP
, &gid
);
2443 err
= ioctl (XFASTINT (p
->infd
), TIOCGPGRP
, &gid
);
2447 gid
= - XFASTINT (p
->pid
);
2448 #endif /* ! defined (pfa) */
2454 #else /* ! defined (TIOCGPGRP ) */
2455 /* Can't select pgrps on this system, so we know that
2456 the child itself heads the pgrp. */
2457 gid
= - XFASTINT (p
->pid
);
2458 #endif /* ! defined (TIOCGPGRP ) */
2461 gid
= - XFASTINT (p
->pid
);
2467 p
->raw_status_low
= Qnil
;
2468 p
->raw_status_high
= Qnil
;
2470 XSETINT (p
->tick
, ++process_tick
);
2474 #endif /* ! defined (SIGCONT) */
2477 send_process (proc
, "\003", 1); /* ^C */
2482 send_process (proc
, "\031", 1); /* ^Y */
2487 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
2490 flush_pending_output (XFASTINT (p
->infd
));
2494 /* If we don't have process groups, send the signal to the immediate
2495 subprocess. That isn't really right, but it's better than any
2496 obvious alternative. */
2499 kill (XFASTINT (p
->pid
), signo
);
2503 /* gid may be a pid, or minus a pgrp's number */
2505 if (!NILP (current_group
))
2506 ioctl (XFASTINT (p
->infd
), TIOCSIGSEND
, signo
);
2509 gid
= - XFASTINT (p
->pid
);
2512 #else /* ! defined (TIOCSIGSEND) */
2513 EMACS_KILLPG (-gid
, signo
);
2514 #endif /* ! defined (TIOCSIGSEND) */
2517 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
2518 "Interrupt process PROCESS. May be process or name of one.\n\
2519 PROCESS may be a process, a buffer, or the name of a process or buffer.\n\
2520 Nil or no arg means current buffer's process.\n\
2521 Second arg CURRENT-GROUP non-nil means send signal to\n\
2522 the current process-group of the process's controlling terminal\n\
2523 rather than to the process's own process group.\n\
2524 If the process is a shell, this means interrupt current subjob\n\
2525 rather than the shell.")
2526 (process
, current_group
)
2527 Lisp_Object process
, current_group
;
2529 process_send_signal (process
, SIGINT
, current_group
, 0);
2533 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
2534 "Kill process PROCESS. May be process or name of one.\n\
2535 See function `interrupt-process' for more details on usage.")
2536 (process
, current_group
)
2537 Lisp_Object process
, current_group
;
2539 process_send_signal (process
, SIGKILL
, current_group
, 0);
2543 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
2544 "Send QUIT signal to process PROCESS. May be process or name of one.\n\
2545 See function `interrupt-process' for more details on usage.")
2546 (process
, current_group
)
2547 Lisp_Object process
, current_group
;
2549 process_send_signal (process
, SIGQUIT
, current_group
, 0);
2553 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
2554 "Stop process PROCESS. May be process or name of one.\n\
2555 See function `interrupt-process' for more details on usage.")
2556 (process
, current_group
)
2557 Lisp_Object process
, current_group
;
2560 error ("no SIGTSTP support");
2562 process_send_signal (process
, SIGTSTP
, current_group
, 0);
2567 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
2568 "Continue process PROCESS. May be process or name of one.\n\
2569 See function `interrupt-process' for more details on usage.")
2570 (process
, current_group
)
2571 Lisp_Object process
, current_group
;
2574 process_send_signal (process
, SIGCONT
, current_group
, 0);
2576 error ("no SIGCONT support");
2581 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
2582 2, 2, "nProcess number: \nnSignal code: ",
2583 "Send the process with number PID the signal with code CODE.\n\
2584 Both PID and CODE are integers.")
2586 Lisp_Object pid
, sig
;
2588 CHECK_NUMBER (pid
, 0);
2589 CHECK_NUMBER (sig
, 1);
2590 return make_number (kill (XINT (pid
), XINT (sig
)));
2593 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
2594 "Make PROCESS see end-of-file in its input.\n\
2595 Eof comes after any text already sent to it.\n\
2596 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
2597 nil, indicating the current buffer's process.")
2599 Lisp_Object process
;
2603 proc
= get_process (process
);
2605 /* Make sure the process is really alive. */
2606 if (! NILP (XPROCESS (proc
)->raw_status_low
))
2607 update_status (XPROCESS (proc
));
2608 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
2609 error ("Process %s not running", XSTRING (XPROCESS (proc
)->name
)->data
);
2611 /* Sending a zero-length record is supposed to mean eof
2612 when TIOCREMOTE is turned on. */
2616 write (XFASTINT (XPROCESS (proc
)->outfd
), buf
, 0);
2618 #else /* did not do TOICREMOTE */
2620 send_process (proc
, "\032", 1); /* ^z */
2622 if (!NILP (XPROCESS (proc
)->pty_flag
))
2623 send_process (proc
, "\004", 1);
2626 close (XPROCESS (proc
)->outfd
);
2627 XFASTINT (XPROCESS (proc
)->outfd
) = open (NULL_DEVICE
, O_WRONLY
);
2630 #endif /* did not do TOICREMOTE */
2634 /* Kill all processes associated with `buffer'.
2635 If `buffer' is nil, kill all processes */
2637 kill_buffer_processes (buffer
)
2640 Lisp_Object tail
, proc
;
2642 for (tail
= Vprocess_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2643 tail
= XCONS (tail
)->cdr
)
2645 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
2646 if (XGCTYPE (proc
) == Lisp_Process
2647 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
2649 if (NETCONN_P (proc
))
2650 deactivate_process (proc
);
2651 else if (XFASTINT (XPROCESS (proc
)->infd
))
2652 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
2657 /* On receipt of a signal that a child status has changed,
2658 loop asking about children with changed statuses until
2659 the system says there are no more.
2660 All we do is change the status;
2661 we do not run sentinels or print notifications.
2662 That is saved for the next time keyboard input is done,
2663 in order to avoid timing errors. */
2665 /** WARNING: this can be called during garbage collection.
2666 Therefore, it must not be fooled by the presence of mark bits in
2669 /** USG WARNING: Although it is not obvious from the documentation
2670 in signal(2), on a USG system the SIGCLD handler MUST NOT call
2671 signal() before executing at least one wait(), otherwise the handler
2672 will be called again, resulting in an infinite loop. The relevant
2673 portion of the documentation reads "SIGCLD signals will be queued
2674 and the signal-catching function will be continually reentered until
2675 the queue is empty". Invoking signal() causes the kernel to reexamine
2676 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
2679 sigchld_handler (signo
)
2682 int old_errno
= errno
;
2684 register struct Lisp_Process
*p
;
2685 extern EMACS_TIME
*input_available_clear_time
;
2689 sigheld
|= sigbit (SIGCHLD
);
2701 #endif /* no WUNTRACED */
2702 /* Keep trying to get a status until we get a definitive result. */
2706 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
2708 while (pid
<= 0 && errno
== EINTR
);
2712 /* A real failure. We have done all our job, so return. */
2714 /* USG systems forget handlers when they are used;
2715 must reestablish each time */
2717 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
2720 sigheld
&= ~sigbit (SIGCHLD
);
2728 #endif /* no WNOHANG */
2730 /* Find the process that signaled us, and record its status. */
2733 for (tail
= Vprocess_alist
; XSYMBOL (tail
) != XSYMBOL (Qnil
); tail
= XCONS (tail
)->cdr
)
2735 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
2736 p
= XPROCESS (proc
);
2737 if (EQ (p
->childp
, Qt
) && XFASTINT (p
->pid
) == pid
)
2742 /* Look for an asynchronous process whose pid hasn't been filled
2745 for (tail
= Vprocess_alist
; XSYMBOL (tail
) != XSYMBOL (Qnil
); tail
= XCONS (tail
)->cdr
)
2747 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
2748 p
= XPROCESS (proc
);
2749 if (XTYPE (p
->pid
) == Lisp_Int
&& XINT (p
->pid
) == -1)
2754 /* Change the status of the process that was found. */
2757 union { int i
; WAITTYPE wt
; } u
;
2759 XSETINT (p
->tick
, ++process_tick
);
2761 XFASTINT (p
->raw_status_low
) = u
.i
& 0xffff;
2762 XFASTINT (p
->raw_status_high
) = u
.i
>> 16;
2764 /* If process has terminated, stop waiting for its output. */
2765 if (WIFSIGNALED (w
) || WIFEXITED (w
))
2766 if (XFASTINT (p
->infd
))
2767 FD_CLR (XFASTINT (p
->infd
), &input_wait_mask
);
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 /* There was no asynchronous process found for that id. Check
2776 if we have a synchronous process. */
2779 synch_process_alive
= 0;
2781 /* Report the status of the synchronous process. */
2783 synch_process_retcode
= WRETCODE (w
);
2784 else if (WIFSIGNALED (w
))
2786 synch_process_death
= sys_siglist
[WTERMSIG (w
)];
2788 synch_process_death
= sys_errlist
[WTERMSIG (w
)];
2791 /* Tell wait_reading_process_input that it needs to wake up and
2793 if (input_available_clear_time
)
2794 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
2797 /* On some systems, we must return right away.
2798 If any more processes want to signal us, we will
2800 Otherwise (on systems that have WNOHANG), loop around
2801 to use up all the processes that have something to tell us. */
2802 #if defined (USG) && ! (defined (HPUX) && defined (WNOHANG))
2804 signal (signo
, sigchld_handler
);
2808 #endif /* USG, but not HPUX with WNOHANG */
2814 exec_sentinel_unwind (data
)
2817 XPROCESS (XCONS (data
)->car
)->sentinel
= XCONS (data
)->cdr
;
2822 exec_sentinel (proc
, reason
)
2823 Lisp_Object proc
, reason
;
2825 Lisp_Object sentinel
;
2826 register struct Lisp_Process
*p
= XPROCESS (proc
);
2827 int count
= specpdl_ptr
- specpdl
;
2829 sentinel
= p
->sentinel
;
2830 if (NILP (sentinel
))
2833 /* Zilch the sentinel while it's running, to avoid recursive invocations;
2834 assure that it gets restored no matter how the sentinel exits. */
2836 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
2837 /* Inhibit quit so that random quits don't screw up a running filter. */
2838 specbind (Qinhibit_quit
, Qt
);
2839 call2 (sentinel
, proc
, reason
);
2843 /* Report all recent events of a change in process status
2844 (either run the sentinel or output a message).
2845 This is done while Emacs is waiting for keyboard input. */
2849 register Lisp_Object proc
, buffer
;
2850 Lisp_Object tail
= Qnil
;
2851 Lisp_Object msg
= Qnil
;
2852 struct gcpro gcpro1
, gcpro2
;
2854 /* We need to gcpro tail; if read_process_output calls a filter
2855 which deletes a process and removes the cons to which tail points
2856 from Vprocess_alist, and then causes a GC, tail is an unprotected
2860 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
2863 register struct Lisp_Process
*p
;
2865 proc
= Fcdr (Fcar (tail
));
2866 p
= XPROCESS (proc
);
2868 if (XINT (p
->tick
) != XINT (p
->update_tick
))
2870 XSETINT (p
->update_tick
, XINT (p
->tick
));
2872 /* If process is still active, read any output that remains. */
2873 if (XFASTINT (p
->infd
))
2874 while (read_process_output (proc
, XFASTINT (p
->infd
)) > 0);
2878 /* Get the text to use for the message. */
2879 if (!NILP (p
->raw_status_low
))
2881 msg
= status_message (p
->status
);
2883 /* If process is terminated, deactivate it or delete it. */
2885 if (XTYPE (p
->status
) == Lisp_Cons
)
2886 symbol
= XCONS (p
->status
)->car
;
2888 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
2889 || EQ (symbol
, Qclosed
))
2891 if (delete_exited_processes
)
2892 remove_process (proc
);
2894 deactivate_process (proc
);
2897 /* Now output the message suitably. */
2898 if (!NILP (p
->sentinel
))
2899 exec_sentinel (proc
, msg
);
2900 /* Don't bother with a message in the buffer
2901 when a process becomes runnable. */
2902 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
2904 Lisp_Object ro
= XBUFFER (buffer
)->read_only
;
2906 struct buffer
*old
= current_buffer
;
2909 /* Avoid error if buffer is deleted
2910 (probably that's why the process is dead, too) */
2911 if (NILP (XBUFFER (buffer
)->name
))
2913 Fset_buffer (buffer
);
2915 /* Insert new output into buffer
2916 at the current end-of-output marker,
2917 thus preserving logical ordering of input and output. */
2918 if (XMARKER (p
->mark
)->buffer
)
2919 SET_PT (marker_position (p
->mark
));
2922 if (point
<= opoint
)
2923 opoint
+= XSTRING (msg
)->size
+ XSTRING (p
->name
)->size
+ 10;
2925 tem
= current_buffer
->read_only
;
2926 current_buffer
->read_only
= Qnil
;
2927 insert_string ("\nProcess ");
2928 Finsert (1, &p
->name
);
2929 insert_string (" ");
2931 current_buffer
->read_only
= tem
;
2932 Fset_marker (p
->mark
, make_number (point
), p
->buffer
);
2935 set_buffer_internal (old
);
2940 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
2941 redisplay_preserve_echo_area ();
2943 update_tick
= process_tick
;
2954 if (! noninteractive
|| initialized
)
2956 signal (SIGCHLD
, sigchld_handler
);
2959 FD_ZERO (&input_wait_mask
);
2960 FD_SET (0, &input_wait_mask
);
2961 Vprocess_alist
= Qnil
;
2962 for (i
= 0; i
< MAXDESC
; i
++)
2964 chan_process
[i
] = Qnil
;
2965 proc_buffered_char
[i
] = -1;
2969 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 0, 1, 0,
2970 "Return the connection type of `PROCESS'. This can be nil (pipe),\n\
2971 t or pty (pty) or stream (socket connection).")
2973 Lisp_Object process
;
2975 return XPROCESS (process
)->type
;
2981 stream_process
= intern ("stream");
2983 Qprocessp
= intern ("processp");
2984 staticpro (&Qprocessp
);
2985 Qrun
= intern ("run");
2987 Qstop
= intern ("stop");
2989 Qsignal
= intern ("signal");
2990 staticpro (&Qsignal
);
2992 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
2995 Qexit = intern ("exit");
2996 staticpro (&Qexit); */
2998 Qopen
= intern ("open");
3000 Qclosed
= intern ("closed");
3001 staticpro (&Qclosed
);
3003 staticpro (&Vprocess_alist
);
3005 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
3006 "*Non-nil means delete processes immediately when they exit.\n\
3007 nil means don't delete them until `list-processes' is run.");
3009 delete_exited_processes
= 1;
3011 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
3012 "Control type of device used to communicate with subprocesses.\n\
3013 Values are nil to use a pipe, and t or 'pty for a pty. Note that if\n\
3014 pty's are not available, this variable will be ignored. The value takes\n\
3015 effect when `start-process' is called.");
3016 Vprocess_connection_type
= Qt
;
3018 defsubr (&Sprocessp
);
3019 defsubr (&Sget_process
);
3020 defsubr (&Sget_buffer_process
);
3021 defsubr (&Sdelete_process
);
3022 defsubr (&Sprocess_status
);
3023 defsubr (&Sprocess_exit_status
);
3024 defsubr (&Sprocess_id
);
3025 defsubr (&Sprocess_name
);
3026 defsubr (&Sprocess_command
);
3027 defsubr (&Sset_process_buffer
);
3028 defsubr (&Sprocess_buffer
);
3029 defsubr (&Sprocess_mark
);
3030 defsubr (&Sset_process_filter
);
3031 defsubr (&Sprocess_filter
);
3032 defsubr (&Sset_process_sentinel
);
3033 defsubr (&Sprocess_sentinel
);
3034 defsubr (&Sprocess_kill_without_query
);
3035 defsubr (&Slist_processes
);
3036 defsubr (&Sprocess_list
);
3037 defsubr (&Sstart_process
);
3039 defsubr (&Sopen_network_stream
);
3040 #endif /* HAVE_SOCKETS */
3041 defsubr (&Saccept_process_output
);
3042 defsubr (&Sprocess_send_region
);
3043 defsubr (&Sprocess_send_string
);
3044 defsubr (&Sinterrupt_process
);
3045 defsubr (&Skill_process
);
3046 defsubr (&Squit_process
);
3047 defsubr (&Sstop_process
);
3048 defsubr (&Scontinue_process
);
3049 defsubr (&Sprocess_send_eof
);
3050 defsubr (&Ssignal_process
);
3051 defsubr (&Swaiting_for_user_input_p
);
3052 /* defsubr (&Sprocess_connection); */
3056 #else /* not subprocesses */
3058 #include <sys/types.h>
3062 #include "systime.h"
3063 #include "termopts.h"
3065 extern int frame_garbaged
;
3068 /* As described above, except assuming that there are no subprocesses:
3070 Wait for timeout to elapse and/or keyboard input to be available.
3073 timeout in seconds, or
3074 zero for no limit, or
3075 -1 means gobble data immediately available but don't wait for any.
3077 read_kbd is a Lisp_Object:
3078 0 to ignore keyboard input, or
3079 1 to return when input is available, or
3080 -1 means caller will actually read the input, so don't throw to
3082 We know that read_kbd will never be a Lisp_Process, since
3083 `subprocesses' isn't defined.
3085 do_display != 0 means redisplay should be done to show subprocess
3086 output that arrives. This version of the function ignores it.
3088 Return true iff we recieved input from any process. */
3091 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
3092 int time_limit
, microsecs
;
3093 Lisp_Object read_kbd
;
3096 EMACS_TIME end_time
, timeout
, *timeout_p
;
3099 /* What does time_limit really mean? */
3100 if (time_limit
|| microsecs
)
3102 /* It's not infinite. */
3103 timeout_p
= &timeout
;
3105 if (time_limit
== -1)
3106 /* In fact, it's zero. */
3107 EMACS_SET_SECS_USECS (timeout
, 0, 0);
3109 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
3111 /* How far in the future is that? */
3112 EMACS_GET_TIME (end_time
);
3113 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
3116 /* It's infinite. */
3119 /* Turn off periodic alarms (in case they are in use)
3120 because the select emulator uses alarms. */
3127 waitchannels
= XINT (read_kbd
) ? 1 : 0;
3129 /* If calling from keyboard input, do not quit
3130 since we want to return C-g as an input character.
3131 Otherwise, do pending quit if requested. */
3132 if (XINT (read_kbd
) >= 0)
3137 EMACS_GET_TIME (*timeout_p
);
3138 EMACS_SUB_TIME (*timeout_p
, end_time
, *timeout_p
);
3139 if (EMACS_TIME_NEG_P (*timeout_p
))
3143 /* Cause C-g and alarm signals to take immediate action,
3144 and cause input available signals to zero out timeout. */
3145 if (XINT (read_kbd
) < 0)
3146 set_waiting_for_input (&timeout
);
3148 /* If a frame has been newly mapped and needs updating,
3149 reprocess its display stuff. */
3151 redisplay_preserve_echo_area ();
3153 if (XINT (read_kbd
) && detect_input_pending ())
3156 nfds
= select (1, &waitchannels
, 0, 0, timeout_p
);
3158 /* Make C-g and alarm signals set flags again */
3159 clear_waiting_for_input ();
3161 /* If we woke up due to SIGWINCH, actually change size now. */
3162 do_pending_window_change ();
3166 /* If the system call was interrupted, then go around the
3172 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
3173 /* System sometimes fails to deliver SIGIO. */
3174 kill (getpid (), SIGIO
);
3176 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
3179 /* If we have timed out (nfds == 0) or found some input (nfds > 0),
3191 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
3192 "Return the (or, a) process associated with BUFFER.\n\
3193 This copy of Emacs has not been built to support subprocesses, so this\n\
3194 function always returns nil.")
3196 register Lisp_Object name
;
3201 /* Kill all processes associated with `buffer'.
3202 If `buffer' is nil, kill all processes.
3203 Since we have no subprocesses, this does nothing. */
3205 kill_buffer_processes (buffer
)
3216 defsubr (&Sget_buffer_process
);
3220 #endif /* not subprocesses */