1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 1996
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
27 /* This file is split into two parts by the following preprocessor
28 conditional. The 'then' clause contains all of the support for
29 asynchronous subprocesses. The 'else' clause contains stub
30 versions of some of the asynchronous subprocess routines that are
31 often called elsewhere in Emacs, so we don't have to #ifdef the
32 sections that call them. */
40 #include <sys/types.h> /* some typedefs are used in sys/file.h */
50 #endif /* not WINDOWSNT */
52 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
53 #include <sys/socket.h>
55 #include <netinet/in.h>
56 #include <arpa/inet.h>
57 #ifdef NEED_NET_ERRNO_H
58 #include <net/errno.h>
59 #endif /* NEED_NET_ERRNO_H */
60 #endif /* HAVE_SOCKETS */
62 /* TERM is a poor-man's SLIP, used on Linux. */
67 /* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */
68 #ifdef HAVE_BROKEN_INET_ADDR
69 #define IN_ADDR struct in_addr
70 #define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
72 #define IN_ADDR unsigned long
73 #define NUMERIC_ADDR_ERROR (numeric_addr == -1)
76 #if defined(BSD_SYSTEM) || defined(STRIDE)
77 #include <sys/ioctl.h>
78 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
80 #endif /* HAVE_PTYS and no O_NDELAY */
81 #endif /* BSD_SYSTEM || STRIDE */
83 #ifdef BROKEN_O_NONBLOCK
85 #endif /* BROKEN_O_NONBLOCK */
92 #include <sys/sysmacros.h> /* for "minor" */
104 #include "termhooks.h"
105 #include "termopts.h"
106 #include "commands.h"
108 #include "blockinput.h"
110 Lisp_Object Qprocessp
;
111 Lisp_Object Qrun
, Qstop
, Qsignal
, Qopen
, Qclosed
;
112 Lisp_Object Qlast_nonmenu_event
;
113 /* Qexit is declared and initialized in eval.c. */
115 /* a process object is a network connection when its childp field is neither
116 Qt nor Qnil but is instead a cons cell (HOSTNAME PORTNUM). */
119 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
121 #define NETCONN_P(p) 0
122 #endif /* HAVE_SOCKETS */
124 /* Define first descriptor number available for subprocesses. */
126 #define FIRST_PROC_DESC 1
128 #define FIRST_PROC_DESC 3
131 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
134 #if !defined (SIGCHLD) && defined (SIGCLD)
135 #define SIGCHLD SIGCLD
138 #include "syssignal.h"
143 extern char *strerror ();
145 extern char *sys_errlist
[];
152 #ifndef SYS_SIGLIST_DECLARED
157 extern char *sys_siglist
[];
158 #endif /* not LINUX */
160 char *sys_siglist
[] =
166 "illegal instruction",
170 "floating point exception",
173 "segmentation violation",
174 "bad argument to system call",
175 "write on a pipe with no one to read it",
177 "software termination signal from kill",
179 "sendable stop signal not from tty",
180 "stop signal from tty",
181 "continue a stopped process",
182 "child status has changed",
183 "background read attempted from control tty",
184 "background write attempted from control tty",
185 "input record available at control tty",
186 "exceeded CPU time limit",
187 "exceeded file size limit"
189 #endif /* not WINDOWSNT */
192 #endif /* ! SYS_SIGLIST_DECLARED */
194 /* t means use pty, nil means use a pipe,
195 maybe other values to come. */
196 static Lisp_Object Vprocess_connection_type
;
200 #include <sys/socket.h>
204 /* These next two vars are non-static since sysdep.c uses them in the
205 emulation of `select'. */
206 /* Number of events of change of status of a process. */
208 /* Number of events for which the user or sentinel has been notified. */
211 #include "sysselect.h"
213 /* If we support a window system, turn on the code to poll periodically
214 to detect C-g. It isn't actually used when doing interrupt input. */
215 #ifdef HAVE_WINDOW_SYSTEM
216 #define POLL_FOR_INPUT
219 /* Mask of bits indicating the descriptors that we wait for input on. */
221 static SELECT_TYPE input_wait_mask
;
223 /* Mask that excludes keyboard input descriptor (s). */
225 static SELECT_TYPE non_keyboard_wait_mask
;
227 /* The largest descriptor currently in use for a process object. */
228 static int max_process_desc
;
230 /* The largest descriptor currently in use for keyboard input. */
231 static int max_keyboard_desc
;
233 /* Nonzero means delete a process right away if it exits. */
234 static int delete_exited_processes
;
236 /* Indexed by descriptor, gives the process (if any) for that descriptor */
237 Lisp_Object chan_process
[MAXDESC
];
239 /* Alist of elements (NAME . PROCESS) */
240 Lisp_Object Vprocess_alist
;
242 /* Buffered-ahead input char from process, indexed by channel.
243 -1 means empty (no char is buffered).
244 Used on sys V where the only way to tell if there is any
245 output from the process is to read at least one char.
246 Always -1 on systems that support FIONREAD. */
248 /* Don't make static; need to access externally. */
249 int proc_buffered_char
[MAXDESC
];
251 /* Table of `struct coding-system' for each process. */
252 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
253 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
255 static Lisp_Object
get_process ();
257 extern EMACS_TIME
timer_check ();
258 extern int timers_run
;
260 /* Maximum number of bytes to send to a pty without an eof. */
261 static int pty_max_bytes
;
264 /* The file name of the pty opened by allocate_pty. */
266 static char pty_name
[24];
269 /* Compute the Lisp form of the process status, p->status, from
270 the numeric status that was returned by `wait'. */
272 Lisp_Object
status_convert ();
275 struct Lisp_Process
*p
;
277 union { int i
; WAITTYPE wt
; } u
;
278 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
279 p
->status
= status_convert (u
.wt
);
280 p
->raw_status_low
= Qnil
;
281 p
->raw_status_high
= Qnil
;
284 /* Convert a process status word in Unix format to
285 the list that we use internally. */
292 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
293 else if (WIFEXITED (w
))
294 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
295 WCOREDUMP (w
) ? Qt
: Qnil
));
296 else if (WIFSIGNALED (w
))
297 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
298 WCOREDUMP (w
) ? Qt
: Qnil
));
303 /* Given a status-list, extract the three pieces of information
304 and store them individually through the three pointers. */
307 decode_status (l
, symbol
, code
, coredump
)
323 *symbol
= XCONS (l
)->car
;
324 tem
= XCONS (l
)->cdr
;
325 *code
= XFASTINT (XCONS (tem
)->car
);
326 tem
= XCONS (tem
)->cdr
;
327 *coredump
= !NILP (tem
);
331 /* Return a string describing a process status list. */
334 status_message (status
)
339 Lisp_Object string
, string2
;
341 decode_status (status
, &symbol
, &code
, &coredump
);
343 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
349 /* Cast to suppress warning if the table has const char *. */
350 signame
= (char *) sys_siglist
[code
];
352 signame
= sys_errlist
[code
];
357 string
= build_string (signame
);
358 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
359 XSTRING (string
)->data
[0] = DOWNCASE (XSTRING (string
)->data
[0]);
360 return concat2 (string
, string2
);
362 else if (EQ (symbol
, Qexit
))
365 return build_string ("finished\n");
366 string
= Fnumber_to_string (make_number (code
));
367 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
368 return concat2 (build_string ("exited abnormally with code "),
369 concat2 (string
, string2
));
372 return Fcopy_sequence (Fsymbol_name (symbol
));
377 /* Open an available pty, returning a file descriptor.
378 Return -1 on failure.
379 The file name of the terminal corresponding to the pty
380 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 struct Lisp_Vector
*vec
;
469 register Lisp_Object val
, tem
, name1
;
470 register struct Lisp_Process
*p
;
474 vec
= allocate_vectorlike ((EMACS_INT
) VECSIZE (struct Lisp_Process
));
475 for (i
= 0; i
< VECSIZE (struct Lisp_Process
); i
++)
476 vec
->contents
[i
] = Qnil
;
477 vec
->size
= VECSIZE (struct Lisp_Process
);
478 p
= (struct Lisp_Process
*)vec
;
480 XSETINT (p
->infd
, -1);
481 XSETINT (p
->outfd
, -1);
482 XSETFASTINT (p
->pid
, 0);
483 XSETFASTINT (p
->tick
, 0);
484 XSETFASTINT (p
->update_tick
, 0);
485 p
->raw_status_low
= Qnil
;
486 p
->raw_status_high
= Qnil
;
488 p
->mark
= Fmake_marker ();
490 /* If name is already in use, modify it until it is unused. */
495 tem
= Fget_process (name1
);
496 if (NILP (tem
)) break;
497 sprintf (suffix
, "<%d>", i
);
498 name1
= concat2 (name
, build_string (suffix
));
502 XSETPROCESS (val
, p
);
503 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
507 remove_process (proc
)
508 register Lisp_Object proc
;
510 register Lisp_Object pair
;
512 pair
= Frassq (proc
, Vprocess_alist
);
513 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
515 deactivate_process (proc
);
518 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
519 "Return t if OBJECT is a process.")
523 return PROCESSP (object
) ? Qt
: Qnil
;
526 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
527 "Return the process named NAME, or nil if there is none.")
529 register Lisp_Object name
;
533 CHECK_STRING (name
, 0);
534 return Fcdr (Fassoc (name
, Vprocess_alist
));
537 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
538 "Return the (or, a) process associated with BUFFER.\n\
539 BUFFER may be a buffer or the name of one.")
541 register Lisp_Object buffer
;
543 register Lisp_Object buf
, tail
, proc
;
545 if (NILP (buffer
)) return Qnil
;
546 buf
= Fget_buffer (buffer
);
547 if (NILP (buf
)) return Qnil
;
549 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
551 proc
= Fcdr (Fcar (tail
));
552 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
558 /* This is how commands for the user decode process arguments. It
559 accepts a process, a process name, a buffer, a buffer name, or nil.
560 Buffers denote the first process in the buffer, and nil denotes the
565 register Lisp_Object name
;
567 register Lisp_Object proc
, obj
;
570 obj
= Fget_process (name
);
572 obj
= Fget_buffer (name
);
574 error ("Process %s does not exist", XSTRING (name
)->data
);
576 else if (NILP (name
))
577 obj
= Fcurrent_buffer ();
581 /* Now obj should be either a buffer object or a process object.
585 proc
= Fget_buffer_process (obj
);
587 error ("Buffer %s has no process", XSTRING (XBUFFER (obj
)->name
)->data
);
591 CHECK_PROCESS (obj
, 0);
597 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
598 "Delete PROCESS: kill it and forget about it immediately.\n\
599 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
600 nil, indicating the current buffer's process.")
602 register Lisp_Object process
;
604 process
= get_process (process
);
605 XPROCESS (process
)->raw_status_low
= Qnil
;
606 XPROCESS (process
)->raw_status_high
= Qnil
;
607 if (NETCONN_P (process
))
609 XPROCESS (process
)->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
610 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
612 else if (XINT (XPROCESS (process
)->infd
) >= 0)
614 Fkill_process (process
, Qnil
);
615 /* Do this now, since remove_process will make sigchld_handler do nothing. */
616 XPROCESS (process
)->status
617 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
618 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
621 remove_process (process
);
625 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
626 "Return the status of PROCESS: a symbol, one of these:\n\
627 run -- for a process that is running.\n\
628 stop -- for a process stopped but continuable.\n\
629 exit -- for a process that has exited.\n\
630 signal -- for a process that has got a fatal signal.\n\
631 open -- for a network stream connection that is open.\n\
632 closed -- for a network stream connection that is closed.\n\
633 nil -- if arg is a process name and no such process exists.\n\
634 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
635 nil, indicating the current buffer's process.")
637 register Lisp_Object process
;
639 register struct Lisp_Process
*p
;
640 register Lisp_Object status
;
642 if (STRINGP (process
))
643 process
= Fget_process (process
);
645 process
= get_process (process
);
650 p
= XPROCESS (process
);
651 if (!NILP (p
->raw_status_low
))
655 status
= XCONS (status
)->car
;
656 if (NETCONN_P (process
))
658 if (EQ (status
, Qrun
))
660 else if (EQ (status
, Qexit
))
666 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
668 "Return the exit status of PROCESS or the signal number that killed it.\n\
669 If PROCESS has not yet exited or died, return 0.")
671 register Lisp_Object process
;
673 CHECK_PROCESS (process
, 0);
674 if (!NILP (XPROCESS (process
)->raw_status_low
))
675 update_status (XPROCESS (process
));
676 if (CONSP (XPROCESS (process
)->status
))
677 return XCONS (XCONS (XPROCESS (process
)->status
)->cdr
)->car
;
678 return make_number (0);
681 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
682 "Return the process id of PROCESS.\n\
683 This is the pid of the Unix process which PROCESS uses or talks to.\n\
684 For a network connection, this value is nil.")
686 register Lisp_Object process
;
688 CHECK_PROCESS (process
, 0);
689 return XPROCESS (process
)->pid
;
692 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
693 "Return the name of PROCESS, as a string.\n\
694 This is the name of the program invoked in PROCESS,\n\
695 possibly modified to make it unique among process names.")
697 register Lisp_Object process
;
699 CHECK_PROCESS (process
, 0);
700 return XPROCESS (process
)->name
;
703 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
704 "Return the command that was executed to start PROCESS.\n\
705 This is a list of strings, the first string being the program executed\n\
706 and the rest of the strings being the arguments given to it.\n\
707 For a non-child channel, this is nil.")
709 register Lisp_Object process
;
711 CHECK_PROCESS (process
, 0);
712 return XPROCESS (process
)->command
;
715 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
716 "Return the name of the terminal PROCESS uses, or nil if none.\n\
717 This is the terminal that the process itself reads and writes on,\n\
718 not the name of the pty that Emacs uses to talk with that terminal.")
720 register Lisp_Object process
;
722 CHECK_PROCESS (process
, 0);
723 return XPROCESS (process
)->tty_name
;
726 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
728 "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
730 register Lisp_Object process
, buffer
;
732 CHECK_PROCESS (process
, 0);
734 CHECK_BUFFER (buffer
, 1);
735 XPROCESS (process
)->buffer
= buffer
;
739 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
741 "Return the buffer PROCESS is associated with.\n\
742 Output from PROCESS is inserted in this buffer\n\
743 unless PROCESS has a filter.")
745 register Lisp_Object process
;
747 CHECK_PROCESS (process
, 0);
748 return XPROCESS (process
)->buffer
;
751 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
753 "Return the marker for the end of the last output from PROCESS.")
755 register Lisp_Object process
;
757 CHECK_PROCESS (process
, 0);
758 return XPROCESS (process
)->mark
;
761 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
763 "Give PROCESS the filter function FILTER; nil means no filter.\n\
764 t means stop accepting output from the process.\n\
765 When a process has a filter, each time it does output\n\
766 the entire string of output is passed to the filter.\n\
767 The filter gets two arguments: the process and the string of output.\n\
768 If the process has a filter, its buffer is not used for output.")
770 register Lisp_Object process
, filter
;
772 CHECK_PROCESS (process
, 0);
775 FD_CLR (XINT (XPROCESS (process
)->infd
), &input_wait_mask
);
776 FD_CLR (XINT (XPROCESS (process
)->infd
), &non_keyboard_wait_mask
);
778 else if (EQ (XPROCESS (process
)->filter
, Qt
))
780 FD_SET (XINT (XPROCESS (process
)->infd
), &input_wait_mask
);
781 FD_SET (XINT (XPROCESS (process
)->infd
), &non_keyboard_wait_mask
);
783 XPROCESS (process
)->filter
= filter
;
787 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
789 "Returns the filter function of PROCESS; nil if none.\n\
790 See `set-process-filter' for more info on filter functions.")
792 register Lisp_Object process
;
794 CHECK_PROCESS (process
, 0);
795 return XPROCESS (process
)->filter
;
798 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
800 "Give PROCESS the sentinel SENTINEL; nil for none.\n\
801 The sentinel is called as a function when the process changes state.\n\
802 It gets two arguments: the process, and a string describing the change.")
804 register Lisp_Object process
, sentinel
;
806 CHECK_PROCESS (process
, 0);
807 XPROCESS (process
)->sentinel
= sentinel
;
811 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
813 "Return the sentinel of PROCESS; nil if none.\n\
814 See `set-process-sentinel' for more info on sentinels.")
816 register Lisp_Object process
;
818 CHECK_PROCESS (process
, 0);
819 return XPROCESS (process
)->sentinel
;
822 DEFUN ("set-process-window-size", Fset_process_window_size
,
823 Sset_process_window_size
, 3, 3, 0,
824 "Tell PROCESS that it has logical window size HEIGHT and WIDTH.")
825 (process
, height
, width
)
826 register Lisp_Object process
, height
, width
;
828 CHECK_PROCESS (process
, 0);
829 CHECK_NATNUM (height
, 0);
830 CHECK_NATNUM (width
, 0);
831 if (set_window_size (XINT (XPROCESS (process
)->infd
),
832 XINT (height
), XINT(width
)) <= 0)
838 DEFUN ("process-kill-without-query", Fprocess_kill_without_query
,
839 Sprocess_kill_without_query
, 1, 2, 0,
840 "Say no query needed if PROCESS is running when Emacs is exited.\n\
841 Optional second argument if non-nil says to require a query.\n\
842 Value is t if a query was formerly required.")
844 register Lisp_Object process
, value
;
848 CHECK_PROCESS (process
, 0);
849 tem
= XPROCESS (process
)->kill_without_query
;
850 XPROCESS (process
)->kill_without_query
= Fnull (value
);
855 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
857 "Return the contact info of PROCESS; t for a real child.\n\
858 For a net connection, the value is a cons cell of the form (HOST SERVICE).")
860 register Lisp_Object process
;
862 CHECK_PROCESS (process
, 0);
863 return XPROCESS (process
)->childp
;
866 #if 0 /* Turned off because we don't currently record this info
867 in the process. Perhaps add it. */
868 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
869 "Return the connection type of `PROCESS'.\n\
870 The value is `nil' for a pipe,\n\
871 `t' or `pty' for a pty, or `stream' for a socket connection.")
875 return XPROCESS (process
)->type
;
882 register Lisp_Object tail
, tem
;
883 Lisp_Object proc
, minspace
, tem1
;
884 register struct buffer
*old
= current_buffer
;
885 register struct Lisp_Process
*p
;
889 XSETFASTINT (minspace
, 1);
891 set_buffer_internal (XBUFFER (Vstandard_output
));
892 Fbuffer_disable_undo (Vstandard_output
);
894 current_buffer
->truncate_lines
= Qt
;
897 Proc Status Buffer Tty Command\n\
898 ---- ------ ------ --- -------\n", -1);
900 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
904 proc
= Fcdr (Fcar (tail
));
906 if (NILP (p
->childp
))
909 Finsert (1, &p
->name
);
910 Findent_to (make_number (13), minspace
);
912 if (!NILP (p
->raw_status_low
))
915 if (CONSP (p
->status
))
916 symbol
= XCONS (p
->status
)->car
;
919 if (EQ (symbol
, Qsignal
))
922 tem
= Fcar (Fcdr (p
->status
));
924 if (XINT (tem
) < NSIG
)
925 write_string (sys_errlist
[XINT (tem
)], -1);
928 Fprinc (symbol
, Qnil
);
930 else if (NETCONN_P (proc
))
932 if (EQ (symbol
, Qrun
))
933 write_string ("open", -1);
934 else if (EQ (symbol
, Qexit
))
935 write_string ("closed", -1);
937 Fprinc (symbol
, Qnil
);
940 Fprinc (symbol
, Qnil
);
942 if (EQ (symbol
, Qexit
))
945 tem
= Fcar (Fcdr (p
->status
));
948 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
949 write_string (tembuf
, -1);
953 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
954 remove_process (proc
);
956 Findent_to (make_number (22), minspace
);
957 if (NILP (p
->buffer
))
958 insert_string ("(none)");
959 else if (NILP (XBUFFER (p
->buffer
)->name
))
960 insert_string ("(Killed)");
962 Finsert (1, &XBUFFER (p
->buffer
)->name
);
964 Findent_to (make_number (37), minspace
);
966 if (STRINGP (p
->tty_name
))
967 Finsert (1, &p
->tty_name
);
969 insert_string ("(none)");
971 Findent_to (make_number (49), minspace
);
973 if (NETCONN_P (proc
))
975 sprintf (tembuf
, "(network stream connection to %s)\n",
976 XSTRING (XCONS (p
->childp
)->car
)->data
);
977 insert_string (tembuf
);
991 insert_string ("\n");
997 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 0, "",
998 "Display a list of all processes.\n\
999 \(Any processes listed as Exited or Signaled are actually eliminated\n\
1000 after the listing is made.)")
1003 internal_with_output_to_temp_buffer ("*Process List*",
1004 list_processes_1
, Qnil
);
1008 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1009 "Return a list of all processes.")
1012 return Fmapcar (Qcdr
, Vprocess_alist
);
1015 /* Starting asynchronous inferior processes. */
1017 static Lisp_Object
start_process_unwind ();
1019 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1020 "Start a program in a subprocess. Return the process object for it.\n\
1021 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
1022 NAME is name for process. It is modified if necessary to make it unique.\n\
1023 BUFFER is the buffer or (buffer-name) to associate with the process.\n\
1024 Process output goes at end of that buffer, unless you specify\n\
1025 an output stream or filter function to handle the output.\n\
1026 BUFFER may be also nil, meaning that this process is not associated\n\
1028 Third arg is program file name. It is searched for as in the shell.\n\
1029 Remaining arguments are strings to give program as arguments.")
1032 register Lisp_Object
*args
;
1034 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1036 register unsigned char *new_argv
;
1039 register unsigned char **new_argv
;
1042 int count
= specpdl_ptr
- specpdl
;
1046 buffer
= Fget_buffer_create (buffer
);
1048 /* Make sure that the child will be able to chdir to the current
1049 buffer's current directory, or its unhandled equivalent. We
1050 can't just have the child check for an error when it does the
1051 chdir, since it's in a vfork.
1053 We have to GCPRO around this because Fexpand_file_name and
1054 Funhandled_file_name_directory might call a file name handling
1055 function. The argument list is protected by the caller, so all
1056 we really have to worry about is buffer. */
1058 struct gcpro gcpro1
, gcpro2
;
1060 current_dir
= current_buffer
->directory
;
1062 GCPRO2 (buffer
, current_dir
);
1065 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1067 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1068 report_file_error ("Setting current directory",
1069 Fcons (current_buffer
->directory
, Qnil
));
1075 CHECK_STRING (name
, 0);
1079 CHECK_STRING (program
, 2);
1082 /* Make a one member argv with all args concatenated
1083 together separated by a blank. */
1084 len
= XSTRING (program
)->size
+ 2;
1085 for (i
= 3; i
< nargs
; i
++)
1088 CHECK_STRING (tem
, i
);
1089 len
+= XSTRING (tem
)->size
+ 1; /* count the blank */
1091 new_argv
= (unsigned char *) alloca (len
);
1092 strcpy (new_argv
, XSTRING (program
)->data
);
1093 for (i
= 3; i
< nargs
; i
++)
1096 CHECK_STRING (tem
, i
);
1097 strcat (new_argv
, " ");
1098 strcat (new_argv
, XSTRING (tem
)->data
);
1100 /* Need to add code here to check for program existence on VMS */
1103 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1105 /* If program file name is not absolute, search our path for it */
1106 if (!IS_DIRECTORY_SEP (XSTRING (program
)->data
[0])
1107 && !(XSTRING (program
)->size
> 1
1108 && IS_DEVICE_SEP (XSTRING (program
)->data
[1])))
1110 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1113 GCPRO4 (name
, program
, buffer
, current_dir
);
1114 openp (Vexec_path
, program
, EXEC_SUFFIXES
, &tem
, 1);
1117 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1118 tem
= Fexpand_file_name (tem
, Qnil
);
1119 new_argv
[0] = XSTRING (tem
)->data
;
1123 if (!NILP (Ffile_directory_p (program
)))
1124 error ("Specified program for new process is a directory");
1126 new_argv
[0] = XSTRING (program
)->data
;
1129 for (i
= 3; i
< nargs
; i
++)
1132 CHECK_STRING (tem
, i
);
1133 new_argv
[i
- 2] = XSTRING (tem
)->data
;
1135 new_argv
[i
- 2] = 0;
1136 #endif /* not VMS */
1138 proc
= make_process (name
);
1139 /* If an error occurs and we can't start the process, we want to
1140 remove it from the process list. This means that each error
1141 check in create_process doesn't need to call remove_process
1142 itself; it's all taken care of here. */
1143 record_unwind_protect (start_process_unwind
, proc
);
1145 XPROCESS (proc
)->childp
= Qt
;
1146 XPROCESS (proc
)->command_channel_p
= Qnil
;
1147 XPROCESS (proc
)->buffer
= buffer
;
1148 XPROCESS (proc
)->sentinel
= Qnil
;
1149 XPROCESS (proc
)->filter
= Qnil
;
1150 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1152 /* Make the process marker point into the process buffer (if any). */
1154 Fset_marker (XPROCESS (proc
)->mark
,
1155 make_number (BUF_ZV (XBUFFER (buffer
))), buffer
);
1157 if (!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
)
1158 || NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
))
1160 XPROCESS (proc
)->decode_coding_system
= Qnil
;
1161 XPROCESS (proc
)->encode_coding_system
= Qnil
;
1165 /* Setup coding systems for communicating with the process. */
1166 /* Qt denotes that we have not yet called Ffind_coding_system. */
1167 Lisp_Object coding_systems
= Qt
;
1168 Lisp_Object val
, *args2
;
1169 struct gcpro gcpro1
;
1171 if (NILP (val
= Vcoding_system_for_read
))
1173 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1174 args2
[0] = Qstart_process
;
1175 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1177 coding_systems
= Ffind_coding_system (nargs
+ 1, args2
);
1179 if (CONSP (coding_systems
))
1180 val
= XCONS (coding_systems
)->car
;
1182 XPROCESS (proc
)->decode_coding_system
= val
;
1184 if (NILP (val
= Vcoding_system_for_write
))
1186 if (EQ (coding_systems
, Qt
))
1188 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1189 args2
[0] = Qstart_process
;
1190 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1192 coding_systems
= Ffind_coding_system (nargs
+ 1, args2
);
1195 if (CONSP (coding_systems
))
1196 val
= XCONS (coding_systems
)->cdr
;
1198 XPROCESS (proc
)->encode_coding_system
= val
;
1201 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1202 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1204 create_process (proc
, new_argv
, current_dir
);
1206 return unbind_to (count
, proc
);
1209 /* This function is the unwind_protect form for Fstart_process. If
1210 PROC doesn't have its pid set, then we know someone has signaled
1211 an error and the process wasn't started successfully, so we should
1212 remove it from the process list. */
1214 start_process_unwind (proc
)
1217 if (!PROCESSP (proc
))
1220 /* Was PROC started successfully? */
1221 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1222 remove_process (proc
);
1229 create_process_1 (signo
)
1232 #if defined (USG) && !defined (POSIX_SIGNALS)
1233 /* USG systems forget handlers when they are used;
1234 must reestablish each time */
1235 signal (signo
, create_process_1
);
1239 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1242 /* Mimic blocking of signals on system V, which doesn't really have it. */
1244 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1245 int sigchld_deferred
;
1248 create_process_sigchld ()
1250 signal (SIGCHLD
, create_process_sigchld
);
1252 sigchld_deferred
= 1;
1258 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1259 create_process (process
, new_argv
, current_dir
)
1260 Lisp_Object process
;
1262 Lisp_Object current_dir
;
1264 int pid
, inchannel
, outchannel
;
1266 #ifdef POSIX_SIGNALS
1269 struct sigaction sigint_action
;
1270 struct sigaction sigquit_action
;
1272 struct sigaction sighup_action
;
1274 #else /* !POSIX_SIGNALS */
1276 SIGTYPE (*sigchld
)();
1278 #endif /* !POSIX_SIGNALS */
1279 /* Use volatile to protect variables from being clobbered by longjmp. */
1280 volatile int forkin
, forkout
;
1281 volatile int pty_flag
= 0;
1282 extern char **environ
;
1284 inchannel
= outchannel
= -1;
1287 if (!NILP (Vprocess_connection_type
))
1288 outchannel
= inchannel
= allocate_pty ();
1293 /* On USG systems it does not work to open the pty's tty here
1294 and then close and reopen it in the child. */
1296 /* Don't let this terminal become our controlling terminal
1297 (in case we don't have one). */
1298 forkout
= forkin
= open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1300 forkout
= forkin
= open (pty_name
, O_RDWR
, 0);
1303 report_file_error ("Opening pty", Qnil
);
1305 forkin
= forkout
= -1;
1306 #endif /* not USG */
1310 #endif /* HAVE_PTYS */
1313 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1314 report_file_error ("Opening socketpair", Qnil
);
1315 outchannel
= inchannel
= sv
[0];
1316 forkout
= forkin
= sv
[1];
1318 #else /* not SKTPAIR */
1327 #endif /* not SKTPAIR */
1330 /* Replaced by close_process_descs */
1331 set_exclusive_use (inchannel
);
1332 set_exclusive_use (outchannel
);
1335 /* Stride people say it's a mystery why this is needed
1336 as well as the O_NDELAY, but that it fails without this. */
1337 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1340 ioctl (inchannel
, FIONBIO
, &one
);
1345 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1346 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1349 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1350 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1354 /* Record this as an active process, with its channels.
1355 As a result, child_setup will close Emacs's side of the pipes. */
1356 chan_process
[inchannel
] = process
;
1357 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1358 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1359 /* Record the tty descriptor used in the subprocess. */
1361 XPROCESS (process
)->subtty
= Qnil
;
1363 XSETFASTINT (XPROCESS (process
)->subtty
, forkin
);
1364 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1365 XPROCESS (process
)->status
= Qrun
;
1366 if (!proc_decode_coding_system
[inchannel
])
1367 proc_decode_coding_system
[inchannel
]
1368 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
1369 setup_coding_system (XPROCESS (process
)->decode_coding_system
,
1370 proc_decode_coding_system
[inchannel
]);
1371 if (!proc_encode_coding_system
[outchannel
])
1372 proc_encode_coding_system
[outchannel
]
1373 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
1374 setup_coding_system (XPROCESS (process
)->encode_coding_system
,
1375 proc_encode_coding_system
[outchannel
]);
1377 /* Delay interrupts until we have a chance to store
1378 the new fork's pid in its process structure */
1379 #ifdef POSIX_SIGNALS
1380 sigemptyset (&blocked
);
1382 sigaddset (&blocked
, SIGCHLD
);
1385 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1386 this sets the parent's signal handlers as well as the child's.
1387 So delay all interrupts whose handlers the child might munge,
1388 and record the current handlers so they can be restored later. */
1389 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1390 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1392 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1394 #endif /* HAVE_VFORK */
1395 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1396 #else /* !POSIX_SIGNALS */
1400 #else /* not BSD4_1 */
1401 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1402 sigsetmask (sigmask (SIGCHLD
));
1403 #else /* ordinary USG */
1405 sigchld_deferred
= 0;
1406 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1408 #endif /* ordinary USG */
1409 #endif /* not BSD4_1 */
1410 #endif /* SIGCHLD */
1411 #endif /* !POSIX_SIGNALS */
1413 FD_SET (inchannel
, &input_wait_mask
);
1414 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1415 if (inchannel
> max_process_desc
)
1416 max_process_desc
= inchannel
;
1418 /* Until we store the proper pid, enable sigchld_handler
1419 to recognize an unknown pid as standing for this process.
1420 It is very important not to let this `marker' value stay
1421 in the table after this function has returned; if it does
1422 it might cause call-process to hang and subsequent asynchronous
1423 processes to get their return values scrambled. */
1424 XSETINT (XPROCESS (process
)->pid
, -1);
1429 /* child_setup must clobber environ on systems with true vfork.
1430 Protect it from permanent change. */
1431 char **save_environ
= environ
;
1436 #endif /* not WINDOWSNT */
1438 int xforkin
= forkin
;
1439 int xforkout
= forkout
;
1441 #if 0 /* This was probably a mistake--it duplicates code later on,
1442 but fails to handle all the cases. */
1443 /* Make sure SIGCHLD is not blocked in the child. */
1444 sigsetmask (SIGEMPTYMASK
);
1447 /* Make the pty be the controlling terminal of the process. */
1449 /* First, disconnect its current controlling terminal. */
1451 /* We tried doing setsid only if pty_flag, but it caused
1452 process_set_signal to fail on SGI when using a pipe. */
1454 /* Make the pty's terminal the controlling terminal. */
1458 /* We ignore the return value
1459 because faith@cs.unc.edu says that is necessary on Linux. */
1460 ioctl (xforkin
, TIOCSCTTY
, 0);
1463 #else /* not HAVE_SETSID */
1465 /* It's very important to call setpgrp here and no time
1466 afterwards. Otherwise, we lose our controlling tty which
1467 is set when we open the pty. */
1470 #endif /* not HAVE_SETSID */
1471 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1472 if (pty_flag
&& xforkin
>= 0)
1475 tcgetattr (xforkin
, &t
);
1477 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1478 write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1481 #if defined (NTTYDISC) && defined (TIOCSETD)
1482 if (pty_flag
&& xforkin
>= 0)
1484 /* Use new line discipline. */
1485 int ldisc
= NTTYDISC
;
1486 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1491 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1492 can do TIOCSPGRP only to the process's controlling tty. */
1495 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1496 I can't test it since I don't have 4.3. */
1497 int j
= open ("/dev/tty", O_RDWR
, 0);
1498 ioctl (j
, TIOCNOTTY
, 0);
1501 /* In order to get a controlling terminal on some versions
1502 of BSD, it is necessary to put the process in pgrp 0
1503 before it opens the terminal. */
1511 #endif /* TIOCNOTTY */
1513 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
1514 /*** There is a suggestion that this ought to be a
1515 conditional on TIOCSPGRP,
1516 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1517 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1518 that system does seem to need this code, even though
1519 both HAVE_SETSID and TIOCSCTTY are defined. */
1520 /* Now close the pty (if we had it open) and reopen it.
1521 This makes the pty the controlling terminal of the subprocess. */
1524 #ifdef SET_CHILD_PTY_PGRP
1525 int pgrp
= getpid ();
1528 /* I wonder if close (open (pty_name, ...)) would work? */
1531 xforkout
= xforkin
= open (pty_name
, O_RDWR
, 0);
1535 write (1, "Couldn't open the pty terminal ", 31);
1536 write (1, pty_name
, strlen (pty_name
));
1541 #ifdef SET_CHILD_PTY_PGRP
1542 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
1543 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
1546 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
1548 #ifdef SETUP_SLAVE_PTY
1553 #endif /* SETUP_SLAVE_PTY */
1555 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1556 Now reenable it in the child, so it will die when we want it to. */
1558 signal (SIGHUP
, SIG_DFL
);
1560 #endif /* HAVE_PTYS */
1562 signal (SIGINT
, SIG_DFL
);
1563 signal (SIGQUIT
, SIG_DFL
);
1565 /* Stop blocking signals in the child. */
1566 #ifdef POSIX_SIGNALS
1567 sigprocmask (SIG_SETMASK
, &procmask
, 0);
1568 #else /* !POSIX_SIGNALS */
1572 #else /* not BSD4_1 */
1573 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1574 sigsetmask (SIGEMPTYMASK
);
1575 #else /* ordinary USG */
1577 signal (SIGCHLD
, sigchld
);
1579 #endif /* ordinary USG */
1580 #endif /* not BSD4_1 */
1581 #endif /* SIGCHLD */
1582 #endif /* !POSIX_SIGNALS */
1585 child_setup_tty (xforkout
);
1587 pid
= child_setup (xforkin
, xforkout
, xforkout
,
1588 new_argv
, 1, current_dir
);
1589 #else /* not WINDOWSNT */
1590 child_setup (xforkin
, xforkout
, xforkout
,
1591 new_argv
, 1, current_dir
);
1592 #endif /* not WINDOWSNT */
1594 environ
= save_environ
;
1599 /* This runs in the Emacs process. */
1604 if (forkin
!= forkout
&& forkout
>= 0)
1609 /* vfork succeeded. */
1610 XSETFASTINT (XPROCESS (process
)->pid
, pid
);
1613 register_child (pid
, inchannel
);
1614 #endif /* WINDOWSNT */
1616 /* If the subfork execv fails, and it exits,
1617 this close hangs. I don't know why.
1618 So have an interrupt jar it loose. */
1620 signal (SIGALRM
, create_process_1
);
1622 XPROCESS (process
)->subtty
= Qnil
;
1627 if (forkin
!= forkout
&& forkout
>= 0)
1632 XPROCESS (process
)->tty_name
= build_string (pty_name
);
1635 XPROCESS (process
)->tty_name
= Qnil
;
1638 /* Restore the signal state whether vfork succeeded or not.
1639 (We will signal an error, below, if it failed.) */
1640 #ifdef POSIX_SIGNALS
1642 /* Restore the parent's signal handlers. */
1643 sigaction (SIGINT
, &sigint_action
, 0);
1644 sigaction (SIGQUIT
, &sigquit_action
, 0);
1646 sigaction (SIGHUP
, &sighup_action
, 0);
1648 #endif /* HAVE_VFORK */
1649 /* Stop blocking signals in the parent. */
1650 sigprocmask (SIG_SETMASK
, &procmask
, 0);
1651 #else /* !POSIX_SIGNALS */
1655 #else /* not BSD4_1 */
1656 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1657 sigsetmask (SIGEMPTYMASK
);
1658 #else /* ordinary USG */
1660 signal (SIGCHLD
, sigchld
);
1661 /* Now really handle any of these signals
1662 that came in during this function. */
1663 if (sigchld_deferred
)
1664 kill (getpid (), SIGCHLD
);
1666 #endif /* ordinary USG */
1667 #endif /* not BSD4_1 */
1668 #endif /* SIGCHLD */
1669 #endif /* !POSIX_SIGNALS */
1671 /* Now generate the error if vfork failed. */
1673 report_file_error ("Doing vfork", Qnil
);
1675 #endif /* not VMS */
1679 /* open a TCP network connection to a given HOST/SERVICE. Treated
1680 exactly like a normal process when reading and writing. Only
1681 differences are in status display and process deletion. A network
1682 connection has no PID; you cannot signal it. All you can do is
1683 deactivate and close it via delete-process */
1685 DEFUN ("open-network-stream", Fopen_network_stream
, Sopen_network_stream
,
1687 "Open a TCP connection for a service to a host.\n\
1688 Returns a subprocess-object to represent the connection.\n\
1689 Input and output work as for subprocesses; `delete-process' closes it.\n\
1690 Args are NAME BUFFER HOST SERVICE.\n\
1691 NAME is name for process. It is modified if necessary to make it unique.\n\
1692 BUFFER is the buffer (or buffer-name) to associate with the process.\n\
1693 Process output goes at end of that buffer, unless you specify\n\
1694 an output stream or filter function to handle the output.\n\
1695 BUFFER may be also nil, meaning that this process is not associated\n\
1697 Third arg is name of the host to connect to, or its IP address.\n\
1698 Fourth arg SERVICE is name of the service desired, or an integer\n\
1699 specifying a port number to connect to.")
1700 (name
, buffer
, host
, service
)
1701 Lisp_Object name
, buffer
, host
, service
;
1705 struct sockaddr_in address
;
1706 struct servent
*svc_info
;
1707 struct hostent
*host_info_ptr
, host_info
;
1708 char *(addr_list
[2]);
1709 IN_ADDR numeric_addr
;
1713 struct hostent host_info_fixed
;
1714 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1716 int count
= specpdl_ptr
- specpdl
;
1719 /* Ensure socket support is loaded if available. */
1720 init_winsock (TRUE
);
1723 GCPRO4 (name
, buffer
, host
, service
);
1724 CHECK_STRING (name
, 0);
1725 CHECK_STRING (host
, 0);
1726 if (INTEGERP (service
))
1727 port
= htons ((unsigned short) XINT (service
));
1730 CHECK_STRING (service
, 0);
1731 svc_info
= getservbyname (XSTRING (service
)->data
, "tcp");
1733 error ("Unknown service \"%s\"", XSTRING (service
)->data
);
1734 port
= svc_info
->s_port
;
1737 /* Slow down polling to every ten seconds.
1738 Some kernels have a bug which causes retrying connect to fail
1739 after a connect. Polling can interfere with gethostbyname too. */
1740 #ifdef POLL_FOR_INPUT
1741 bind_polling_period (10);
1752 host_info_ptr
= gethostbyname (XSTRING (host
)->data
);
1755 if (! (host_info_ptr
== 0 && h_errno
== TRY_AGAIN
))
1758 Fsleep_for (make_number (1), Qnil
);
1760 if (host_info_ptr
== 0)
1761 /* Attempt to interpret host as numeric inet address */
1763 numeric_addr
= inet_addr ((char *) XSTRING (host
)->data
);
1764 if (NUMERIC_ADDR_ERROR
)
1765 error ("Unknown host \"%s\"", XSTRING (host
)->data
);
1767 host_info_ptr
= &host_info
;
1768 host_info
.h_name
= 0;
1769 host_info
.h_aliases
= 0;
1770 host_info
.h_addrtype
= AF_INET
;
1772 /* Older machines have only one address slot called h_addr.
1773 Newer machines have h_addr_list, but #define h_addr to
1774 be its first element. */
1775 host_info
.h_addr_list
= &(addr_list
[0]);
1777 host_info
.h_addr
= (char*)(&numeric_addr
);
1779 /* numeric_addr isn't null-terminated; it has fixed length. */
1780 host_info
.h_length
= sizeof (numeric_addr
);
1783 bzero (&address
, sizeof address
);
1784 bcopy (host_info_ptr
->h_addr
, (char *) &address
.sin_addr
,
1785 host_info_ptr
->h_length
);
1786 address
.sin_family
= host_info_ptr
->h_addrtype
;
1787 address
.sin_port
= port
;
1789 s
= socket (host_info_ptr
->h_addrtype
, SOCK_STREAM
, 0);
1791 report_file_error ("error creating socket", Fcons (name
, Qnil
));
1793 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1794 when connect is interrupted. So let's not let it get interrupted.
1795 Note we do not turn off polling, because polling is only used
1796 when not interrupt_input, and thus not normally used on the systems
1797 which have this bug. On systems which use polling, there's no way
1798 to quit if polling is turned off. */
1799 if (interrupt_input
)
1807 if (connect (s
, (struct sockaddr
*) &address
, sizeof address
) == -1
1808 && errno
!= EISCONN
)
1816 if (errno
== EADDRINUSE
&& retry
< 20)
1818 /* A delay here is needed on some FreeBSD systems,
1819 and it is harmless, since this retrying takes time anyway
1820 and should be infrequent. */
1821 Fsleep_for (make_number (1), Qnil
);
1828 if (interrupt_input
)
1832 report_file_error ("connection failed",
1833 Fcons (host
, Fcons (name
, Qnil
)));
1838 #ifdef POLL_FOR_INPUT
1839 unbind_to (count
, Qnil
);
1842 if (interrupt_input
)
1846 s
= connect_server (0);
1848 report_file_error ("error creating socket", Fcons (name
, Qnil
));
1849 send_command (s
, C_PORT
, 0, "%s:%d", XSTRING (host
)->data
, ntohs (port
));
1850 send_command (s
, C_DUMB
, 1, 0);
1856 report_file_error ("error duplicating socket", Fcons (name
, Qnil
));
1859 buffer
= Fget_buffer_create (buffer
);
1860 proc
= make_process (name
);
1862 chan_process
[inch
] = proc
;
1865 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
1868 fcntl (inch
, F_SETFL
, O_NDELAY
);
1872 XPROCESS (proc
)->childp
= Fcons (host
, Fcons (service
, Qnil
));
1873 XPROCESS (proc
)->command_channel_p
= Qnil
;
1874 XPROCESS (proc
)->buffer
= buffer
;
1875 XPROCESS (proc
)->sentinel
= Qnil
;
1876 XPROCESS (proc
)->filter
= Qnil
;
1877 XPROCESS (proc
)->command
= Qnil
;
1878 XPROCESS (proc
)->pid
= Qnil
;
1879 XSETINT (XPROCESS (proc
)->infd
, inch
);
1880 XSETINT (XPROCESS (proc
)->outfd
, outch
);
1881 XPROCESS (proc
)->status
= Qrun
;
1882 FD_SET (inch
, &input_wait_mask
);
1883 FD_SET (inch
, &non_keyboard_wait_mask
);
1884 if (inch
> max_process_desc
)
1885 max_process_desc
= inch
;
1887 if (!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
)
1888 || NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
))
1890 XPROCESS (proc
)->decode_coding_system
= Qnil
;
1891 XPROCESS (proc
)->encode_coding_system
= Qnil
;
1895 /* Setup coding systems for communicating with the network stream. */
1896 struct gcpro gcpro1
;
1897 /* Qt denotes that we have not yet called Ffind_coding_system. */
1898 Lisp_Object coding_systems
= Qt
;
1899 Lisp_Object args
[5], val
;
1901 if (NILP (val
= Vcoding_system_for_read
))
1903 args
[0] = Qopen_network_stream
, args
[1] = name
,
1904 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
1906 coding_systems
= Ffind_coding_system (5, args
);
1908 val
= (CONSP (coding_systems
) ? XCONS (coding_systems
)->car
: Qnil
);
1910 XPROCESS (proc
)->decode_coding_system
= val
;
1912 if (NILP (val
= Vcoding_system_for_write
))
1914 if (EQ (coding_systems
, Qt
))
1916 args
[0] = Qopen_network_stream
, args
[1] = name
,
1917 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
1919 coding_systems
= Ffind_coding_system (5, args
);
1922 val
= (CONSP (coding_systems
) ? XCONS (coding_systems
)->cdr
: Qnil
);
1924 XPROCESS (proc
)->encode_coding_system
= val
;
1927 if (!proc_decode_coding_system
[inch
])
1928 proc_decode_coding_system
[inch
]
1929 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
1930 setup_coding_system (XPROCESS (proc
)->decode_coding_system
,
1931 proc_decode_coding_system
[inch
]);
1932 if (!proc_encode_coding_system
[outch
])
1933 proc_encode_coding_system
[outch
]
1934 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
1935 setup_coding_system (XPROCESS (proc
)->encode_coding_system
,
1936 proc_encode_coding_system
[outch
]);
1938 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1939 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1944 #endif /* HAVE_SOCKETS */
1946 deactivate_process (proc
)
1949 register int inchannel
, outchannel
;
1950 register struct Lisp_Process
*p
= XPROCESS (proc
);
1952 inchannel
= XINT (p
->infd
);
1953 outchannel
= XINT (p
->outfd
);
1957 /* Beware SIGCHLD hereabouts. */
1958 flush_pending_output (inchannel
);
1961 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
1962 sys$
dassgn (outchannel
);
1963 vs
= get_vms_process_pointer (p
->pid
);
1965 give_back_vms_process_stuff (vs
);
1969 if (outchannel
>= 0 && outchannel
!= inchannel
)
1973 XSETINT (p
->infd
, -1);
1974 XSETINT (p
->outfd
, -1);
1975 chan_process
[inchannel
] = Qnil
;
1976 FD_CLR (inchannel
, &input_wait_mask
);
1977 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
1978 if (inchannel
== max_process_desc
)
1981 /* We just closed the highest-numbered process input descriptor,
1982 so recompute the highest-numbered one now. */
1983 max_process_desc
= 0;
1984 for (i
= 0; i
< MAXDESC
; i
++)
1985 if (!NILP (chan_process
[i
]))
1986 max_process_desc
= i
;
1991 /* Close all descriptors currently in use for communication
1992 with subprocess. This is used in a newly-forked subprocess
1993 to get rid of irrelevant descriptors. */
1995 close_process_descs ()
1999 for (i
= 0; i
< MAXDESC
; i
++)
2001 Lisp_Object process
;
2002 process
= chan_process
[i
];
2003 if (!NILP (process
))
2005 int in
= XINT (XPROCESS (process
)->infd
);
2006 int out
= XINT (XPROCESS (process
)->outfd
);
2009 if (out
>= 0 && in
!= out
)
2016 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
2018 "Allow any pending output from subprocesses to be read by Emacs.\n\
2019 It is read into the process' buffers or given to their filter functions.\n\
2020 Non-nil arg PROCESS means do not return until some output has been received\n\
2022 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\
2023 seconds and microseconds to wait; return after that much time whether\n\
2024 or not there is input.\n\
2025 Return non-nil iff we received any output before the timeout expired.")
2026 (process
, timeout
, timeout_msecs
)
2027 register Lisp_Object process
, timeout
, timeout_msecs
;
2032 if (! NILP (timeout_msecs
))
2034 CHECK_NUMBER (timeout_msecs
, 2);
2035 useconds
= XINT (timeout_msecs
);
2036 if (!INTEGERP (timeout
))
2037 XSETINT (timeout
, 0);
2040 int carry
= useconds
/ 1000000;
2042 XSETINT (timeout
, XINT (timeout
) + carry
);
2043 useconds
-= carry
* 1000000;
2045 /* I think this clause is necessary because C doesn't
2046 guarantee a particular rounding direction for negative
2050 XSETINT (timeout
, XINT (timeout
) - 1);
2051 useconds
+= 1000000;
2058 if (! NILP (timeout
))
2060 CHECK_NUMBER (timeout
, 1);
2061 seconds
= XINT (timeout
);
2062 if (seconds
< 0 || (seconds
== 0 && useconds
== 0))
2074 XSETFASTINT (process
, 0);
2077 (wait_reading_process_input (seconds
, useconds
, process
, 0)
2081 /* This variable is different from waiting_for_input in keyboard.c.
2082 It is used to communicate to a lisp process-filter/sentinel (via the
2083 function Fwaiting_for_user_input_p below) whether emacs was waiting
2084 for user-input when that process-filter was called.
2085 waiting_for_input cannot be used as that is by definition 0 when
2086 lisp code is being evalled.
2087 This is also used in record_asynch_buffer_change.
2088 For that purpose, this must be 0
2089 when not inside wait_reading_process_input. */
2090 static int waiting_for_user_input_p
;
2092 /* This is here so breakpoints can be put on it. */
2094 wait_reading_process_input_1 ()
2098 /* Read and dispose of subprocess output while waiting for timeout to
2099 elapse and/or keyboard input to be available.
2102 timeout in seconds, or
2103 zero for no limit, or
2104 -1 means gobble data immediately available but don't wait for any.
2107 an additional duration to wait, measured in microseconds.
2108 If this is nonzero and time_limit is 0, then the timeout
2109 consists of MICROSECS only.
2111 READ_KBD is a lisp value:
2112 0 to ignore keyboard input, or
2113 1 to return when input is available, or
2114 -1 meaning caller will actually read the input, so don't throw to
2115 the quit handler, or
2116 a cons cell, meaning wait until its car is non-nil
2117 (and gobble terminal input into the buffer if any arrives), or
2118 a process object, meaning wait until something arrives from that
2119 process. The return value is true iff we read some input from
2122 DO_DISPLAY != 0 means redisplay should be done to show subprocess
2123 output that arrives.
2125 If READ_KBD is a pointer to a struct Lisp_Process, then the
2126 function returns true iff we received input from that process
2127 before the timeout elapsed.
2128 Otherwise, return true iff we received input from any process. */
2130 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
2131 int time_limit
, microsecs
;
2132 Lisp_Object read_kbd
;
2135 register int channel
, nfds
, m
;
2136 static SELECT_TYPE Available
;
2139 EMACS_TIME timeout
, end_time
, garbage
;
2141 int wait_channel
= -1;
2142 struct Lisp_Process
*wait_proc
= 0;
2143 int got_some_input
= 0;
2144 Lisp_Object
*wait_for_cell
= 0;
2146 FD_ZERO (&Available
);
2148 /* If read_kbd is a process to watch, set wait_proc and wait_channel
2150 if (PROCESSP (read_kbd
))
2152 wait_proc
= XPROCESS (read_kbd
);
2153 wait_channel
= XINT (wait_proc
->infd
);
2154 XSETFASTINT (read_kbd
, 0);
2157 /* If waiting for non-nil in a cell, record where. */
2158 if (CONSP (read_kbd
))
2160 wait_for_cell
= &XCONS (read_kbd
)->car
;
2161 XSETFASTINT (read_kbd
, 0);
2164 waiting_for_user_input_p
= XINT (read_kbd
);
2166 /* Since we may need to wait several times,
2167 compute the absolute time to return at. */
2168 if (time_limit
|| microsecs
)
2170 EMACS_GET_TIME (end_time
);
2171 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
2172 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
2175 /* AlainF 5-Jul-1996
2176 HP-UX 10.10 seem to have problems with signals coming in
2177 Causes "poll: interrupted system call" messages when Emacs is run
2179 Turn off periodic alarms (in case they are in use) */
2185 int timeout_reduced_for_timers
= 0;
2187 /* If calling from keyboard input, do not quit
2188 since we want to return C-g as an input character.
2189 Otherwise, do pending quit if requested. */
2190 if (XINT (read_kbd
) >= 0)
2193 /* Exit now if the cell we're waiting for became non-nil. */
2194 if (wait_for_cell
&& ! NILP (*wait_for_cell
))
2197 /* Compute time from now till when time limit is up */
2198 /* Exit if already run out */
2199 if (time_limit
== -1)
2201 /* -1 specified for timeout means
2202 gobble output available now
2203 but don't wait at all. */
2205 EMACS_SET_SECS_USECS (timeout
, 0, 0);
2207 else if (time_limit
|| microsecs
)
2209 EMACS_GET_TIME (timeout
);
2210 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
2211 if (EMACS_TIME_NEG_P (timeout
))
2216 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
2219 /* Normally we run timers here.
2220 But not if wait_for_cell; in those cases,
2221 the wait is supposed to be short,
2222 and those callers cannot handle running arbitrary Lisp code here. */
2223 if (! wait_for_cell
)
2225 EMACS_TIME timer_delay
;
2229 old_timers_run
= timers_run
;
2230 timer_delay
= timer_check (1);
2231 if (timers_run
!= old_timers_run
&& do_display
)
2233 redisplay_preserve_echo_area ();
2234 /* We must retry, since a timer may have requeued itself
2235 and that could alter the time_delay. */
2239 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
2241 EMACS_TIME difference
;
2242 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
2243 if (EMACS_TIME_NEG_P (difference
))
2245 timeout
= timer_delay
;
2246 timeout_reduced_for_timers
= 1;
2249 /* If time_limit is -1, we are not going to wait at all. */
2250 else if (time_limit
!= -1)
2252 /* This is so a breakpoint can be put here. */
2253 wait_reading_process_input_1 ();
2257 /* Cause C-g and alarm signals to take immediate action,
2258 and cause input available signals to zero out timeout.
2260 It is important that we do this before checking for process
2261 activity. If we get a SIGCHLD after the explicit checks for
2262 process activity, timeout is the only way we will know. */
2263 if (XINT (read_kbd
) < 0)
2264 set_waiting_for_input (&timeout
);
2266 /* If status of something has changed, and no input is
2267 available, notify the user of the change right away. After
2268 this explicit check, we'll let the SIGCHLD handler zap
2269 timeout to get our attention. */
2270 if (update_tick
!= process_tick
&& do_display
)
2272 Atemp
= input_wait_mask
;
2273 EMACS_SET_SECS_USECS (timeout
, 0, 0);
2274 if ((select (MAXDESC
, &Atemp
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
2278 /* It's okay for us to do this and then continue with
2279 the loop, since timeout has already been zeroed out. */
2280 clear_waiting_for_input ();
2285 /* Don't wait for output from a non-running process. */
2286 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
2287 update_status (wait_proc
);
2289 && ! EQ (wait_proc
->status
, Qrun
))
2291 clear_waiting_for_input ();
2295 /* Wait till there is something to do */
2297 if (! XINT (read_kbd
) && wait_for_cell
== 0)
2298 Available
= non_keyboard_wait_mask
;
2300 Available
= input_wait_mask
;
2302 /* If frame size has changed or the window is newly mapped,
2303 redisplay now, before we start to wait. There is a race
2304 condition here; if a SIGIO arrives between now and the select
2305 and indicates that a frame is trashed, the select may block
2306 displaying a trashed screen. */
2307 if (frame_garbaged
&& do_display
)
2309 clear_waiting_for_input ();
2310 redisplay_preserve_echo_area ();
2311 if (XINT (read_kbd
) < 0)
2312 set_waiting_for_input (&timeout
);
2315 if (XINT (read_kbd
) && detect_input_pending ())
2318 FD_ZERO (&Available
);
2321 nfds
= select (MAXDESC
, &Available
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
2326 /* Make C-g and alarm signals set flags again */
2327 clear_waiting_for_input ();
2329 /* If we woke up due to SIGWINCH, actually change size now. */
2330 do_pending_window_change ();
2332 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
2333 /* We wanted the full specified time, so return now. */
2337 if (xerrno
== EINTR
)
2338 FD_ZERO (&Available
);
2340 /* Ultrix select seems to return ENOMEM when it is
2341 interrupted. Treat it just like EINTR. Bleah. Note
2342 that we want to test for the "ultrix" CPP symbol, not
2343 "__ultrix__"; the latter is only defined under GCC, but
2344 not by DEC's bundled CC. -JimB */
2345 else if (xerrno
== ENOMEM
)
2346 FD_ZERO (&Available
);
2349 /* This happens for no known reason on ALLIANT.
2350 I am guessing that this is the right response. -- RMS. */
2351 else if (xerrno
== EFAULT
)
2352 FD_ZERO (&Available
);
2354 else if (xerrno
== EBADF
)
2357 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
2358 the child's closure of the pts gives the parent a SIGHUP, and
2359 the ptc file descriptor is automatically closed,
2360 yielding EBADF here or at select() call above.
2361 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
2362 in m/ibmrt-aix.h), and here we just ignore the select error.
2363 Cleanup occurs c/o status_notify after SIGCLD. */
2364 FD_ZERO (&Available
); /* Cannot depend on values returned */
2370 error ("select error: %s", strerror (xerrno
));
2372 #if defined(sun) && !defined(USG5_4)
2373 else if (nfds
> 0 && keyboard_bit_set (&Available
)
2375 /* System sometimes fails to deliver SIGIO.
2377 David J. Mackenzie says that Emacs doesn't compile under
2378 Solaris if this code is enabled, thus the USG5_4 in the CPP
2379 conditional. "I haven't noticed any ill effects so far.
2380 If you find a Solaris expert somewhere, they might know
2382 kill (getpid (), SIGIO
);
2385 /* Check for keyboard input */
2386 /* If there is any, return immediately
2387 to give it higher priority than subprocesses */
2389 if ((XINT (read_kbd
) != 0)
2390 && detect_input_pending_run_timers (do_display
))
2392 swallow_events (do_display
);
2393 if (detect_input_pending_run_timers (do_display
))
2397 /* If wait_for_cell. check for keyboard input
2398 but don't run any timers.
2399 ??? (It seems wrong to me to check for keyboard
2400 input at all when wait_for_cell, but the code
2401 has been this way since July 1994.
2402 Try changing this after version 19.31.) */
2404 && detect_input_pending ())
2406 swallow_events (do_display
);
2407 if (detect_input_pending ())
2411 /* Exit now if the cell we're waiting for became non-nil. */
2412 if (wait_for_cell
&& ! NILP (*wait_for_cell
))
2416 /* If we think we have keyboard input waiting, but didn't get SIGIO
2417 go read it. This can happen with X on BSD after logging out.
2418 In that case, there really is no input and no SIGIO,
2419 but select says there is input. */
2421 if (XINT (read_kbd
) && interrupt_input
2422 && (keyboard_bit_set (&Available
)))
2423 kill (getpid (), SIGIO
);
2427 got_some_input
|= nfds
> 0;
2429 /* If checking input just got us a size-change event from X,
2430 obey it now if we should. */
2431 if (XINT (read_kbd
) || wait_for_cell
)
2432 do_pending_window_change ();
2434 /* Check for data from a process. */
2435 /* Really FIRST_PROC_DESC should be 0 on Unix,
2436 but this is safer in the short run. */
2437 for (channel
= 0; channel
<= max_process_desc
; channel
++)
2439 if (FD_ISSET (channel
, &Available
)
2440 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
2444 /* If waiting for this channel, arrange to return as
2445 soon as no more input to be processed. No more
2447 if (wait_channel
== channel
)
2453 proc
= chan_process
[channel
];
2457 /* Read data from the process, starting with our
2458 buffered-ahead character if we have one. */
2460 nread
= read_process_output (proc
, channel
);
2463 /* Since read_process_output can run a filter,
2464 which can call accept-process-output,
2465 don't try to read from any other processes
2466 before doing the select again. */
2467 FD_ZERO (&Available
);
2470 redisplay_preserve_echo_area ();
2473 else if (nread
== -1 && errno
== EWOULDBLOCK
)
2476 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
2477 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
2479 else if (nread
== -1 && errno
== EAGAIN
)
2483 else if (nread
== -1 && errno
== EAGAIN
)
2485 /* Note that we cannot distinguish between no input
2486 available now and a closed pipe.
2487 With luck, a closed pipe will be accompanied by
2488 subprocess termination and SIGCHLD. */
2489 else if (nread
== 0 && !NETCONN_P (proc
))
2491 #endif /* O_NDELAY */
2492 #endif /* O_NONBLOCK */
2494 /* On some OSs with ptys, when the process on one end of
2495 a pty exits, the other end gets an error reading with
2496 errno = EIO instead of getting an EOF (0 bytes read).
2497 Therefore, if we get an error reading and errno =
2498 EIO, just continue, because the child process has
2499 exited and should clean itself up soon (e.g. when we
2501 else if (nread
== -1 && errno
== EIO
)
2503 #endif /* HAVE_PTYS */
2504 /* If we can detect process termination, don't consider the process
2505 gone just because its pipe is closed. */
2507 else if (nread
== 0 && !NETCONN_P (proc
))
2512 /* Preserve status of processes already terminated. */
2513 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
2514 deactivate_process (proc
);
2515 if (!NILP (XPROCESS (proc
)->raw_status_low
))
2516 update_status (XPROCESS (proc
));
2517 if (EQ (XPROCESS (proc
)->status
, Qrun
))
2518 XPROCESS (proc
)->status
2519 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
2522 } /* end for each file descriptor */
2523 } /* end while exit conditions not met */
2525 waiting_for_user_input_p
= 0;
2527 /* If calling from keyboard input, do not quit
2528 since we want to return C-g as an input character.
2529 Otherwise, do pending quit if requested. */
2530 if (XINT (read_kbd
) >= 0)
2532 /* Prevent input_pending from remaining set if we quit. */
2533 clear_input_pending ();
2537 /* AlainF 5-Jul-1996
2538 HP-UX 10.10 seems to have problems with signals coming in
2539 Causes "poll: interrupted system call" messages when Emacs is run
2541 Turn periodic alarms back on */
2545 return got_some_input
;
2548 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
2551 read_process_output_call (fun_and_args
)
2552 Lisp_Object fun_and_args
;
2554 return apply1 (XCONS (fun_and_args
)->car
, XCONS (fun_and_args
)->cdr
);
2558 read_process_output_error_handler (error
)
2561 cmd_error_internal (error
, "error in process filter: ");
2563 update_echo_area ();
2564 Fsleep_for (make_number (2), Qnil
);
2568 #define READ_CHILD_OUTPUT read_child_output
2570 #define READ_CHILD_OUTPUT read
2573 /* Read pending output from the process channel,
2574 starting with our buffered-ahead character if we have one.
2575 Yield number of decoded characters read.
2577 This function reads at most 1024 characters.
2578 If you want to read all available subprocess output,
2579 you must call it repeatedly until it returns zero.
2581 The characters read are decoded according to PROC's coding-system
2584 read_process_output (proc
, channel
)
2586 register int channel
;
2588 register int nchars
;
2591 int chars_allocated
= 0; /* If 1, `chars' should be freed later. */
2595 register Lisp_Object outstream
;
2596 register struct buffer
*old
= current_buffer
;
2597 register struct Lisp_Process
*p
= XPROCESS (proc
);
2598 register int opoint
;
2599 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
2600 int chars_in_decoding_buf
= 0; /* If 1, `chars' points
2601 XSTRING (p->decoding_buf)->data. */
2604 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
2606 vs
= get_vms_process_pointer (p
->pid
);
2610 return(0); /* Really weird if it does this */
2611 if (!(vs
->iosb
[0] & 1))
2612 return -1; /* I/O error */
2615 error ("Could not get VMS process pointer");
2616 chars
= vs
->inputBuffer
;
2617 nchars
= clean_vms_buffer (chars
, vs
->iosb
[1]);
2620 start_vms_process_read (vs
); /* Crank up the next read on the process */
2621 return 1; /* Nothing worth printing, say we got 1 */
2623 if (coding
->carryover_size
)
2625 /* The data carried over in the previous decoding should be
2626 prepended to the new data read to decode all together. */
2627 char *buf
= (char *) xmalloc (nchars
+ coding
->carryover_size
);
2629 bcopy (coding
->carryover
, buf
, coding
->carryover_size
);
2630 bcopy (chars
, buf
+ coding
->carryover_size
, nchars
);
2632 chars_allocated
= 1;
2636 if (coding
->carryover_size
)
2637 /* The data carried over in the previous decoding should be
2638 prepended to the new data read to decode all together. */
2639 bcopy (coding
->carryover
, buf
, coding
->carryover_size
);
2641 if (proc_buffered_char
[channel
] < 0)
2642 nchars
= READ_CHILD_OUTPUT (channel
, buf
+ coding
->carryover_size
,
2643 (sizeof buf
) - coding
->carryover_size
);
2646 buf
[coding
->carryover_size
] = proc_buffered_char
[channel
];
2647 proc_buffered_char
[channel
] = -1;
2648 nchars
= READ_CHILD_OUTPUT (channel
, buf
+ coding
->carryover_size
+ 1,
2649 (sizeof buf
) - coding
->carryover_size
- 1);
2653 nchars
= nchars
+ 1;
2656 #endif /* not VMS */
2658 /* At this point, NCHARS holds number of characters just received
2659 (including the one in proc_buffered_char[channel]). */
2660 if (nchars
<= 0) return nchars
;
2662 /* Now set NCHARS how many bytes we must decode. */
2663 nchars
+= coding
->carryover_size
;
2665 if (CODING_REQUIRE_CONVERSION (coding
))
2667 int require
= decoding_buffer_size (coding
, nchars
);
2668 int consumed
, produced
;
2670 if (XSTRING (p
->decoding_buf
)->size
< require
)
2671 p
->decoding_buf
= make_uninit_string (require
);
2672 produced
= decode_coding (coding
, chars
, XSTRING (p
->decoding_buf
)->data
,
2673 nchars
, XSTRING (p
->decoding_buf
)->size
,
2676 /* New coding-system might be found by `decode_coding'. */
2677 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
2679 p
->decode_coding_system
= coding
->symbol
;
2680 setup_coding_system (coding
->symbol
,
2681 proc_decode_coding_system
[channel
]);
2682 /* If coding-system for encoding is not yet decided, we set it
2683 as the same as coding-system for decoding. */
2684 if (NILP (p
->encode_coding_system
))
2686 p
->encode_coding_system
= coding
->symbol
;
2687 setup_coding_system (coding
->symbol
,
2688 proc_encode_coding_system
[channel
]);
2692 /* Now we don't need the contents of `chars'. */
2693 if (chars_allocated
)
2698 chars
= XSTRING (p
->decoding_buf
)->data
;
2700 chars_in_decoding_buf
= 1;
2703 else if (chars_allocated
)
2705 /* Although we don't have to decode the received data, we must
2706 move it to an area which we don't have to free. */
2707 if (! STRINGP (p
->decoding_buf
)
2708 || XSTRING (p
->decoding_buf
)->size
< nchars
)
2709 p
->decoding_buf
= make_uninit_string (nchars
);
2710 bcopy (chars
, XSTRING (p
->decoding_buf
)->data
, nchars
);
2712 chars
= XSTRING (p
->decoding_buf
)->data
;
2713 chars_in_decoding_buf
= 1;
2717 outstream
= p
->filter
;
2718 if (!NILP (outstream
))
2720 /* We inhibit quit here instead of just catching it so that
2721 hitting ^G when a filter happens to be running won't screw
2723 int count
= specpdl_ptr
- specpdl
;
2724 Lisp_Object odeactivate
;
2725 Lisp_Object obuffer
, okeymap
;
2726 int outer_running_asynch_code
= running_asynch_code
;
2728 /* No need to gcpro these, because all we do with them later
2729 is test them for EQness, and none of them should be a string. */
2730 odeactivate
= Vdeactivate_mark
;
2731 XSETBUFFER (obuffer
, current_buffer
);
2732 okeymap
= current_buffer
->keymap
;
2734 specbind (Qinhibit_quit
, Qt
);
2735 specbind (Qlast_nonmenu_event
, Qt
);
2737 /* In case we get recursively called,
2738 and we already saved the match data nonrecursively,
2739 save the same match data in safely recursive fashion. */
2740 if (outer_running_asynch_code
)
2743 /* Don't clobber the CURRENT match data, either! */
2744 tem
= Fmatch_data (Qnil
, Qnil
);
2745 restore_match_data ();
2746 record_unwind_protect (Fstore_match_data
, Fmatch_data (Qnil
, Qnil
));
2747 Fstore_match_data (tem
);
2750 /* For speed, if a search happens within this code,
2751 save the match data in a special nonrecursive fashion. */
2752 running_asynch_code
= 1;
2754 /* Read and dispose of the process output. */
2755 internal_condition_case_1 (read_process_output_call
,
2758 Fcons (make_string (chars
,
2761 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
2762 read_process_output_error_handler
);
2764 /* If we saved the match data nonrecursively, restore it now. */
2765 restore_match_data ();
2766 running_asynch_code
= outer_running_asynch_code
;
2768 /* Handling the process output should not deactivate the mark. */
2769 Vdeactivate_mark
= odeactivate
;
2771 #if 0 /* Call record_asynch_buffer_change unconditionally,
2772 because we might have changed minor modes or other things
2773 that affect key bindings. */
2774 if (! EQ (Fcurrent_buffer (), obuffer
)
2775 || ! EQ (current_buffer
->keymap
, okeymap
))
2777 /* But do it only if the caller is actually going to read events.
2778 Otherwise there's no need to make him wake up, and it could
2779 cause trouble (for example it would make Fsit_for return). */
2780 if (waiting_for_user_input_p
== -1)
2781 record_asynch_buffer_change ();
2784 start_vms_process_read (vs
);
2786 unbind_to (count
, Qnil
);
2790 /* If no filter, write into buffer if it isn't dead. */
2791 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
2793 Lisp_Object old_read_only
;
2794 Lisp_Object old_begv
, old_zv
;
2795 Lisp_Object odeactivate
;
2797 odeactivate
= Vdeactivate_mark
;
2799 Fset_buffer (p
->buffer
);
2801 old_read_only
= current_buffer
->read_only
;
2802 XSETFASTINT (old_begv
, BEGV
);
2803 XSETFASTINT (old_zv
, ZV
);
2805 current_buffer
->read_only
= Qnil
;
2807 /* Insert new output into buffer
2808 at the current end-of-output marker,
2809 thus preserving logical ordering of input and output. */
2810 if (XMARKER (p
->mark
)->buffer
)
2811 SET_PT (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
));
2815 /* If the output marker is outside of the visible region, save
2816 the restriction and widen. */
2817 if (! (BEGV
<= PT
&& PT
<= ZV
))
2820 /* Make sure opoint floats ahead of any new text, just as point
2825 /* Insert after old_begv, but before old_zv. */
2826 if (PT
< XFASTINT (old_begv
))
2827 XSETFASTINT (old_begv
, XFASTINT (old_begv
) + nchars
);
2828 if (PT
<= XFASTINT (old_zv
))
2829 XSETFASTINT (old_zv
, XFASTINT (old_zv
) + nchars
);
2831 /* Insert before markers in case we are inserting where
2832 the buffer's mark is, and the user's next command is Meta-y. */
2833 if (chars_in_decoding_buf
)
2834 insert_from_string_before_markers (p
->decoding_buf
, 0, nchars
, 0);
2836 insert_before_markers (chars
, nchars
);
2837 Fset_marker (p
->mark
, make_number (PT
), p
->buffer
);
2839 update_mode_lines
++;
2841 /* If the restriction isn't what it should be, set it. */
2842 if (XFASTINT (old_begv
) != BEGV
|| XFASTINT (old_zv
) != ZV
)
2843 Fnarrow_to_region (old_begv
, old_zv
);
2845 /* Handling the process output should not deactivate the mark. */
2846 Vdeactivate_mark
= odeactivate
;
2848 current_buffer
->read_only
= old_read_only
;
2850 set_buffer_internal (old
);
2853 start_vms_process_read (vs
);
2858 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
2860 "Returns non-nil if emacs is waiting for input from the user.\n\
2861 This is intended for use by asynchronous process output filters and sentinels.")
2864 return (waiting_for_user_input_p
? Qt
: Qnil
);
2867 /* Sending data to subprocess */
2869 jmp_buf send_process_frame
;
2872 send_process_trap ()
2878 longjmp (send_process_frame
, 1);
2881 /* Send some data to process PROC.
2882 BUF is the beginning of the data; LEN is the number of characters.
2883 OBJECT is the Lisp object that the data comes from.
2885 The data is encoded by PROC's coding-system for encoding before it
2886 is sent. But if the data ends at the middle of multi-byte
2887 representation, that incomplete sequence of bytes are sent without
2888 being encoded. Should we store them in a buffer to prepend them to
2889 the data send later? */
2891 send_process (proc
, buf
, len
, object
)
2892 volatile Lisp_Object proc
;
2897 /* Use volatile to protect variables from being clobbered by longjmp. */
2899 volatile unsigned char *procname
= XSTRING (XPROCESS (proc
)->name
)->data
;
2900 struct coding_system
*coding
;
2901 struct gcpro gcpro1
;
2906 struct Lisp_Process
*p
= XPROCESS (proc
);
2907 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
2910 if (! NILP (XPROCESS (proc
)->raw_status_low
))
2911 update_status (XPROCESS (proc
));
2912 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
2913 error ("Process %s not running", procname
);
2914 if (XINT (XPROCESS (proc
)->outfd
) < 0)
2915 error ("Output file descriptor of %s is closed", procname
);
2917 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
2918 if (CODING_REQUIRE_CONVERSION (coding
))
2920 int require
= encoding_buffer_size (coding
, len
);
2922 char *temp_buf
= NULL
;
2924 /* Remember the offset of data because a string or a buffer may
2925 be relocated. Setting OFFSET to -1 means we don't have to
2927 offset
= (BUFFERP (object
)
2928 ? BUF_PTR_CHAR_POS (XBUFFER (object
), (unsigned char *) buf
)
2930 ? offset
= buf
- (char *) XSTRING (object
)->data
2933 if (coding
->carryover_size
> 0)
2935 temp_buf
= (char *) xmalloc (len
+ coding
->carryover_size
);
2939 if (BUFFERP (object
))
2940 buf
= (char *) BUF_CHAR_ADDRESS (XBUFFER (object
), offset
);
2941 else if (STRINGP (object
))
2942 buf
= offset
+ (char *) XSTRING (object
)->data
;
2943 /* Now we don't have to care relocation. */
2946 bcopy (coding
->carryover
, temp_buf
, coding
->carryover_size
);
2947 bcopy (buf
, temp_buf
+ coding
->carryover_size
, len
);
2951 if (XSTRING (XPROCESS (proc
)->encoding_buf
)->size
< require
)
2953 XPROCESS (proc
)->encoding_buf
= make_uninit_string (require
);
2957 if (BUFFERP (object
))
2958 buf
= (char *) BUF_CHAR_ADDRESS (XBUFFER (object
), offset
);
2959 else if (STRINGP (object
))
2960 buf
= offset
+ (char *) XSTRING (object
)->data
;
2963 object
= XPROCESS (proc
)->encoding_buf
;
2964 len
= encode_coding (coding
, buf
, XSTRING (object
)->data
,
2965 len
, XSTRING (object
)->size
, &dummy
);
2966 buf
= XSTRING (object
)->data
;
2972 vs
= get_vms_process_pointer (p
->pid
);
2974 error ("Could not find this process: %x", p
->pid
);
2975 else if (write_to_vms_process (vs
, buf
, len
))
2979 if (pty_max_bytes
== 0)
2981 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
2982 pty_max_bytes
= fpathconf (XFASTINT (XPROCESS (proc
)->outfd
),
2984 if (pty_max_bytes
< 0)
2985 pty_max_bytes
= 250;
2987 pty_max_bytes
= 250;
2989 /* Deduct one, to leave space for the eof. */
2993 if (!setjmp (send_process_frame
))
2997 SIGTYPE (*old_sigpipe
)();
3000 /* Decide how much data we can send in one batch.
3001 Long lines need to be split into multiple batches. */
3002 if (!NILP (XPROCESS (proc
)->pty_flag
))
3004 /* Starting this at zero is always correct when not the first iteration
3005 because the previous iteration ended by sending C-d.
3006 It may not be correct for the first iteration
3007 if a partial line was sent in a separate send_process call.
3008 If that proves worth handling, we need to save linepos
3009 in the process object. */
3012 char *end
= buf
+ len
;
3014 /* Scan through this text for a line that is too long. */
3015 while (ptr
!= end
&& linepos
< pty_max_bytes
)
3023 /* If we found one, break the line there
3024 and put in a C-d to force the buffer through. */
3028 /* Send this batch, using one or more write calls. */
3031 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
3032 rv
= write (XINT (XPROCESS (proc
)->outfd
), buf
, this);
3033 signal (SIGPIPE
, old_sigpipe
);
3039 || errno
== EWOULDBLOCK
3045 /* Buffer is full. Wait, accepting input;
3046 that may allow the program
3047 to finish doing output and read more. */
3052 /* Running filters might relocate buffers or strings.
3053 Arrange to relocate BUF. */
3054 if (BUFFERP (object
))
3055 offset
= BUF_PTR_CHAR_POS (XBUFFER (object
),
3056 (unsigned char *) buf
);
3057 else if (STRINGP (object
))
3058 offset
= buf
- (char *) XSTRING (object
)->data
;
3060 XSETFASTINT (zero
, 0);
3061 #ifdef EMACS_HAS_USECS
3062 wait_reading_process_input (0, 20000, zero
, 0);
3064 wait_reading_process_input (1, 0, zero
, 0);
3067 if (BUFFERP (object
))
3068 buf
= (char *) BUF_CHAR_ADDRESS (XBUFFER (object
), offset
);
3069 else if (STRINGP (object
))
3070 buf
= offset
+ (char *) XSTRING (object
)->data
;
3075 /* This is a real error. */
3076 report_file_error ("writing to process", Fcons (proc
, Qnil
));
3083 /* If we sent just part of the string, put in an EOF
3084 to force it through, before we send the rest. */
3086 Fprocess_send_eof (proc
);
3091 XPROCESS (proc
)->raw_status_low
= Qnil
;
3092 XPROCESS (proc
)->raw_status_high
= Qnil
;
3093 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
3094 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
3095 deactivate_process (proc
);
3097 error ("Error writing to process %s; closed it", procname
);
3099 error ("SIGPIPE raised on process %s; closed it", procname
);
3106 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
3108 "Send current contents of region as input to PROCESS.\n\
3109 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
3110 nil, indicating the current buffer's process.\n\
3111 Called from program, takes three arguments, PROCESS, START and END.\n\
3112 If the region is more than 500 characters long,\n\
3113 it is sent in several bunches. This may happen even for shorter regions.\n\
3114 Output from processes can arrive in between bunches.")
3115 (process
, start
, end
)
3116 Lisp_Object process
, start
, end
;
3121 proc
= get_process (process
);
3122 validate_region (&start
, &end
);
3124 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
3127 start1
= XINT (start
);
3128 send_process (proc
, POS_ADDR (start1
), XINT (end
) - XINT (start
),
3129 Fcurrent_buffer ());
3134 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
3136 "Send PROCESS the contents of STRING as input.\n\
3137 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
3138 nil, indicating the current buffer's process.\n\
3139 If STRING is more than 500 characters long,\n\
3140 it is sent in several bunches. This may happen even for shorter strings.\n\
3141 Output from processes can arrive in between bunches.")
3143 Lisp_Object process
, string
;
3146 CHECK_STRING (string
, 1);
3147 proc
= get_process (process
);
3148 send_process (proc
, XSTRING (string
)->data
, XSTRING (string
)->size
, string
);
3152 /* send a signal number SIGNO to PROCESS.
3153 CURRENT_GROUP means send to the process group that currently owns
3154 the terminal being used to communicate with PROCESS.
3155 This is used for various commands in shell mode.
3156 If NOMSG is zero, insert signal-announcements into process's buffers
3159 If we can, we try to signal PROCESS by sending control characters
3160 down the pty. This allows us to signal inferiors who have changed
3161 their uid, for which killpg would return an EPERM error. */
3164 process_send_signal (process
, signo
, current_group
, nomsg
)
3165 Lisp_Object process
;
3167 Lisp_Object current_group
;
3171 register struct Lisp_Process
*p
;
3175 proc
= get_process (process
);
3176 p
= XPROCESS (proc
);
3178 if (!EQ (p
->childp
, Qt
))
3179 error ("Process %s is not a subprocess",
3180 XSTRING (p
->name
)->data
);
3181 if (XINT (p
->infd
) < 0)
3182 error ("Process %s is not active",
3183 XSTRING (p
->name
)->data
);
3185 if (NILP (p
->pty_flag
))
3186 current_group
= Qnil
;
3188 /* If we are using pgrps, get a pgrp number and make it negative. */
3189 if (!NILP (current_group
))
3191 #ifdef SIGNALS_VIA_CHARACTERS
3192 /* If possible, send signals to the entire pgrp
3193 by sending an input character to it. */
3195 /* TERMIOS is the latest and bestest, and seems most likely to
3196 work. If the system has it, use it. */
3203 tcgetattr (XINT (p
->infd
), &t
);
3204 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
3208 tcgetattr (XINT (p
->infd
), &t
);
3209 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
3213 tcgetattr (XINT (p
->infd
), &t
);
3214 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
3215 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
3217 send_process (proc
, &t
.c_cc
[VSUSP
], 1, Qnil
);
3222 #else /* ! HAVE_TERMIOS */
3224 /* On Berkeley descendants, the following IOCTL's retrieve the
3225 current control characters. */
3226 #if defined (TIOCGLTC) && defined (TIOCGETC)
3234 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
3235 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
3238 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
3239 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
3243 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
3244 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
3246 #endif /* ! defined (SIGTSTP) */
3249 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
3251 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
3258 ioctl (XINT (p
->infd
), TCGETA
, &t
);
3259 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
3262 ioctl (XINT (p
->infd
), TCGETA
, &t
);
3263 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
3267 ioctl (XINT (p
->infd
), TCGETA
, &t
);
3268 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
3270 #endif /* ! defined (SIGTSTP) */
3272 #else /* ! defined (TCGETA) */
3273 Your configuration files are messed up
.
3274 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
3275 you'd better be using one of the alternatives above! */
3276 #endif /* ! defined (TCGETA) */
3277 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
3278 #endif /* ! defined HAVE_TERMIOS */
3279 #endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
3282 /* Get the pgrp using the tty itself, if we have that.
3283 Otherwise, use the pty to get the pgrp.
3284 On pfa systems, saka@pfu.fujitsu.co.JP writes:
3285 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
3286 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
3287 His patch indicates that if TIOCGPGRP returns an error, then
3288 we should just assume that p->pid is also the process group id. */
3292 if (!NILP (p
->subtty
))
3293 err
= ioctl (XFASTINT (p
->subtty
), TIOCGPGRP
, &gid
);
3295 err
= ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
);
3299 gid
= - XFASTINT (p
->pid
);
3300 #endif /* ! defined (pfa) */
3306 #else /* ! defined (TIOCGPGRP ) */
3307 /* Can't select pgrps on this system, so we know that
3308 the child itself heads the pgrp. */
3309 gid
= - XFASTINT (p
->pid
);
3310 #endif /* ! defined (TIOCGPGRP ) */
3313 gid
= - XFASTINT (p
->pid
);
3319 p
->raw_status_low
= Qnil
;
3320 p
->raw_status_high
= Qnil
;
3322 XSETINT (p
->tick
, ++process_tick
);
3326 #endif /* ! defined (SIGCONT) */
3329 send_process (proc
, "\003", 1, Qnil
); /* ^C */
3334 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
3339 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
3342 flush_pending_output (XINT (p
->infd
));
3346 /* If we don't have process groups, send the signal to the immediate
3347 subprocess. That isn't really right, but it's better than any
3348 obvious alternative. */
3351 kill (XFASTINT (p
->pid
), signo
);
3355 /* gid may be a pid, or minus a pgrp's number */
3357 if (!NILP (current_group
))
3358 ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
);
3361 gid
= - XFASTINT (p
->pid
);
3364 #else /* ! defined (TIOCSIGSEND) */
3365 EMACS_KILLPG (-gid
, signo
);
3366 #endif /* ! defined (TIOCSIGSEND) */
3369 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
3370 "Interrupt process PROCESS. May be process or name of one.\n\
3371 PROCESS may be a process, a buffer, or the name of a process or buffer.\n\
3372 nil or no arg means current buffer's process.\n\
3373 Second arg CURRENT-GROUP non-nil means send signal to\n\
3374 the current process-group of the process's controlling terminal\n\
3375 rather than to the process's own process group.\n\
3376 If the process is a shell, this means interrupt current subjob\n\
3377 rather than the shell.")
3378 (process
, current_group
)
3379 Lisp_Object process
, current_group
;
3381 process_send_signal (process
, SIGINT
, current_group
, 0);
3385 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
3386 "Kill process PROCESS. May be process or name of one.\n\
3387 See function `interrupt-process' for more details on usage.")
3388 (process
, current_group
)
3389 Lisp_Object process
, current_group
;
3391 process_send_signal (process
, SIGKILL
, current_group
, 0);
3395 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
3396 "Send QUIT signal to process PROCESS. May be process or name of one.\n\
3397 See function `interrupt-process' for more details on usage.")
3398 (process
, current_group
)
3399 Lisp_Object process
, current_group
;
3401 process_send_signal (process
, SIGQUIT
, current_group
, 0);
3405 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
3406 "Stop process PROCESS. May be process or name of one.\n\
3407 See function `interrupt-process' for more details on usage.")
3408 (process
, current_group
)
3409 Lisp_Object process
, current_group
;
3412 error ("no SIGTSTP support");
3414 process_send_signal (process
, SIGTSTP
, current_group
, 0);
3419 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
3420 "Continue process PROCESS. May be process or name of one.\n\
3421 See function `interrupt-process' for more details on usage.")
3422 (process
, current_group
)
3423 Lisp_Object process
, current_group
;
3426 process_send_signal (process
, SIGCONT
, current_group
, 0);
3428 error ("no SIGCONT support");
3433 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
3434 2, 2, "nProcess number: \nnSignal code: ",
3435 "Send the process with process id PID the signal with code SIGCODE.\n\
3436 PID must be an integer. The process need not be a child of this Emacs.\n\
3437 SIGCODE may be an integer, or a symbol whose name is a signal name.")
3439 Lisp_Object pid
, sigcode
;
3441 CHECK_NUMBER (pid
, 0);
3443 #define handle_signal(NAME, VALUE) \
3444 else if (!strcmp (name, NAME)) \
3445 XSETINT (sigcode, VALUE)
3447 if (INTEGERP (sigcode
))
3451 unsigned char *name
;
3453 CHECK_SYMBOL (sigcode
, 1);
3454 name
= XSYMBOL (sigcode
)->name
->data
;
3459 handle_signal ("SIGHUP", SIGHUP
);
3462 handle_signal ("SIGINT", SIGINT
);
3465 handle_signal ("SIGQUIT", SIGQUIT
);
3468 handle_signal ("SIGILL", SIGILL
);
3471 handle_signal ("SIGABRT", SIGABRT
);
3474 handle_signal ("SIGEMT", SIGEMT
);
3477 handle_signal ("SIGKILL", SIGKILL
);
3480 handle_signal ("SIGFPE", SIGFPE
);
3483 handle_signal ("SIGBUS", SIGBUS
);
3486 handle_signal ("SIGSEGV", SIGSEGV
);
3489 handle_signal ("SIGSYS", SIGSYS
);
3492 handle_signal ("SIGPIPE", SIGPIPE
);
3495 handle_signal ("SIGALRM", SIGALRM
);
3498 handle_signal ("SIGTERM", SIGTERM
);
3501 handle_signal ("SIGURG", SIGURG
);
3504 handle_signal ("SIGSTOP", SIGSTOP
);
3507 handle_signal ("SIGTSTP", SIGTSTP
);
3510 handle_signal ("SIGCONT", SIGCONT
);
3513 handle_signal ("SIGCHLD", SIGCHLD
);
3516 handle_signal ("SIGTTIN", SIGTTIN
);
3519 handle_signal ("SIGTTOU", SIGTTOU
);
3522 handle_signal ("SIGIO", SIGIO
);
3525 handle_signal ("SIGXCPU", SIGXCPU
);
3528 handle_signal ("SIGXFSZ", SIGXFSZ
);
3531 handle_signal ("SIGVTALRM", SIGVTALRM
);
3534 handle_signal ("SIGPROF", SIGPROF
);
3537 handle_signal ("SIGWINCH", SIGWINCH
);
3540 handle_signal ("SIGINFO", SIGINFO
);
3543 handle_signal ("SIGUSR1", SIGUSR1
);
3546 handle_signal ("SIGUSR2", SIGUSR2
);
3549 error ("Undefined signal name %s", name
);
3552 #undef handle_signal
3554 return make_number (kill (XINT (pid
), XINT (sigcode
)));
3557 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
3558 "Make PROCESS see end-of-file in its input.\n\
3559 Eof comes after any text already sent to it.\n\
3560 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
3561 nil, indicating the current buffer's process.\n\
3562 If PROCESS is a network connection, or is a process communicating\n\
3563 through a pipe (as opposed to a pty), then you cannot send any more\n\
3564 text to PROCESS after you call this function.")
3566 Lisp_Object process
;
3570 proc
= get_process (process
);
3572 /* Make sure the process is really alive. */
3573 if (! NILP (XPROCESS (proc
)->raw_status_low
))
3574 update_status (XPROCESS (proc
));
3575 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
3576 error ("Process %s not running", XSTRING (XPROCESS (proc
)->name
)->data
);
3579 send_process (proc
, "\032", 1, Qnil
); /* ^z */
3581 if (!NILP (XPROCESS (proc
)->pty_flag
))
3582 send_process (proc
, "\004", 1, Qnil
);
3585 close (XINT (XPROCESS (proc
)->outfd
));
3586 XSETINT (XPROCESS (proc
)->outfd
, open (NULL_DEVICE
, O_WRONLY
));
3592 /* Kill all processes associated with `buffer'.
3593 If `buffer' is nil, kill all processes */
3595 kill_buffer_processes (buffer
)
3598 Lisp_Object tail
, proc
;
3600 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3602 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
3603 if (GC_PROCESSP (proc
)
3604 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
3606 if (NETCONN_P (proc
))
3607 Fdelete_process (proc
);
3608 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
3609 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
3614 /* On receipt of a signal that a child status has changed,
3615 loop asking about children with changed statuses until
3616 the system says there are no more.
3617 All we do is change the status;
3618 we do not run sentinels or print notifications.
3619 That is saved for the next time keyboard input is done,
3620 in order to avoid timing errors. */
3622 /** WARNING: this can be called during garbage collection.
3623 Therefore, it must not be fooled by the presence of mark bits in
3626 /** USG WARNING: Although it is not obvious from the documentation
3627 in signal(2), on a USG system the SIGCLD handler MUST NOT call
3628 signal() before executing at least one wait(), otherwise the handler
3629 will be called again, resulting in an infinite loop. The relevant
3630 portion of the documentation reads "SIGCLD signals will be queued
3631 and the signal-catching function will be continually reentered until
3632 the queue is empty". Invoking signal() causes the kernel to reexamine
3633 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
3636 sigchld_handler (signo
)
3639 int old_errno
= errno
;
3641 register struct Lisp_Process
*p
;
3642 extern EMACS_TIME
*input_available_clear_time
;
3646 sigheld
|= sigbit (SIGCHLD
);
3658 #endif /* no WUNTRACED */
3659 /* Keep trying to get a status until we get a definitive result. */
3663 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
3665 while (pid
<= 0 && errno
== EINTR
);
3669 /* A real failure. We have done all our job, so return. */
3671 /* USG systems forget handlers when they are used;
3672 must reestablish each time */
3673 #if defined (USG) && !defined (POSIX_SIGNALS)
3674 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
3677 sigheld
&= ~sigbit (SIGCHLD
);
3685 #endif /* no WNOHANG */
3687 /* Find the process that signaled us, and record its status. */
3690 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3692 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
3693 p
= XPROCESS (proc
);
3694 if (EQ (p
->childp
, Qt
) && XFASTINT (p
->pid
) == pid
)
3699 /* Look for an asynchronous process whose pid hasn't been filled
3702 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3704 proc
= XCONS (XCONS (tail
)->car
)->cdr
;
3705 p
= XPROCESS (proc
);
3706 if (INTEGERP (p
->pid
) && XINT (p
->pid
) == -1)
3711 /* Change the status of the process that was found. */
3714 union { int i
; WAITTYPE wt
; } u
;
3715 int clear_desc_flag
= 0;
3717 XSETINT (p
->tick
, ++process_tick
);
3719 XSETINT (p
->raw_status_low
, u
.i
& 0xffff);
3720 XSETINT (p
->raw_status_high
, u
.i
>> 16);
3722 /* If process has terminated, stop waiting for its output. */
3723 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
3724 && XINT (p
->infd
) >= 0)
3725 clear_desc_flag
= 1;
3727 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
3728 if (clear_desc_flag
)
3730 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
3731 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
3734 /* Tell wait_reading_process_input that it needs to wake up and
3736 if (input_available_clear_time
)
3737 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
3740 /* There was no asynchronous process found for that id. Check
3741 if we have a synchronous process. */
3744 synch_process_alive
= 0;
3746 /* Report the status of the synchronous process. */
3748 synch_process_retcode
= WRETCODE (w
);
3749 else if (WIFSIGNALED (w
))
3751 int code
= WTERMSIG (w
);
3757 /* Suppress warning if the table has const char *. */
3758 signame
= (char *) sys_siglist
[code
];
3760 signame
= sys_errlist
[code
];
3764 signame
= "unknown";
3766 synch_process_death
= signame
;
3769 /* Tell wait_reading_process_input that it needs to wake up and
3771 if (input_available_clear_time
)
3772 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
3775 /* On some systems, we must return right away.
3776 If any more processes want to signal us, we will
3778 Otherwise (on systems that have WNOHANG), loop around
3779 to use up all the processes that have something to tell us. */
3780 #if defined (USG) && ! (defined (HPUX) && defined (WNOHANG)) || defined (WINDOWSNT)
3781 #if defined (USG) && ! defined (POSIX_SIGNALS)
3782 signal (signo
, sigchld_handler
);
3786 #endif /* USG, but not HPUX with WNOHANG */
3792 exec_sentinel_unwind (data
)
3795 XPROCESS (XCONS (data
)->car
)->sentinel
= XCONS (data
)->cdr
;
3800 exec_sentinel_error_handler (error
)
3803 cmd_error_internal (error
, "error in process sentinel: ");
3805 update_echo_area ();
3806 Fsleep_for (make_number (2), Qnil
);
3810 exec_sentinel (proc
, reason
)
3811 Lisp_Object proc
, reason
;
3813 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
3814 register struct Lisp_Process
*p
= XPROCESS (proc
);
3815 int count
= specpdl_ptr
- specpdl
;
3816 int outer_running_asynch_code
= running_asynch_code
;
3818 /* No need to gcpro these, because all we do with them later
3819 is test them for EQness, and none of them should be a string. */
3820 odeactivate
= Vdeactivate_mark
;
3821 XSETBUFFER (obuffer
, current_buffer
);
3822 okeymap
= current_buffer
->keymap
;
3824 sentinel
= p
->sentinel
;
3825 if (NILP (sentinel
))
3828 /* Zilch the sentinel while it's running, to avoid recursive invocations;
3829 assure that it gets restored no matter how the sentinel exits. */
3831 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
3832 /* Inhibit quit so that random quits don't screw up a running filter. */
3833 specbind (Qinhibit_quit
, Qt
);
3834 specbind (Qlast_nonmenu_event
, Qt
);
3836 /* In case we get recursively called,
3837 and we already saved the match data nonrecursively,
3838 save the same match data in safely recursive fashion. */
3839 if (outer_running_asynch_code
)
3842 tem
= Fmatch_data (Qnil
, Qnil
);
3843 restore_match_data ();
3844 record_unwind_protect (Fstore_match_data
, Fmatch_data (Qnil
, Qnil
));
3845 Fstore_match_data (tem
);
3848 /* For speed, if a search happens within this code,
3849 save the match data in a special nonrecursive fashion. */
3850 running_asynch_code
= 1;
3852 internal_condition_case_1 (read_process_output_call
,
3854 Fcons (proc
, Fcons (reason
, Qnil
))),
3855 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
3856 exec_sentinel_error_handler
);
3858 /* If we saved the match data nonrecursively, restore it now. */
3859 restore_match_data ();
3860 running_asynch_code
= outer_running_asynch_code
;
3862 Vdeactivate_mark
= odeactivate
;
3864 if (! EQ (Fcurrent_buffer (), obuffer
)
3865 || ! EQ (current_buffer
->keymap
, okeymap
))
3867 /* But do it only if the caller is actually going to read events.
3868 Otherwise there's no need to make him wake up, and it could
3869 cause trouble (for example it would make Fsit_for return). */
3870 if (waiting_for_user_input_p
== -1)
3871 record_asynch_buffer_change ();
3873 unbind_to (count
, Qnil
);
3876 /* Report all recent events of a change in process status
3877 (either run the sentinel or output a message).
3878 This is done while Emacs is waiting for keyboard input. */
3882 register Lisp_Object proc
, buffer
;
3883 Lisp_Object tail
, msg
;
3884 struct gcpro gcpro1
, gcpro2
;
3888 /* We need to gcpro tail; if read_process_output calls a filter
3889 which deletes a process and removes the cons to which tail points
3890 from Vprocess_alist, and then causes a GC, tail is an unprotected
3894 /* Set this now, so that if new processes are created by sentinels
3895 that we run, we get called again to handle their status changes. */
3896 update_tick
= process_tick
;
3898 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
3901 register struct Lisp_Process
*p
;
3903 proc
= Fcdr (Fcar (tail
));
3904 p
= XPROCESS (proc
);
3906 if (XINT (p
->tick
) != XINT (p
->update_tick
))
3908 XSETINT (p
->update_tick
, XINT (p
->tick
));
3910 /* If process is still active, read any output that remains. */
3911 while (! EQ (p
->filter
, Qt
)
3912 && XINT (p
->infd
) >= 0
3913 && read_process_output (proc
, XINT (p
->infd
)) > 0);
3917 /* Get the text to use for the message. */
3918 if (!NILP (p
->raw_status_low
))
3920 msg
= status_message (p
->status
);
3922 /* If process is terminated, deactivate it or delete it. */
3924 if (CONSP (p
->status
))
3925 symbol
= XCONS (p
->status
)->car
;
3927 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
3928 || EQ (symbol
, Qclosed
))
3930 if (delete_exited_processes
)
3931 remove_process (proc
);
3933 deactivate_process (proc
);
3936 /* The actions above may have further incremented p->tick.
3937 So set p->update_tick again
3938 so that an error in the sentinel will not cause
3939 this code to be run again. */
3940 XSETINT (p
->update_tick
, XINT (p
->tick
));
3941 /* Now output the message suitably. */
3942 if (!NILP (p
->sentinel
))
3943 exec_sentinel (proc
, msg
);
3944 /* Don't bother with a message in the buffer
3945 when a process becomes runnable. */
3946 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
3948 Lisp_Object ro
, tem
;
3949 struct buffer
*old
= current_buffer
;
3952 ro
= XBUFFER (buffer
)->read_only
;
3954 /* Avoid error if buffer is deleted
3955 (probably that's why the process is dead, too) */
3956 if (NILP (XBUFFER (buffer
)->name
))
3958 Fset_buffer (buffer
);
3960 /* Insert new output into buffer
3961 at the current end-of-output marker,
3962 thus preserving logical ordering of input and output. */
3963 if (XMARKER (p
->mark
)->buffer
)
3964 SET_PT (marker_position (p
->mark
));
3968 opoint
+= XSTRING (msg
)->size
+ XSTRING (p
->name
)->size
+ 10;
3970 tem
= current_buffer
->read_only
;
3971 current_buffer
->read_only
= Qnil
;
3972 insert_string ("\nProcess ");
3973 Finsert (1, &p
->name
);
3974 insert_string (" ");
3976 current_buffer
->read_only
= tem
;
3977 Fset_marker (p
->mark
, make_number (PT
), p
->buffer
);
3980 set_buffer_internal (old
);
3985 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
3986 redisplay_preserve_echo_area ();
3992 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
3993 Sset_process_coding_system
, 1, 3, 0,
3994 "Set coding-systems of PROCESS to DECODING (input from the process) and\n\
3995 ENCODING (output to the process).")
3996 (proc
, decoding
, encoding
)
3997 register Lisp_Object proc
, decoding
, encoding
;
3999 register struct Lisp_Process
*p
;
4001 CHECK_PROCESS (proc
, 0);
4002 p
= XPROCESS (proc
);
4003 if (XINT (p
->infd
) < 0)
4004 error ("Input file descriptor of %s closed", XSTRING (p
->name
)->data
);
4005 if (XINT (p
->outfd
) < 0)
4006 error ("Output file descriptor of %s closed", XSTRING (p
->name
)->data
);
4008 p
->decode_coding_system
= Fcheck_coding_system (decoding
);
4009 p
->encode_coding_system
= Fcheck_coding_system (encoding
);
4010 setup_coding_system (decoding
,
4011 proc_decode_coding_system
[XINT (p
->infd
)]);
4012 setup_coding_system (encoding
,
4013 proc_encode_coding_system
[XINT (p
->outfd
)]);
4018 DEFUN ("process-coding-system",
4019 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
4020 "Return a cons of coding-system for decoding and encoding of PROCESS.")
4022 register Lisp_Object proc
;
4024 CHECK_PROCESS (proc
, 0);
4025 return Fcons (XPROCESS (proc
)->decode_coding_system
,
4026 XPROCESS (proc
)->encode_coding_system
);
4029 /* The first time this is called, assume keyboard input comes from DESC
4030 instead of from where we used to expect it.
4031 Subsequent calls mean assume input keyboard can come from DESC
4032 in addition to other places. */
4034 static int add_keyboard_wait_descriptor_called_flag
;
4037 add_keyboard_wait_descriptor (desc
)
4040 if (! add_keyboard_wait_descriptor_called_flag
)
4041 FD_CLR (0, &input_wait_mask
);
4042 add_keyboard_wait_descriptor_called_flag
= 1;
4043 FD_SET (desc
, &input_wait_mask
);
4044 if (desc
> max_keyboard_desc
)
4045 max_keyboard_desc
= desc
;
4048 /* From now on, do not expect DESC to give keyboard input. */
4051 delete_keyboard_wait_descriptor (desc
)
4055 int lim
= max_keyboard_desc
;
4057 FD_CLR (desc
, &input_wait_mask
);
4059 if (desc
== max_keyboard_desc
)
4060 for (fd
= 0; fd
< lim
; fd
++)
4061 if (FD_ISSET (fd
, &input_wait_mask
)
4062 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
4063 max_keyboard_desc
= fd
;
4066 /* Return nonzero if *MASK has a bit set
4067 that corresponds to one of the keyboard input descriptors. */
4070 keyboard_bit_set (mask
)
4075 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
4076 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
4077 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
4089 if (! noninteractive
|| initialized
)
4091 signal (SIGCHLD
, sigchld_handler
);
4094 FD_ZERO (&input_wait_mask
);
4095 FD_ZERO (&non_keyboard_wait_mask
);
4096 max_process_desc
= 0;
4098 FD_SET (0, &input_wait_mask
);
4100 Vprocess_alist
= Qnil
;
4101 for (i
= 0; i
< MAXDESC
; i
++)
4103 chan_process
[i
] = Qnil
;
4104 proc_buffered_char
[i
] = -1;
4106 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
4107 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
4112 Qprocessp
= intern ("processp");
4113 staticpro (&Qprocessp
);
4114 Qrun
= intern ("run");
4116 Qstop
= intern ("stop");
4118 Qsignal
= intern ("signal");
4119 staticpro (&Qsignal
);
4121 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
4124 Qexit = intern ("exit");
4125 staticpro (&Qexit); */
4127 Qopen
= intern ("open");
4129 Qclosed
= intern ("closed");
4130 staticpro (&Qclosed
);
4132 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
4133 staticpro (&Qlast_nonmenu_event
);
4135 staticpro (&Vprocess_alist
);
4137 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
4138 "*Non-nil means delete processes immediately when they exit.\n\
4139 nil means don't delete them until `list-processes' is run.");
4141 delete_exited_processes
= 1;
4143 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
4144 "Control type of device used to communicate with subprocesses.\n\
4145 Values are nil to use a pipe, or t or `pty' to use a pty.\n\
4146 The value has no effect if the system has no ptys or if all ptys are busy:\n\
4147 then a pipe is used in any case.\n\
4148 The value takes effect when `start-process' is called.");
4149 Vprocess_connection_type
= Qt
;
4151 defsubr (&Sprocessp
);
4152 defsubr (&Sget_process
);
4153 defsubr (&Sget_buffer_process
);
4154 defsubr (&Sdelete_process
);
4155 defsubr (&Sprocess_status
);
4156 defsubr (&Sprocess_exit_status
);
4157 defsubr (&Sprocess_id
);
4158 defsubr (&Sprocess_name
);
4159 defsubr (&Sprocess_tty_name
);
4160 defsubr (&Sprocess_command
);
4161 defsubr (&Sset_process_buffer
);
4162 defsubr (&Sprocess_buffer
);
4163 defsubr (&Sprocess_mark
);
4164 defsubr (&Sset_process_filter
);
4165 defsubr (&Sprocess_filter
);
4166 defsubr (&Sset_process_sentinel
);
4167 defsubr (&Sprocess_sentinel
);
4168 defsubr (&Sset_process_window_size
);
4169 defsubr (&Sprocess_kill_without_query
);
4170 defsubr (&Sprocess_contact
);
4171 defsubr (&Slist_processes
);
4172 defsubr (&Sprocess_list
);
4173 defsubr (&Sstart_process
);
4175 defsubr (&Sopen_network_stream
);
4176 #endif /* HAVE_SOCKETS */
4177 defsubr (&Saccept_process_output
);
4178 defsubr (&Sprocess_send_region
);
4179 defsubr (&Sprocess_send_string
);
4180 defsubr (&Sinterrupt_process
);
4181 defsubr (&Skill_process
);
4182 defsubr (&Squit_process
);
4183 defsubr (&Sstop_process
);
4184 defsubr (&Scontinue_process
);
4185 defsubr (&Sprocess_send_eof
);
4186 defsubr (&Ssignal_process
);
4187 defsubr (&Swaiting_for_user_input_p
);
4188 /* defsubr (&Sprocess_connection); */
4189 defsubr (&Sset_process_coding_system
);
4190 defsubr (&Sprocess_coding_system
);
4194 #else /* not subprocesses */
4196 #include <sys/types.h>
4200 #include "systime.h"
4201 #include "termopts.h"
4202 #include "sysselect.h"
4204 extern int frame_garbaged
;
4206 extern EMACS_TIME
timer_check ();
4207 extern int timers_run
;
4209 /* As described above, except assuming that there are no subprocesses:
4211 Wait for timeout to elapse and/or keyboard input to be available.
4214 timeout in seconds, or
4215 zero for no limit, or
4216 -1 means gobble data immediately available but don't wait for any.
4218 read_kbd is a Lisp_Object:
4219 0 to ignore keyboard input, or
4220 1 to return when input is available, or
4221 -1 means caller will actually read the input, so don't throw to
4223 a cons cell, meaning wait until its car is non-nil
4224 (and gobble terminal input into the buffer if any arrives), or
4225 We know that read_kbd will never be a Lisp_Process, since
4226 `subprocesses' isn't defined.
4228 do_display != 0 means redisplay should be done to show subprocess
4229 output that arrives.
4231 Return true iff we received input from any process. */
4234 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
4235 int time_limit
, microsecs
;
4236 Lisp_Object read_kbd
;
4239 EMACS_TIME end_time
, timeout
;
4240 SELECT_TYPE waitchannels
;
4242 Lisp_Object
*wait_for_cell
= 0;
4244 /* If waiting for non-nil in a cell, record where. */
4245 if (CONSP (read_kbd
))
4247 wait_for_cell
= &XCONS (read_kbd
)->car
;
4248 XSETFASTINT (read_kbd
, 0);
4251 /* What does time_limit really mean? */
4252 if (time_limit
|| microsecs
)
4254 if (time_limit
== -1)
4255 /* In fact, it's zero. */
4256 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4258 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4260 /* How far in the future is that? */
4261 EMACS_GET_TIME (end_time
);
4262 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4265 /* It's infinite. */
4266 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4268 /* Turn off periodic alarms (in case they are in use)
4269 because the select emulator uses alarms. */
4275 int timeout_reduced_for_timers
= 0;
4277 /* If calling from keyboard input, do not quit
4278 since we want to return C-g as an input character.
4279 Otherwise, do pending quit if requested. */
4280 if (XINT (read_kbd
) >= 0)
4283 /* Exit now if the cell we're waiting for became non-nil. */
4284 if (wait_for_cell
&& ! NILP (*wait_for_cell
))
4287 /* Compute time from now till when time limit is up */
4288 /* Exit if already run out */
4289 if (time_limit
> 0 || microsecs
)
4291 EMACS_GET_TIME (timeout
);
4292 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4293 if (EMACS_TIME_NEG_P (timeout
))
4297 /* If our caller will not immediately handle keyboard events,
4298 run timer events directly.
4299 (Callers that will immediately read keyboard events
4300 call timer_delay on their own.) */
4301 if (! wait_for_cell
)
4303 EMACS_TIME timer_delay
;
4307 old_timers_run
= timers_run
;
4308 timer_delay
= timer_check (1);
4309 if (timers_run
!= old_timers_run
&& do_display
)
4311 redisplay_preserve_echo_area ();
4312 /* We must retry, since a timer may have requeued itself
4313 and that could alter the time delay. */
4317 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4319 EMACS_TIME difference
;
4320 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4321 if (EMACS_TIME_NEG_P (difference
))
4323 timeout
= timer_delay
;
4324 timeout_reduced_for_timers
= 1;
4329 /* Cause C-g and alarm signals to take immediate action,
4330 and cause input available signals to zero out timeout. */
4331 if (XINT (read_kbd
) < 0)
4332 set_waiting_for_input (&timeout
);
4334 /* Wait till there is something to do. */
4336 if (! XINT (read_kbd
) && wait_for_cell
== 0)
4337 FD_ZERO (&waitchannels
);
4339 FD_SET (0, &waitchannels
);
4341 /* If a frame has been newly mapped and needs updating,
4342 reprocess its display stuff. */
4343 if (frame_garbaged
&& do_display
)
4345 clear_waiting_for_input ();
4346 redisplay_preserve_echo_area ();
4347 if (XINT (read_kbd
) < 0)
4348 set_waiting_for_input (&timeout
);
4351 if (XINT (read_kbd
) && detect_input_pending ())
4354 FD_ZERO (&waitchannels
);
4357 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
4362 /* Make C-g and alarm signals set flags again */
4363 clear_waiting_for_input ();
4365 /* If we woke up due to SIGWINCH, actually change size now. */
4366 do_pending_window_change ();
4368 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4369 /* We waited the full specified time, so return now. */
4374 /* If the system call was interrupted, then go around the
4376 if (xerrno
== EINTR
)
4377 FD_ZERO (&waitchannels
);
4379 error ("select error: %s", strerror (xerrno
));
4382 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
4383 /* System sometimes fails to deliver SIGIO. */
4384 kill (getpid (), SIGIO
);
4387 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
4388 kill (getpid (), SIGIO
);
4391 /* Check for keyboard input */
4393 if ((XINT (read_kbd
) != 0)
4394 && detect_input_pending_run_timers (do_display
))
4396 swallow_events (do_display
);
4397 if (detect_input_pending_run_timers (do_display
))
4401 /* If wait_for_cell. check for keyboard input
4402 but don't run any timers.
4403 ??? (It seems wrong to me to check for keyboard
4404 input at all when wait_for_cell, but the code
4405 has been this way since July 1994.
4406 Try changing this after version 19.31.) */
4408 && detect_input_pending ())
4410 swallow_events (do_display
);
4411 if (detect_input_pending ())
4415 /* Exit now if the cell we're waiting for became non-nil. */
4416 if (wait_for_cell
&& ! NILP (*wait_for_cell
))
4426 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
4427 /* Don't confuse make-docfile by having two doc strings for this function.
4428 make-docfile does not pay attention to #if, for good reason! */
4431 register Lisp_Object name
;
4436 /* Kill all processes associated with `buffer'.
4437 If `buffer' is nil, kill all processes.
4438 Since we have no subprocesses, this does nothing. */
4440 kill_buffer_processes (buffer
)
4451 defsubr (&Sget_buffer_process
);
4455 #endif /* not subprocesses */