1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999,
3 2001, 2002 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. */
23 #define _GNU_SOURCE /* to get strsignal declared with glibc 2 */
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 */
47 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
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 GNU/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"
107 #include "keyboard.h"
109 #include "blockinput.h"
110 #include "dispextern.h"
111 #include "composite.h"
114 Lisp_Object Qprocessp
;
115 Lisp_Object Qrun
, Qstop
, Qsignal
;
116 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
;
117 Lisp_Object Qlast_nonmenu_event
;
118 /* Qexit is declared and initialized in eval.c. */
120 /* a process object is a network connection when its childp field is neither
121 Qt nor Qnil but is instead a cons cell (HOSTNAME PORTNUM). */
124 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
126 #define NETCONN_P(p) 0
127 #endif /* HAVE_SOCKETS */
129 /* Define first descriptor number available for subprocesses. */
131 #define FIRST_PROC_DESC 1
133 #define FIRST_PROC_DESC 3
136 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
139 #if !defined (SIGCHLD) && defined (SIGCLD)
140 #define SIGCHLD SIGCLD
143 #include "syssignal.h"
147 extern void set_waiting_for_input
P_ ((EMACS_TIME
*));
153 extern char *sys_errlist
[];
160 /* t means use pty, nil means use a pipe,
161 maybe other values to come. */
162 static Lisp_Object Vprocess_connection_type
;
166 #include <sys/socket.h>
170 /* These next two vars are non-static since sysdep.c uses them in the
171 emulation of `select'. */
172 /* Number of events of change of status of a process. */
174 /* Number of events for which the user or sentinel has been notified. */
177 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
179 #ifdef BROKEN_NON_BLOCKING_CONNECT
180 #undef NON_BLOCKING_CONNECT
182 #ifndef NON_BLOCKING_CONNECT
185 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
186 #if defined (O_NONBLOCK) || defined (O_NDELAY)
187 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
188 #define NON_BLOCKING_CONNECT
189 #endif /* EWOULDBLOCK || EINPROGRESS */
190 #endif /* O_NONBLOCK || O_NDELAY */
191 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
192 #endif /* HAVE_SELECT */
193 #endif /* HAVE_SOCKETS */
194 #endif /* NON_BLOCKING_CONNECT */
195 #endif /* BROKEN_NON_BLOCKING_CONNECT */
198 #undef NON_BLOCKING_CONNECT
201 #include "sysselect.h"
203 extern int keyboard_bit_set
P_ ((SELECT_TYPE
*));
205 /* If we support a window system, turn on the code to poll periodically
206 to detect C-g. It isn't actually used when doing interrupt input. */
207 #ifdef HAVE_WINDOW_SYSTEM
208 #define POLL_FOR_INPUT
211 /* Mask of bits indicating the descriptors that we wait for input on. */
213 static SELECT_TYPE input_wait_mask
;
215 /* Mask that excludes keyboard input descriptor (s). */
217 static SELECT_TYPE non_keyboard_wait_mask
;
219 /* Mask that excludes process input descriptor (s). */
221 static SELECT_TYPE non_process_wait_mask
;
223 /* Mask of bits indicating the descriptors that we wait for connect to
224 complete on. Once they complete, they are removed from this mask
225 and added to the input_wait_mask and non_keyboard_wait_mask. */
227 static SELECT_TYPE connect_wait_mask
;
229 /* Number of bits set in connect_wait_mask. */
230 static int num_pending_connects
;
232 /* The largest descriptor currently in use for a process object. */
233 static int max_process_desc
;
235 /* The largest descriptor currently in use for keyboard input. */
236 static int max_keyboard_desc
;
238 /* Nonzero means delete a process right away if it exits. */
239 static int delete_exited_processes
;
241 /* Indexed by descriptor, gives the process (if any) for that descriptor */
242 Lisp_Object chan_process
[MAXDESC
];
244 /* Alist of elements (NAME . PROCESS) */
245 Lisp_Object Vprocess_alist
;
247 /* Buffered-ahead input char from process, indexed by channel.
248 -1 means empty (no char is buffered).
249 Used on sys V where the only way to tell if there is any
250 output from the process is to read at least one char.
251 Always -1 on systems that support FIONREAD. */
253 /* Don't make static; need to access externally. */
254 int proc_buffered_char
[MAXDESC
];
256 /* Table of `struct coding-system' for each process. */
257 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
258 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
260 static Lisp_Object
get_process ();
261 static void exec_sentinel ();
263 extern EMACS_TIME
timer_check ();
264 extern int timers_run
;
266 /* Maximum number of bytes to send to a pty without an eof. */
267 static int pty_max_bytes
;
269 extern Lisp_Object Vfile_name_coding_system
, Vdefault_file_name_coding_system
;
272 /* The file name of the pty opened by allocate_pty. */
274 static char pty_name
[24];
277 /* Compute the Lisp form of the process status, p->status, from
278 the numeric status that was returned by `wait'. */
280 Lisp_Object
status_convert ();
284 struct Lisp_Process
*p
;
286 union { int i
; WAITTYPE wt
; } u
;
287 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
288 p
->status
= status_convert (u
.wt
);
289 p
->raw_status_low
= Qnil
;
290 p
->raw_status_high
= Qnil
;
293 /* Convert a process status word in Unix format to
294 the list that we use internally. */
301 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
302 else if (WIFEXITED (w
))
303 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
304 WCOREDUMP (w
) ? Qt
: Qnil
));
305 else if (WIFSIGNALED (w
))
306 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
307 WCOREDUMP (w
) ? Qt
: Qnil
));
312 /* Given a status-list, extract the three pieces of information
313 and store them individually through the three pointers. */
316 decode_status (l
, symbol
, code
, coredump
)
334 *code
= XFASTINT (XCAR (tem
));
336 *coredump
= !NILP (tem
);
340 /* Return a string describing a process status list. */
343 status_message (status
)
348 Lisp_Object string
, string2
;
350 decode_status (status
, &symbol
, &code
, &coredump
);
352 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
355 synchronize_system_messages_locale ();
356 signame
= strsignal (code
);
359 string
= build_string (signame
);
360 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
361 XSTRING (string
)->data
[0] = DOWNCASE (XSTRING (string
)->data
[0]);
362 return concat2 (string
, string2
);
364 else if (EQ (symbol
, Qexit
))
367 return build_string ("finished\n");
368 string
= Fnumber_to_string (make_number (code
));
369 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
370 return concat2 (build_string ("exited abnormally with code "),
371 concat2 (string
, string2
));
373 else if (EQ (symbol
, Qfailed
))
375 string
= Fnumber_to_string (make_number (code
));
376 string2
= build_string ("\n");
377 return concat2 (build_string ("failed with code "),
378 concat2 (string
, string2
));
381 return Fcopy_sequence (Fsymbol_name (symbol
));
386 /* Open an available pty, returning a file descriptor.
387 Return -1 on failure.
388 The file name of the terminal corresponding to the pty
389 is left in the variable pty_name. */
398 /* Some systems name their pseudoterminals so that there are gaps in
399 the usual sequence - for example, on HP9000/S700 systems, there
400 are no pseudoterminals with names ending in 'f'. So we wait for
401 three failures in a row before deciding that we've reached the
403 int failed_count
= 0;
408 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
409 for (i
= 0; i
< 16; i
++)
412 #ifdef PTY_NAME_SPRINTF
415 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
416 #endif /* no PTY_NAME_SPRINTF */
420 #else /* no PTY_OPEN */
422 /* Unusual IRIS code */
423 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
426 if (fstat (fd
, &stb
) < 0)
429 if (stat (pty_name
, &stb
) < 0)
432 if (failed_count
>= 3)
438 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
440 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
442 #endif /* not IRIS */
443 #endif /* no PTY_OPEN */
447 /* check to make certain that both sides are available
448 this avoids a nasty yet stupid bug in rlogins */
449 #ifdef PTY_TTY_NAME_SPRINTF
452 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
453 #endif /* no PTY_TTY_NAME_SPRINTF */
455 if (access (pty_name
, 6) != 0)
458 #if !defined(IRIS) && !defined(__sgi)
464 #endif /* not UNIPLUS */
471 #endif /* HAVE_PTYS */
477 register Lisp_Object val
, tem
, name1
;
478 register struct Lisp_Process
*p
;
482 p
= allocate_process ();
484 XSETINT (p
->infd
, -1);
485 XSETINT (p
->outfd
, -1);
486 XSETFASTINT (p
->pid
, 0);
487 XSETFASTINT (p
->tick
, 0);
488 XSETFASTINT (p
->update_tick
, 0);
489 p
->raw_status_low
= Qnil
;
490 p
->raw_status_high
= Qnil
;
492 p
->mark
= Fmake_marker ();
494 /* If name is already in use, modify it until it is unused. */
499 tem
= Fget_process (name1
);
500 if (NILP (tem
)) break;
501 sprintf (suffix
, "<%d>", i
);
502 name1
= concat2 (name
, build_string (suffix
));
506 XSETPROCESS (val
, p
);
507 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
512 remove_process (proc
)
513 register Lisp_Object proc
;
515 register Lisp_Object pair
;
517 pair
= Frassq (proc
, Vprocess_alist
);
518 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
520 deactivate_process (proc
);
523 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
524 doc
: /* Return t if OBJECT is a process. */)
528 return PROCESSP (object
) ? Qt
: Qnil
;
531 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
532 doc
: /* Return the process named NAME, or nil if there is none. */)
534 register Lisp_Object name
;
539 return Fcdr (Fassoc (name
, Vprocess_alist
));
542 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
543 doc
: /* Return the (or a) process associated with BUFFER.
544 BUFFER may be a buffer or the name of one. */)
546 register Lisp_Object buffer
;
548 register Lisp_Object buf
, tail
, proc
;
550 if (NILP (buffer
)) return Qnil
;
551 buf
= Fget_buffer (buffer
);
552 if (NILP (buf
)) return Qnil
;
554 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
556 proc
= Fcdr (Fcar (tail
));
557 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
563 /* This is how commands for the user decode process arguments. It
564 accepts a process, a process name, a buffer, a buffer name, or nil.
565 Buffers denote the first process in the buffer, and nil denotes the
570 register Lisp_Object name
;
572 register Lisp_Object proc
, obj
;
575 obj
= Fget_process (name
);
577 obj
= Fget_buffer (name
);
579 error ("Process %s does not exist", XSTRING (name
)->data
);
581 else if (NILP (name
))
582 obj
= Fcurrent_buffer ();
586 /* Now obj should be either a buffer object or a process object.
590 proc
= Fget_buffer_process (obj
);
592 error ("Buffer %s has no process", XSTRING (XBUFFER (obj
)->name
)->data
);
602 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
603 doc
: /* Delete PROCESS: kill it and forget about it immediately.
604 PROCESS may be a process, a buffer, the name of a process or buffer, or
605 nil, indicating the current buffer's process. */)
607 register Lisp_Object process
;
609 process
= get_process (process
);
610 XPROCESS (process
)->raw_status_low
= Qnil
;
611 XPROCESS (process
)->raw_status_high
= Qnil
;
612 if (NETCONN_P (process
))
614 XPROCESS (process
)->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
615 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
617 else if (XINT (XPROCESS (process
)->infd
) >= 0)
619 Fkill_process (process
, Qnil
);
620 /* Do this now, since remove_process will make sigchld_handler do nothing. */
621 XPROCESS (process
)->status
622 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
623 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
626 remove_process (process
);
630 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
631 doc
: /* Return the status of PROCESS.
632 The returned value is one of the following symbols:
633 run -- for a process that is running.
634 stop -- for a process stopped but continuable.
635 exit -- for a process that has exited.
636 signal -- for a process that has got a fatal signal.
637 open -- for a network stream connection that is open.
638 closed -- for a network stream connection that is closed.
639 connect -- when waiting for a non-blocking connection to complete.
640 failed -- when a non-blocking connection has failed.
641 nil -- if arg is a process name and no such process exists.
642 PROCESS may be a process, a buffer, the name of a process, or
643 nil, indicating the current buffer's process. */)
645 register Lisp_Object process
;
647 register struct Lisp_Process
*p
;
648 register Lisp_Object status
;
650 if (STRINGP (process
))
651 process
= Fget_process (process
);
653 process
= get_process (process
);
658 p
= XPROCESS (process
);
659 if (!NILP (p
->raw_status_low
))
663 status
= XCAR (status
);
664 if (NETCONN_P (process
))
666 if (EQ (status
, Qrun
))
668 else if (EQ (status
, Qexit
))
674 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
676 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
677 If PROCESS has not yet exited or died, return 0. */)
679 register Lisp_Object process
;
681 CHECK_PROCESS (process
);
682 if (!NILP (XPROCESS (process
)->raw_status_low
))
683 update_status (XPROCESS (process
));
684 if (CONSP (XPROCESS (process
)->status
))
685 return XCAR (XCDR (XPROCESS (process
)->status
));
686 return make_number (0);
689 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
690 doc
: /* Return the process id of PROCESS.
691 This is the pid of the Unix process which PROCESS uses or talks to.
692 For a network connection, this value is nil. */)
694 register Lisp_Object process
;
696 CHECK_PROCESS (process
);
697 return XPROCESS (process
)->pid
;
700 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
701 doc
: /* Return the name of PROCESS, as a string.
702 This is the name of the program invoked in PROCESS,
703 possibly modified to make it unique among process names. */)
705 register Lisp_Object process
;
707 CHECK_PROCESS (process
);
708 return XPROCESS (process
)->name
;
711 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
712 doc
: /* Return the command that was executed to start PROCESS.
713 This is a list of strings, the first string being the program executed
714 and the rest of the strings being the arguments given to it.
715 For a non-child channel, this is nil. */)
717 register Lisp_Object process
;
719 CHECK_PROCESS (process
);
720 return XPROCESS (process
)->command
;
723 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
724 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
725 This is the terminal that the process itself reads and writes on,
726 not the name of the pty that Emacs uses to talk with that terminal. */)
728 register Lisp_Object process
;
730 CHECK_PROCESS (process
);
731 return XPROCESS (process
)->tty_name
;
734 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
736 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
738 register Lisp_Object process
, buffer
;
740 CHECK_PROCESS (process
);
742 CHECK_BUFFER (buffer
);
743 XPROCESS (process
)->buffer
= buffer
;
747 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
749 doc
: /* Return the buffer PROCESS is associated with.
750 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
752 register Lisp_Object process
;
754 CHECK_PROCESS (process
);
755 return XPROCESS (process
)->buffer
;
758 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
760 doc
: /* Return the marker for the end of the last output from PROCESS. */)
762 register Lisp_Object process
;
764 CHECK_PROCESS (process
);
765 return XPROCESS (process
)->mark
;
768 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
770 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
771 t means stop accepting output from the process.
772 When a process has a filter, each time it does output
773 the entire string of output is passed to the filter.
774 The filter gets two arguments: the process and the string of output.
775 If the process has a filter, its buffer is not used for output. */)
777 register Lisp_Object process
, filter
;
779 struct Lisp_Process
*p
;
781 CHECK_PROCESS (process
);
782 p
= XPROCESS (process
);
784 /* Don't signal an error if the process' input file descriptor
785 is closed. This could make debugging Lisp more difficult,
786 for example when doing something like
788 (setq process (start-process ...))
790 (set-process-filter process ...) */
792 if (XINT (p
->infd
) >= 0)
796 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
797 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
799 else if (EQ (XPROCESS (process
)->filter
, Qt
))
801 FD_SET (XINT (p
->infd
), &input_wait_mask
);
802 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
810 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
812 doc
: /* Returns the filter function of PROCESS; nil if none.
813 See `set-process-filter' for more info on filter functions. */)
815 register Lisp_Object process
;
817 CHECK_PROCESS (process
);
818 return XPROCESS (process
)->filter
;
821 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
823 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
824 The sentinel is called as a function when the process changes state.
825 It gets two arguments: the process, and a string describing the change. */)
827 register Lisp_Object process
, sentinel
;
829 CHECK_PROCESS (process
);
830 XPROCESS (process
)->sentinel
= sentinel
;
834 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
836 doc
: /* Return the sentinel of PROCESS; nil if none.
837 See `set-process-sentinel' for more info on sentinels. */)
839 register Lisp_Object process
;
841 CHECK_PROCESS (process
);
842 return XPROCESS (process
)->sentinel
;
845 DEFUN ("set-process-window-size", Fset_process_window_size
,
846 Sset_process_window_size
, 3, 3, 0,
847 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
848 (process
, height
, width
)
849 register Lisp_Object process
, height
, width
;
851 CHECK_PROCESS (process
);
852 CHECK_NATNUM (height
);
853 CHECK_NATNUM (width
);
855 if (XINT (XPROCESS (process
)->infd
) < 0
856 || set_window_size (XINT (XPROCESS (process
)->infd
),
857 XINT (height
), XINT (width
)) <= 0)
863 DEFUN ("set-process-inherit-coding-system-flag",
864 Fset_process_inherit_coding_system_flag
,
865 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
866 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
867 If the second argument FLAG is non-nil, then the variable
868 `buffer-file-coding-system' of the buffer associated with PROCESS
869 will be bound to the value of the coding system used to decode
872 This is useful when the coding system specified for the process buffer
873 leaves either the character code conversion or the end-of-line conversion
874 unspecified, or if the coding system used to decode the process output
875 is more appropriate for saving the process buffer.
877 Binding the variable `inherit-process-coding-system' to non-nil before
878 starting the process is an alternative way of setting the inherit flag
879 for the process which will run. */)
881 register Lisp_Object process
, flag
;
883 CHECK_PROCESS (process
);
884 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
888 DEFUN ("process-inherit-coding-system-flag",
889 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
891 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
892 If this flag is t, `buffer-file-coding-system' of the buffer
893 associated with PROCESS will inherit the coding system used to decode
894 the process output. */)
896 register Lisp_Object process
;
898 CHECK_PROCESS (process
);
899 return XPROCESS (process
)->inherit_coding_system_flag
;
902 DEFUN ("process-kill-without-query", Fprocess_kill_without_query
,
903 Sprocess_kill_without_query
, 1, 2, 0,
904 doc
: /* Say no query needed if PROCESS is running when Emacs is exited.
905 Optional second argument if non-nil says to require a query.
906 Value is t if a query was formerly required. */)
908 register Lisp_Object process
, value
;
912 CHECK_PROCESS (process
);
913 tem
= XPROCESS (process
)->kill_without_query
;
914 XPROCESS (process
)->kill_without_query
= Fnull (value
);
919 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
921 doc
: /* Return the contact info of PROCESS; t for a real child.
922 For a net connection, the value is a cons cell of the form (HOST SERVICE). */)
924 register Lisp_Object process
;
926 CHECK_PROCESS (process
);
927 return XPROCESS (process
)->childp
;
930 #if 0 /* Turned off because we don't currently record this info
931 in the process. Perhaps add it. */
932 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
933 doc
: /* Return the connection type of PROCESS.
934 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
935 a socket connection. */)
939 return XPROCESS (process
)->type
;
946 register Lisp_Object tail
, tem
;
947 Lisp_Object proc
, minspace
, tem1
;
948 register struct Lisp_Process
*p
;
951 XSETFASTINT (minspace
, 1);
953 set_buffer_internal (XBUFFER (Vstandard_output
));
954 Fbuffer_disable_undo (Vstandard_output
);
956 current_buffer
->truncate_lines
= Qt
;
959 Proc Status Buffer Tty Command\n\
960 ---- ------ ------ --- -------\n", -1);
962 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
966 proc
= Fcdr (Fcar (tail
));
968 if (NILP (p
->childp
))
971 Finsert (1, &p
->name
);
972 Findent_to (make_number (13), minspace
);
974 if (!NILP (p
->raw_status_low
))
977 if (CONSP (p
->status
))
978 symbol
= XCAR (p
->status
);
981 if (EQ (symbol
, Qsignal
))
984 tem
= Fcar (Fcdr (p
->status
));
986 if (XINT (tem
) < NSIG
)
987 write_string (sys_errlist
[XINT (tem
)], -1);
990 Fprinc (symbol
, Qnil
);
992 else if (NETCONN_P (proc
))
994 if (EQ (symbol
, Qrun
))
995 write_string ("open", -1);
996 else if (EQ (symbol
, Qexit
))
997 write_string ("closed", -1);
999 Fprinc (symbol
, Qnil
);
1002 Fprinc (symbol
, Qnil
);
1004 if (EQ (symbol
, Qexit
))
1007 tem
= Fcar (Fcdr (p
->status
));
1010 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1011 write_string (tembuf
, -1);
1015 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
1016 remove_process (proc
);
1018 Findent_to (make_number (22), minspace
);
1019 if (NILP (p
->buffer
))
1020 insert_string ("(none)");
1021 else if (NILP (XBUFFER (p
->buffer
)->name
))
1022 insert_string ("(Killed)");
1024 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1026 Findent_to (make_number (37), minspace
);
1028 if (STRINGP (p
->tty_name
))
1029 Finsert (1, &p
->tty_name
);
1031 insert_string ("(none)");
1033 Findent_to (make_number (49), minspace
);
1035 if (NETCONN_P (proc
))
1037 sprintf (tembuf
, "(network stream connection to %s)\n",
1038 XSTRING (XCAR (p
->childp
))->data
);
1039 insert_string (tembuf
);
1051 insert_string (" ");
1053 insert_string ("\n");
1059 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 0, "",
1060 doc
: /* Display a list of all processes.
1061 Any process listed as exited or signaled is actually eliminated
1062 after the listing is made. */)
1065 internal_with_output_to_temp_buffer ("*Process List*",
1066 list_processes_1
, Qnil
);
1070 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1071 doc
: /* Return a list of all processes. */)
1074 return Fmapcar (Qcdr
, Vprocess_alist
);
1077 /* Starting asynchronous inferior processes. */
1079 static Lisp_Object
start_process_unwind ();
1081 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1082 doc
: /* Start a program in a subprocess. Return the process object for it.
1083 NAME is name for process. It is modified if necessary to make it unique.
1084 BUFFER is the buffer or (buffer-name) to associate with the process.
1085 Process output goes at end of that buffer, unless you specify
1086 an output stream or filter function to handle the output.
1087 BUFFER may be also nil, meaning that this process is not associated
1089 Third arg is program file name. It is searched for in PATH.
1090 Remaining arguments are strings to give program as arguments.
1091 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1094 register Lisp_Object
*args
;
1096 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1098 register unsigned char *new_argv
;
1101 register unsigned char **new_argv
;
1104 int count
= specpdl_ptr
- specpdl
;
1108 buffer
= Fget_buffer_create (buffer
);
1110 /* Make sure that the child will be able to chdir to the current
1111 buffer's current directory, or its unhandled equivalent. We
1112 can't just have the child check for an error when it does the
1113 chdir, since it's in a vfork.
1115 We have to GCPRO around this because Fexpand_file_name and
1116 Funhandled_file_name_directory might call a file name handling
1117 function. The argument list is protected by the caller, so all
1118 we really have to worry about is buffer. */
1120 struct gcpro gcpro1
, gcpro2
;
1122 current_dir
= current_buffer
->directory
;
1124 GCPRO2 (buffer
, current_dir
);
1127 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1129 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1130 report_file_error ("Setting current directory",
1131 Fcons (current_buffer
->directory
, Qnil
));
1137 CHECK_STRING (name
);
1141 CHECK_STRING (program
);
1143 proc
= make_process (name
);
1144 /* If an error occurs and we can't start the process, we want to
1145 remove it from the process list. This means that each error
1146 check in create_process doesn't need to call remove_process
1147 itself; it's all taken care of here. */
1148 record_unwind_protect (start_process_unwind
, proc
);
1150 XPROCESS (proc
)->childp
= Qt
;
1151 XPROCESS (proc
)->command_channel_p
= Qnil
;
1152 XPROCESS (proc
)->buffer
= buffer
;
1153 XPROCESS (proc
)->sentinel
= Qnil
;
1154 XPROCESS (proc
)->filter
= Qnil
;
1155 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1157 /* Make the process marker point into the process buffer (if any). */
1159 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1160 BUF_ZV (XBUFFER (buffer
)),
1161 BUF_ZV_BYTE (XBUFFER (buffer
)));
1164 /* Decide coding systems for communicating with the process. Here
1165 we don't setup the structure coding_system nor pay attention to
1166 unibyte mode. They are done in create_process. */
1168 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1169 Lisp_Object coding_systems
= Qt
;
1170 Lisp_Object val
, *args2
;
1171 struct gcpro gcpro1
, gcpro2
;
1173 val
= Vcoding_system_for_read
;
1176 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1177 args2
[0] = Qstart_process
;
1178 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1179 GCPRO2 (proc
, current_dir
);
1180 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1182 if (CONSP (coding_systems
))
1183 val
= XCAR (coding_systems
);
1184 else if (CONSP (Vdefault_process_coding_system
))
1185 val
= XCAR (Vdefault_process_coding_system
);
1187 XPROCESS (proc
)->decode_coding_system
= val
;
1189 val
= Vcoding_system_for_write
;
1192 if (EQ (coding_systems
, Qt
))
1194 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1195 args2
[0] = Qstart_process
;
1196 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1197 GCPRO2 (proc
, current_dir
);
1198 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1201 if (CONSP (coding_systems
))
1202 val
= XCDR (coding_systems
);
1203 else if (CONSP (Vdefault_process_coding_system
))
1204 val
= XCDR (Vdefault_process_coding_system
);
1206 XPROCESS (proc
)->encode_coding_system
= val
;
1210 /* Make a one member argv with all args concatenated
1211 together separated by a blank. */
1212 len
= STRING_BYTES (XSTRING (program
)) + 2;
1213 for (i
= 3; i
< nargs
; i
++)
1217 len
+= STRING_BYTES (XSTRING (tem
)) + 1; /* count the blank */
1219 new_argv
= (unsigned char *) alloca (len
);
1220 strcpy (new_argv
, XSTRING (program
)->data
);
1221 for (i
= 3; i
< nargs
; i
++)
1225 strcat (new_argv
, " ");
1226 strcat (new_argv
, XSTRING (tem
)->data
);
1228 /* Need to add code here to check for program existence on VMS */
1231 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1233 /* If program file name is not absolute, search our path for it */
1234 if (!IS_DIRECTORY_SEP (XSTRING (program
)->data
[0])
1235 && !(XSTRING (program
)->size
> 1
1236 && IS_DEVICE_SEP (XSTRING (program
)->data
[1])))
1238 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1241 GCPRO4 (name
, program
, buffer
, current_dir
);
1242 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, 1);
1245 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1246 tem
= Fexpand_file_name (tem
, Qnil
);
1247 tem
= ENCODE_FILE (tem
);
1248 new_argv
[0] = XSTRING (tem
)->data
;
1252 if (!NILP (Ffile_directory_p (program
)))
1253 error ("Specified program for new process is a directory");
1255 tem
= ENCODE_FILE (program
);
1256 new_argv
[0] = XSTRING (tem
)->data
;
1259 /* Here we encode arguments by the coding system used for sending
1260 data to the process. We don't support using different coding
1261 systems for encoding arguments and for encoding data sent to the
1264 for (i
= 3; i
< nargs
; i
++)
1268 if (STRING_MULTIBYTE (tem
))
1269 tem
= (code_convert_string_norecord
1270 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1271 new_argv
[i
- 2] = XSTRING (tem
)->data
;
1273 new_argv
[i
- 2] = 0;
1274 #endif /* not VMS */
1276 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1277 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1278 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1279 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1281 XPROCESS (proc
)->inherit_coding_system_flag
1282 = (NILP (buffer
) || !inherit_process_coding_system
1285 create_process (proc
, (char **) new_argv
, current_dir
);
1287 return unbind_to (count
, proc
);
1290 /* This function is the unwind_protect form for Fstart_process. If
1291 PROC doesn't have its pid set, then we know someone has signaled
1292 an error and the process wasn't started successfully, so we should
1293 remove it from the process list. */
1295 start_process_unwind (proc
)
1298 if (!PROCESSP (proc
))
1301 /* Was PROC started successfully? */
1302 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1303 remove_process (proc
);
1309 create_process_1 (timer
)
1310 struct atimer
*timer
;
1312 /* Nothing to do. */
1316 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1319 /* Mimic blocking of signals on system V, which doesn't really have it. */
1321 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1322 int sigchld_deferred
;
1325 create_process_sigchld ()
1327 signal (SIGCHLD
, create_process_sigchld
);
1329 sigchld_deferred
= 1;
1335 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1337 create_process (process
, new_argv
, current_dir
)
1338 Lisp_Object process
;
1340 Lisp_Object current_dir
;
1342 int pid
, inchannel
, outchannel
;
1344 #ifdef POSIX_SIGNALS
1347 struct sigaction sigint_action
;
1348 struct sigaction sigquit_action
;
1350 struct sigaction sighup_action
;
1352 #else /* !POSIX_SIGNALS */
1355 SIGTYPE (*sigchld
)();
1358 #endif /* !POSIX_SIGNALS */
1359 /* Use volatile to protect variables from being clobbered by longjmp. */
1360 volatile int forkin
, forkout
;
1361 volatile int pty_flag
= 0;
1363 extern char **environ
;
1366 inchannel
= outchannel
= -1;
1369 if (!NILP (Vprocess_connection_type
))
1370 outchannel
= inchannel
= allocate_pty ();
1375 /* On USG systems it does not work to open the pty's tty here
1376 and then close and reopen it in the child. */
1378 /* Don't let this terminal become our controlling terminal
1379 (in case we don't have one). */
1380 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1382 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1385 report_file_error ("Opening pty", Qnil
);
1387 forkin
= forkout
= -1;
1388 #endif /* not USG */
1392 #endif /* HAVE_PTYS */
1395 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1396 report_file_error ("Opening socketpair", Qnil
);
1397 outchannel
= inchannel
= sv
[0];
1398 forkout
= forkin
= sv
[1];
1400 #else /* not SKTPAIR */
1405 report_file_error ("Creating pipe", Qnil
);
1411 emacs_close (inchannel
);
1412 emacs_close (forkout
);
1413 report_file_error ("Creating pipe", Qnil
);
1418 #endif /* not SKTPAIR */
1421 /* Replaced by close_process_descs */
1422 set_exclusive_use (inchannel
);
1423 set_exclusive_use (outchannel
);
1426 /* Stride people say it's a mystery why this is needed
1427 as well as the O_NDELAY, but that it fails without this. */
1428 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1431 ioctl (inchannel
, FIONBIO
, &one
);
1436 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1437 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1440 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1441 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1445 /* Record this as an active process, with its channels.
1446 As a result, child_setup will close Emacs's side of the pipes. */
1447 chan_process
[inchannel
] = process
;
1448 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1449 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1450 /* Record the tty descriptor used in the subprocess. */
1452 XPROCESS (process
)->subtty
= Qnil
;
1454 XSETFASTINT (XPROCESS (process
)->subtty
, forkin
);
1455 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1456 XPROCESS (process
)->status
= Qrun
;
1457 if (!proc_decode_coding_system
[inchannel
])
1458 proc_decode_coding_system
[inchannel
]
1459 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
1460 setup_coding_system (XPROCESS (process
)->decode_coding_system
,
1461 proc_decode_coding_system
[inchannel
]);
1462 if (!proc_encode_coding_system
[outchannel
])
1463 proc_encode_coding_system
[outchannel
]
1464 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
1465 setup_coding_system (XPROCESS (process
)->encode_coding_system
,
1466 proc_encode_coding_system
[outchannel
]);
1468 /* Delay interrupts until we have a chance to store
1469 the new fork's pid in its process structure */
1470 #ifdef POSIX_SIGNALS
1471 sigemptyset (&blocked
);
1473 sigaddset (&blocked
, SIGCHLD
);
1475 #ifdef HAVE_WORKING_VFORK
1476 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1477 this sets the parent's signal handlers as well as the child's.
1478 So delay all interrupts whose handlers the child might munge,
1479 and record the current handlers so they can be restored later. */
1480 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1481 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1483 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1485 #endif /* HAVE_WORKING_VFORK */
1486 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1487 #else /* !POSIX_SIGNALS */
1491 #else /* not BSD4_1 */
1492 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1493 sigsetmask (sigmask (SIGCHLD
));
1494 #else /* ordinary USG */
1496 sigchld_deferred
= 0;
1497 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1499 #endif /* ordinary USG */
1500 #endif /* not BSD4_1 */
1501 #endif /* SIGCHLD */
1502 #endif /* !POSIX_SIGNALS */
1504 FD_SET (inchannel
, &input_wait_mask
);
1505 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1506 if (inchannel
> max_process_desc
)
1507 max_process_desc
= inchannel
;
1509 /* Until we store the proper pid, enable sigchld_handler
1510 to recognize an unknown pid as standing for this process.
1511 It is very important not to let this `marker' value stay
1512 in the table after this function has returned; if it does
1513 it might cause call-process to hang and subsequent asynchronous
1514 processes to get their return values scrambled. */
1515 XSETINT (XPROCESS (process
)->pid
, -1);
1520 /* child_setup must clobber environ on systems with true vfork.
1521 Protect it from permanent change. */
1522 char **save_environ
= environ
;
1524 current_dir
= ENCODE_FILE (current_dir
);
1529 #endif /* not WINDOWSNT */
1531 int xforkin
= forkin
;
1532 int xforkout
= forkout
;
1534 #if 0 /* This was probably a mistake--it duplicates code later on,
1535 but fails to handle all the cases. */
1536 /* Make sure SIGCHLD is not blocked in the child. */
1537 sigsetmask (SIGEMPTYMASK
);
1540 /* Make the pty be the controlling terminal of the process. */
1542 /* First, disconnect its current controlling terminal. */
1544 /* We tried doing setsid only if pty_flag, but it caused
1545 process_set_signal to fail on SGI when using a pipe. */
1547 /* Make the pty's terminal the controlling terminal. */
1551 /* We ignore the return value
1552 because faith@cs.unc.edu says that is necessary on Linux. */
1553 ioctl (xforkin
, TIOCSCTTY
, 0);
1556 #else /* not HAVE_SETSID */
1558 /* It's very important to call setpgrp here and no time
1559 afterwards. Otherwise, we lose our controlling tty which
1560 is set when we open the pty. */
1563 #endif /* not HAVE_SETSID */
1564 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1565 if (pty_flag
&& xforkin
>= 0)
1568 tcgetattr (xforkin
, &t
);
1570 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1571 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1574 #if defined (NTTYDISC) && defined (TIOCSETD)
1575 if (pty_flag
&& xforkin
>= 0)
1577 /* Use new line discipline. */
1578 int ldisc
= NTTYDISC
;
1579 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1584 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1585 can do TIOCSPGRP only to the process's controlling tty. */
1588 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1589 I can't test it since I don't have 4.3. */
1590 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
1591 ioctl (j
, TIOCNOTTY
, 0);
1594 /* In order to get a controlling terminal on some versions
1595 of BSD, it is necessary to put the process in pgrp 0
1596 before it opens the terminal. */
1604 #endif /* TIOCNOTTY */
1606 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
1607 /*** There is a suggestion that this ought to be a
1608 conditional on TIOCSPGRP,
1609 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1610 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1611 that system does seem to need this code, even though
1612 both HAVE_SETSID and TIOCSCTTY are defined. */
1613 /* Now close the pty (if we had it open) and reopen it.
1614 This makes the pty the controlling terminal of the subprocess. */
1617 #ifdef SET_CHILD_PTY_PGRP
1618 int pgrp
= getpid ();
1621 /* I wonder if emacs_close (emacs_open (pty_name, ...))
1624 emacs_close (xforkin
);
1625 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
1629 emacs_write (1, "Couldn't open the pty terminal ", 31);
1630 emacs_write (1, pty_name
, strlen (pty_name
));
1631 emacs_write (1, "\n", 1);
1635 #ifdef SET_CHILD_PTY_PGRP
1636 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
1637 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
1640 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
1642 #ifdef SETUP_SLAVE_PTY
1647 #endif /* SETUP_SLAVE_PTY */
1649 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1650 Now reenable it in the child, so it will die when we want it to. */
1652 signal (SIGHUP
, SIG_DFL
);
1654 #endif /* HAVE_PTYS */
1656 signal (SIGINT
, SIG_DFL
);
1657 signal (SIGQUIT
, SIG_DFL
);
1659 /* Stop blocking signals in the child. */
1660 #ifdef POSIX_SIGNALS
1661 sigprocmask (SIG_SETMASK
, &procmask
, 0);
1662 #else /* !POSIX_SIGNALS */
1666 #else /* not BSD4_1 */
1667 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1668 sigsetmask (SIGEMPTYMASK
);
1669 #else /* ordinary USG */
1671 signal (SIGCHLD
, sigchld
);
1673 #endif /* ordinary USG */
1674 #endif /* not BSD4_1 */
1675 #endif /* SIGCHLD */
1676 #endif /* !POSIX_SIGNALS */
1679 child_setup_tty (xforkout
);
1681 pid
= child_setup (xforkin
, xforkout
, xforkout
,
1682 new_argv
, 1, current_dir
);
1683 #else /* not WINDOWSNT */
1684 child_setup (xforkin
, xforkout
, xforkout
,
1685 new_argv
, 1, current_dir
);
1686 #endif /* not WINDOWSNT */
1688 environ
= save_environ
;
1693 /* This runs in the Emacs process. */
1697 emacs_close (forkin
);
1698 if (forkin
!= forkout
&& forkout
>= 0)
1699 emacs_close (forkout
);
1703 /* vfork succeeded. */
1704 XSETFASTINT (XPROCESS (process
)->pid
, pid
);
1707 register_child (pid
, inchannel
);
1708 #endif /* WINDOWSNT */
1710 /* If the subfork execv fails, and it exits,
1711 this close hangs. I don't know why.
1712 So have an interrupt jar it loose. */
1714 struct atimer
*timer
;
1718 EMACS_SET_SECS_USECS (offset
, 1, 0);
1719 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
1721 XPROCESS (process
)->subtty
= Qnil
;
1723 emacs_close (forkin
);
1725 cancel_atimer (timer
);
1729 if (forkin
!= forkout
&& forkout
>= 0)
1730 emacs_close (forkout
);
1734 XPROCESS (process
)->tty_name
= build_string (pty_name
);
1737 XPROCESS (process
)->tty_name
= Qnil
;
1740 /* Restore the signal state whether vfork succeeded or not.
1741 (We will signal an error, below, if it failed.) */
1742 #ifdef POSIX_SIGNALS
1743 #ifdef HAVE_WORKING_VFORK
1744 /* Restore the parent's signal handlers. */
1745 sigaction (SIGINT
, &sigint_action
, 0);
1746 sigaction (SIGQUIT
, &sigquit_action
, 0);
1748 sigaction (SIGHUP
, &sighup_action
, 0);
1750 #endif /* HAVE_WORKING_VFORK */
1751 /* Stop blocking signals in the parent. */
1752 sigprocmask (SIG_SETMASK
, &procmask
, 0);
1753 #else /* !POSIX_SIGNALS */
1757 #else /* not BSD4_1 */
1758 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1759 sigsetmask (SIGEMPTYMASK
);
1760 #else /* ordinary USG */
1762 signal (SIGCHLD
, sigchld
);
1763 /* Now really handle any of these signals
1764 that came in during this function. */
1765 if (sigchld_deferred
)
1766 kill (getpid (), SIGCHLD
);
1768 #endif /* ordinary USG */
1769 #endif /* not BSD4_1 */
1770 #endif /* SIGCHLD */
1771 #endif /* !POSIX_SIGNALS */
1773 /* Now generate the error if vfork failed. */
1775 report_file_error ("Doing vfork", Qnil
);
1777 #endif /* not VMS */
1781 /* open a TCP network connection to a given HOST/SERVICE. Treated
1782 exactly like a normal process when reading and writing. Only
1783 differences are in status display and process deletion. A network
1784 connection has no PID; you cannot signal it. All you can do is
1785 deactivate and close it via delete-process */
1787 DEFUN ("open-network-stream", Fopen_network_stream
, Sopen_network_stream
,
1789 doc
: /* Open a TCP connection for a service to a host.
1790 Returns a subprocess-object to represent the connection.
1791 Returns nil if a non-blocking connect is attempted on a system which
1792 cannot support that; in that case, the caller should attempt a
1793 normal connect instead.
1795 Input and output work as for subprocesses; `delete-process' closes it.
1796 Args are NAME BUFFER HOST SERVICE FILTER SENTINEL NON-BLOCKING.
1797 NAME is name for process. It is modified if necessary to make it unique.
1798 BUFFER is the buffer (or buffer-name) to associate with the process.
1799 Process output goes at end of that buffer, unless you specify
1800 an output stream or filter function to handle the output.
1801 BUFFER may be also nil, meaning that this process is not associated
1803 HOST is name of the host to connect to, or its IP address.
1804 SERVICE is name of the service desired, or an integer specifying a
1805 port number to connect to.
1806 FILTER and SENTINEL are optional args specifying the filter and
1807 sentinel functions associated with the network stream.
1808 NON-BLOCKING is optional arg requesting an non-blocking connect.
1809 When non-nil, open-network-stream will return immediately without
1810 waiting for the connection to be made. Instead, the sentinel function
1811 will be called with second matching "open" (if successful) or
1812 "failed" when the connect completes. */)
1813 (name
, buffer
, host
, service
, filter
, sentinel
, non_blocking
)
1814 Lisp_Object name
, buffer
, host
, service
, filter
, sentinel
, non_blocking
;
1817 #ifdef HAVE_GETADDRINFO
1818 struct addrinfo hints
, *res
, *lres
;
1819 char *portstring
, portbuf
[128];
1820 #else /* HAVE_GETADDRINFO */
1821 struct sockaddr_in address
;
1822 struct servent
*svc_info
;
1823 struct hostent
*host_info_ptr
, host_info
;
1824 char *(addr_list
[2]);
1825 IN_ADDR numeric_addr
;
1827 struct _emacs_addrinfo
1833 struct sockaddr
*ai_addr
;
1834 struct _emacs_addrinfo
*ai_next
;
1836 #endif /* HAVE_GETADDRINFO */
1839 int s
= -1, outch
, inch
;
1840 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
1842 int count
= specpdl_ptr
- specpdl
;
1844 int is_non_blocking
= 0;
1846 if (!NILP (non_blocking
))
1848 #ifndef NON_BLOCKING_CONNECT
1851 non_blocking
= Qt
; /* Instead of GCPRO */
1852 is_non_blocking
= 1;
1857 /* Ensure socket support is loaded if available. */
1858 init_winsock (TRUE
);
1861 /* Can only GCPRO 5 variables */
1862 sentinel
= Fcons (sentinel
, filter
);
1863 GCPRO5 (name
, buffer
, host
, service
, sentinel
);
1864 CHECK_STRING (name
);
1865 CHECK_STRING (host
);
1867 #ifdef HAVE_GETADDRINFO
1868 /* SERVICE can either be a string or int.
1869 Convert to a C string for later use by getaddrinfo. */
1870 if (INTEGERP (service
))
1872 sprintf (portbuf
, "%ld", (long) XINT (service
));
1873 portstring
= portbuf
;
1877 CHECK_STRING (service
);
1878 portstring
= XSTRING (service
)->data
;
1880 #else /* HAVE_GETADDRINFO */
1881 if (INTEGERP (service
))
1882 port
= htons ((unsigned short) XINT (service
));
1885 CHECK_STRING (service
);
1886 svc_info
= getservbyname (XSTRING (service
)->data
, "tcp");
1888 error ("Unknown service \"%s\"", XSTRING (service
)->data
);
1889 port
= svc_info
->s_port
;
1891 #endif /* HAVE_GETADDRINFO */
1894 /* Slow down polling to every ten seconds.
1895 Some kernels have a bug which causes retrying connect to fail
1896 after a connect. Polling can interfere with gethostbyname too. */
1897 #ifdef POLL_FOR_INPUT
1898 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
1899 bind_polling_period (10);
1903 #ifdef HAVE_GETADDRINFO
1906 memset (&hints
, 0, sizeof (hints
));
1908 hints
.ai_family
= AF_UNSPEC
;
1909 hints
.ai_socktype
= SOCK_STREAM
;
1910 hints
.ai_protocol
= 0;
1911 ret
= getaddrinfo (XSTRING (host
)->data
, portstring
, &hints
, &res
);
1913 #ifdef HAVE_GAI_STRERROR
1914 error ("%s/%s %s", XSTRING (host
)->data
, portstring
, gai_strerror(ret
));
1916 error ("%s/%s getaddrinfo error %d", XSTRING (host
)->data
, portstring
,
1921 #else /* not HAVE_GETADDRINFO */
1932 host_info_ptr
= gethostbyname (XSTRING (host
)->data
);
1936 if (! (host_info_ptr
== 0 && h_errno
== TRY_AGAIN
))
1940 Fsleep_for (make_number (1), Qnil
);
1943 if (host_info_ptr
== 0)
1944 /* Attempt to interpret host as numeric inet address */
1946 numeric_addr
= inet_addr ((char *) XSTRING (host
)->data
);
1947 if (NUMERIC_ADDR_ERROR
)
1948 error ("Unknown host \"%s\"", XSTRING (host
)->data
);
1950 host_info_ptr
= &host_info
;
1951 host_info
.h_name
= 0;
1952 host_info
.h_aliases
= 0;
1953 host_info
.h_addrtype
= AF_INET
;
1955 /* Older machines have only one address slot called h_addr.
1956 Newer machines have h_addr_list, but #define h_addr to
1957 be its first element. */
1958 host_info
.h_addr_list
= &(addr_list
[0]);
1960 host_info
.h_addr
= (char*)(&numeric_addr
);
1962 /* numeric_addr isn't null-terminated; it has fixed length. */
1963 host_info
.h_length
= sizeof (numeric_addr
);
1966 bzero (&address
, sizeof address
);
1967 bcopy (host_info_ptr
->h_addr
, (char *) &address
.sin_addr
,
1968 host_info_ptr
->h_length
);
1969 address
.sin_family
= host_info_ptr
->h_addrtype
;
1970 address
.sin_port
= port
;
1972 /* Emulate HAVE_GETADDRINFO for the loop over `res' below. */
1973 ai
.ai_family
= host_info_ptr
->h_addrtype
;
1974 ai
.ai_socktype
= SOCK_STREAM
;
1976 ai
.ai_addr
= (struct sockaddr
*) &address
;
1977 ai
.ai_addrlen
= sizeof address
;
1980 #endif /* not HAVE_GETADDRINFO */
1982 /* Do this in case we never enter the for-loop below. */
1983 count1
= specpdl_ptr
- specpdl
;
1986 for (lres
= res
; lres
; lres
= lres
->ai_next
)
1988 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
1995 #ifdef NON_BLOCKING_CONNECT
1996 if (is_non_blocking
)
1999 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
2001 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
2013 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
2014 when connect is interrupted. So let's not let it get interrupted.
2015 Note we do not turn off polling, because polling is only used
2016 when not interrupt_input, and thus not normally used on the systems
2017 which have this bug. On systems which use polling, there's no way
2018 to quit if polling is turned off. */
2019 if (interrupt_input
)
2022 /* Make us close S if quit. */
2023 count1
= specpdl_ptr
- specpdl
;
2024 record_unwind_protect (close_file_unwind
, make_number (s
));
2031 /* This turns off all alarm-based interrupts; the
2032 bind_polling_period call above doesn't always turn all the
2033 short-interval ones off, especially if interrupt_input is
2036 It'd be nice to be able to control the connect timeout
2037 though. Would non-blocking connect calls be portable?
2039 This used to be conditioned by HAVE_GETADDRINFO. Why? */
2041 if (!is_non_blocking
)
2042 turn_on_atimers (0);
2044 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
2047 if (!is_non_blocking
)
2048 turn_on_atimers (1);
2050 if (ret
== 0 || xerrno
== EISCONN
)
2052 is_non_blocking
= 0;
2053 /* The unwind-protect will be discarded afterwards.
2054 Likewise for immediate_quit. */
2058 #ifdef NON_BLOCKING_CONNECT
2060 if (is_non_blocking
&& xerrno
== EINPROGRESS
)
2064 if (is_non_blocking
&& xerrno
== EWOULDBLOCK
)
2072 if (xerrno
== EINTR
)
2074 if (xerrno
== EADDRINUSE
&& retry
< 20)
2076 /* A delay here is needed on some FreeBSD systems,
2077 and it is harmless, since this retrying takes time anyway
2078 and should be infrequent. */
2079 Fsleep_for (make_number (1), Qnil
);
2084 /* Discard the unwind protect closing S. */
2085 specpdl_ptr
= specpdl
+ count1
;
2086 count1
= specpdl_ptr
- specpdl
;
2092 #ifdef HAVE_GETADDRINFO
2098 if (interrupt_input
)
2101 /* If non-blocking got this far - and failed - assume non-blocking is
2102 not supported after all. This is probably a wrong assumption, but
2103 the normal blocking calls to open-network-stream handles this error
2105 if (is_non_blocking
)
2107 #ifdef POLL_FOR_INPUT
2108 unbind_to (count
, Qnil
);
2114 report_file_error ("connection failed",
2115 Fcons (host
, Fcons (name
, Qnil
)));
2120 /* Discard the unwind protect, if any. */
2121 specpdl_ptr
= specpdl
+ count1
;
2123 #ifdef POLL_FOR_INPUT
2124 unbind_to (count
, Qnil
);
2127 if (interrupt_input
)
2131 s
= connect_server (0);
2133 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2134 send_command (s
, C_PORT
, 0, "%s:%d", XSTRING (host
)->data
, ntohs (port
));
2135 send_command (s
, C_DUMB
, 1, 0);
2142 buffer
= Fget_buffer_create (buffer
);
2143 proc
= make_process (name
);
2145 chan_process
[inch
] = proc
;
2148 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
2151 fcntl (inch
, F_SETFL
, O_NDELAY
);
2155 XPROCESS (proc
)->childp
= Fcons (host
, Fcons (service
, Qnil
));
2156 XPROCESS (proc
)->command_channel_p
= Qnil
;
2157 XPROCESS (proc
)->buffer
= buffer
;
2158 XPROCESS (proc
)->sentinel
= XCAR (sentinel
);
2159 XPROCESS (proc
)->filter
= XCDR (sentinel
);
2160 XPROCESS (proc
)->command
= Qnil
;
2161 XPROCESS (proc
)->pid
= Qnil
;
2162 XSETINT (XPROCESS (proc
)->infd
, inch
);
2163 XSETINT (XPROCESS (proc
)->outfd
, outch
);
2164 XPROCESS (proc
)->status
= Qrun
;
2166 #ifdef NON_BLOCKING_CONNECT
2167 if (!NILP (non_blocking
))
2169 /* We may get here if connect did succeed immediately. However,
2170 in that case, we still need to signal this like a non-blocking
2172 XPROCESS (proc
)->status
= Qconnect
;
2173 if (!FD_ISSET (inch
, &connect_wait_mask
))
2175 FD_SET (inch
, &connect_wait_mask
);
2176 num_pending_connects
++;
2181 if (!EQ (XPROCESS (proc
)->filter
, Qt
))
2183 FD_SET (inch
, &input_wait_mask
);
2184 FD_SET (inch
, &non_keyboard_wait_mask
);
2187 if (inch
> max_process_desc
)
2188 max_process_desc
= inch
;
2191 /* Setup coding systems for communicating with the network stream. */
2192 struct gcpro gcpro1
;
2193 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
2194 Lisp_Object coding_systems
= Qt
;
2195 Lisp_Object args
[5], val
;
2197 if (!NILP (Vcoding_system_for_read
))
2198 val
= Vcoding_system_for_read
;
2199 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
2200 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
2201 /* We dare not decode end-of-line format by setting VAL to
2202 Qraw_text, because the existing Emacs Lisp libraries
2203 assume that they receive bare code including a sequene of
2208 args
[0] = Qopen_network_stream
, args
[1] = name
,
2209 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
2211 coding_systems
= Ffind_operation_coding_system (5, args
);
2213 if (CONSP (coding_systems
))
2214 val
= XCAR (coding_systems
);
2215 else if (CONSP (Vdefault_process_coding_system
))
2216 val
= XCAR (Vdefault_process_coding_system
);
2220 XPROCESS (proc
)->decode_coding_system
= val
;
2222 if (!NILP (Vcoding_system_for_write
))
2223 val
= Vcoding_system_for_write
;
2224 else if (NILP (current_buffer
->enable_multibyte_characters
))
2228 if (EQ (coding_systems
, Qt
))
2230 args
[0] = Qopen_network_stream
, args
[1] = name
,
2231 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
2233 coding_systems
= Ffind_operation_coding_system (5, args
);
2236 if (CONSP (coding_systems
))
2237 val
= XCDR (coding_systems
);
2238 else if (CONSP (Vdefault_process_coding_system
))
2239 val
= XCDR (Vdefault_process_coding_system
);
2243 XPROCESS (proc
)->encode_coding_system
= val
;
2246 if (!proc_decode_coding_system
[inch
])
2247 proc_decode_coding_system
[inch
]
2248 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
2249 setup_coding_system (XPROCESS (proc
)->decode_coding_system
,
2250 proc_decode_coding_system
[inch
]);
2251 if (!proc_encode_coding_system
[outch
])
2252 proc_encode_coding_system
[outch
]
2253 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
2254 setup_coding_system (XPROCESS (proc
)->encode_coding_system
,
2255 proc_encode_coding_system
[outch
]);
2257 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
2258 XPROCESS (proc
)->decoding_carryover
= make_number (0);
2259 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
2260 XPROCESS (proc
)->encoding_carryover
= make_number (0);
2262 XPROCESS (proc
)->inherit_coding_system_flag
2263 = (NILP (buffer
) || !inherit_process_coding_system
2269 #endif /* HAVE_SOCKETS */
2272 deactivate_process (proc
)
2275 register int inchannel
, outchannel
;
2276 register struct Lisp_Process
*p
= XPROCESS (proc
);
2278 inchannel
= XINT (p
->infd
);
2279 outchannel
= XINT (p
->outfd
);
2283 /* Beware SIGCHLD hereabouts. */
2284 flush_pending_output (inchannel
);
2287 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
2288 sys$
dassgn (outchannel
);
2289 vs
= get_vms_process_pointer (p
->pid
);
2291 give_back_vms_process_stuff (vs
);
2294 emacs_close (inchannel
);
2295 if (outchannel
>= 0 && outchannel
!= inchannel
)
2296 emacs_close (outchannel
);
2299 XSETINT (p
->infd
, -1);
2300 XSETINT (p
->outfd
, -1);
2301 chan_process
[inchannel
] = Qnil
;
2302 FD_CLR (inchannel
, &input_wait_mask
);
2303 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
2304 if (FD_ISSET (inchannel
, &connect_wait_mask
))
2306 FD_CLR (inchannel
, &connect_wait_mask
);
2307 if (--num_pending_connects
< 0)
2310 if (inchannel
== max_process_desc
)
2313 /* We just closed the highest-numbered process input descriptor,
2314 so recompute the highest-numbered one now. */
2315 max_process_desc
= 0;
2316 for (i
= 0; i
< MAXDESC
; i
++)
2317 if (!NILP (chan_process
[i
]))
2318 max_process_desc
= i
;
2323 /* Close all descriptors currently in use for communication
2324 with subprocess. This is used in a newly-forked subprocess
2325 to get rid of irrelevant descriptors. */
2328 close_process_descs ()
2332 for (i
= 0; i
< MAXDESC
; i
++)
2334 Lisp_Object process
;
2335 process
= chan_process
[i
];
2336 if (!NILP (process
))
2338 int in
= XINT (XPROCESS (process
)->infd
);
2339 int out
= XINT (XPROCESS (process
)->outfd
);
2342 if (out
>= 0 && in
!= out
)
2349 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
2351 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
2352 It is read into the process' buffers or given to their filter functions.
2353 Non-nil arg PROCESS means do not return until some output has been received
2355 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of
2356 seconds and microseconds to wait; return after that much time whether
2357 or not there is input.
2358 Return non-nil iff we received any output before the timeout expired. */)
2359 (process
, timeout
, timeout_msecs
)
2360 register Lisp_Object process
, timeout
, timeout_msecs
;
2365 if (! NILP (process
))
2366 CHECK_PROCESS (process
);
2368 if (! NILP (timeout_msecs
))
2370 CHECK_NUMBER (timeout_msecs
);
2371 useconds
= XINT (timeout_msecs
);
2372 if (!INTEGERP (timeout
))
2373 XSETINT (timeout
, 0);
2376 int carry
= useconds
/ 1000000;
2378 XSETINT (timeout
, XINT (timeout
) + carry
);
2379 useconds
-= carry
* 1000000;
2381 /* I think this clause is necessary because C doesn't
2382 guarantee a particular rounding direction for negative
2386 XSETINT (timeout
, XINT (timeout
) - 1);
2387 useconds
+= 1000000;
2394 if (! NILP (timeout
))
2396 CHECK_NUMBER (timeout
);
2397 seconds
= XINT (timeout
);
2398 if (seconds
< 0 || (seconds
== 0 && useconds
== 0))
2410 XSETFASTINT (process
, 0);
2413 (wait_reading_process_input (seconds
, useconds
, process
, 0)
2417 /* This variable is different from waiting_for_input in keyboard.c.
2418 It is used to communicate to a lisp process-filter/sentinel (via the
2419 function Fwaiting_for_user_input_p below) whether emacs was waiting
2420 for user-input when that process-filter was called.
2421 waiting_for_input cannot be used as that is by definition 0 when
2422 lisp code is being evalled.
2423 This is also used in record_asynch_buffer_change.
2424 For that purpose, this must be 0
2425 when not inside wait_reading_process_input. */
2426 static int waiting_for_user_input_p
;
2428 /* This is here so breakpoints can be put on it. */
2430 wait_reading_process_input_1 ()
2434 /* Read and dispose of subprocess output while waiting for timeout to
2435 elapse and/or keyboard input to be available.
2438 timeout in seconds, or
2439 zero for no limit, or
2440 -1 means gobble data immediately available but don't wait for any.
2443 an additional duration to wait, measured in microseconds.
2444 If this is nonzero and time_limit is 0, then the timeout
2445 consists of MICROSECS only.
2447 READ_KBD is a lisp value:
2448 0 to ignore keyboard input, or
2449 1 to return when input is available, or
2450 -1 meaning caller will actually read the input, so don't throw to
2451 the quit handler, or
2452 a cons cell, meaning wait until its car is non-nil
2453 (and gobble terminal input into the buffer if any arrives), or
2454 a process object, meaning wait until something arrives from that
2455 process. The return value is true iff we read some input from
2458 DO_DISPLAY != 0 means redisplay should be done to show subprocess
2459 output that arrives.
2461 If READ_KBD is a pointer to a struct Lisp_Process, then the
2462 function returns true iff we received input from that process
2463 before the timeout elapsed.
2464 Otherwise, return true iff we received input from any process. */
2467 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
2468 int time_limit
, microsecs
;
2469 Lisp_Object read_kbd
;
2472 register int channel
, nfds
;
2473 static SELECT_TYPE Available
;
2474 static SELECT_TYPE Connecting
;
2475 int check_connect
, no_avail
;
2478 EMACS_TIME timeout
, end_time
;
2479 int wait_channel
= -1;
2480 struct Lisp_Process
*wait_proc
= 0;
2481 int got_some_input
= 0;
2482 /* Either nil or a cons cell, the car of which is of interest and
2483 may be changed outside of this routine. */
2484 Lisp_Object wait_for_cell
= Qnil
;
2486 FD_ZERO (&Available
);
2487 FD_ZERO (&Connecting
);
2489 /* If read_kbd is a process to watch, set wait_proc and wait_channel
2491 if (PROCESSP (read_kbd
))
2493 wait_proc
= XPROCESS (read_kbd
);
2494 wait_channel
= XINT (wait_proc
->infd
);
2495 XSETFASTINT (read_kbd
, 0);
2498 /* If waiting for non-nil in a cell, record where. */
2499 if (CONSP (read_kbd
))
2501 wait_for_cell
= read_kbd
;
2502 XSETFASTINT (read_kbd
, 0);
2505 waiting_for_user_input_p
= XINT (read_kbd
);
2507 /* Since we may need to wait several times,
2508 compute the absolute time to return at. */
2509 if (time_limit
|| microsecs
)
2511 EMACS_GET_TIME (end_time
);
2512 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
2513 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
2516 /* AlainF 5-Jul-1996
2517 HP-UX 10.10 seem to have problems with signals coming in
2518 Causes "poll: interrupted system call" messages when Emacs is run
2520 Turn off periodic alarms (in case they are in use) */
2521 turn_on_atimers (0);
2526 int timeout_reduced_for_timers
= 0;
2528 /* If calling from keyboard input, do not quit
2529 since we want to return C-g as an input character.
2530 Otherwise, do pending quit if requested. */
2531 if (XINT (read_kbd
) >= 0)
2534 /* Exit now if the cell we're waiting for became non-nil. */
2535 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
2538 /* Compute time from now till when time limit is up */
2539 /* Exit if already run out */
2540 if (time_limit
== -1)
2542 /* -1 specified for timeout means
2543 gobble output available now
2544 but don't wait at all. */
2546 EMACS_SET_SECS_USECS (timeout
, 0, 0);
2548 else if (time_limit
|| microsecs
)
2550 EMACS_GET_TIME (timeout
);
2551 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
2552 if (EMACS_TIME_NEG_P (timeout
))
2557 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
2560 /* Normally we run timers here.
2561 But not if wait_for_cell; in those cases,
2562 the wait is supposed to be short,
2563 and those callers cannot handle running arbitrary Lisp code here. */
2564 if (NILP (wait_for_cell
))
2566 EMACS_TIME timer_delay
;
2570 int old_timers_run
= timers_run
;
2571 struct buffer
*old_buffer
= current_buffer
;
2573 timer_delay
= timer_check (1);
2575 /* If a timer has run, this might have changed buffers
2576 an alike. Make read_key_sequence aware of that. */
2577 if (timers_run
!= old_timers_run
2578 && old_buffer
!= current_buffer
2579 && waiting_for_user_input_p
== -1)
2580 record_asynch_buffer_change ();
2582 if (timers_run
!= old_timers_run
&& do_display
)
2583 /* We must retry, since a timer may have requeued itself
2584 and that could alter the time_delay. */
2585 redisplay_preserve_echo_area (9);
2589 while (!detect_input_pending ());
2591 /* If there is unread keyboard input, also return. */
2592 if (XINT (read_kbd
) != 0
2593 && requeued_events_pending_p ())
2596 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
2598 EMACS_TIME difference
;
2599 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
2600 if (EMACS_TIME_NEG_P (difference
))
2602 timeout
= timer_delay
;
2603 timeout_reduced_for_timers
= 1;
2606 /* If time_limit is -1, we are not going to wait at all. */
2607 else if (time_limit
!= -1)
2609 /* This is so a breakpoint can be put here. */
2610 wait_reading_process_input_1 ();
2614 /* Cause C-g and alarm signals to take immediate action,
2615 and cause input available signals to zero out timeout.
2617 It is important that we do this before checking for process
2618 activity. If we get a SIGCHLD after the explicit checks for
2619 process activity, timeout is the only way we will know. */
2620 if (XINT (read_kbd
) < 0)
2621 set_waiting_for_input (&timeout
);
2623 /* If status of something has changed, and no input is
2624 available, notify the user of the change right away. After
2625 this explicit check, we'll let the SIGCHLD handler zap
2626 timeout to get our attention. */
2627 if (update_tick
!= process_tick
&& do_display
)
2629 SELECT_TYPE Atemp
, Ctemp
;
2631 Atemp
= input_wait_mask
;
2632 Ctemp
= connect_wait_mask
;
2633 EMACS_SET_SECS_USECS (timeout
, 0, 0);
2634 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
2636 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
2637 (SELECT_TYPE
*)0, &timeout
)
2640 /* It's okay for us to do this and then continue with
2641 the loop, since timeout has already been zeroed out. */
2642 clear_waiting_for_input ();
2647 /* Don't wait for output from a non-running process. Just
2648 read whatever data has already been received. */
2649 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
2650 update_status (wait_proc
);
2652 && ! EQ (wait_proc
->status
, Qrun
)
2653 && ! EQ (wait_proc
->status
, Qconnect
))
2655 int nread
, total_nread
= 0;
2657 clear_waiting_for_input ();
2658 XSETPROCESS (proc
, wait_proc
);
2660 /* Read data from the process, until we exhaust it. */
2661 while (XINT (wait_proc
->infd
) >= 0)
2663 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
2669 total_nread
+= nread
;
2671 else if (nread
== -1 && EIO
== errno
)
2675 else if (nread
== -1 && EAGAIN
== errno
)
2679 else if (nread
== -1 && EWOULDBLOCK
== errno
)
2683 if (total_nread
> 0 && do_display
)
2684 redisplay_preserve_echo_area (10);
2689 /* Wait till there is something to do */
2691 if (!NILP (wait_for_cell
))
2693 Available
= non_process_wait_mask
;
2698 if (! XINT (read_kbd
))
2699 Available
= non_keyboard_wait_mask
;
2701 Available
= input_wait_mask
;
2702 check_connect
= (num_pending_connects
> 0);
2705 /* If frame size has changed or the window is newly mapped,
2706 redisplay now, before we start to wait. There is a race
2707 condition here; if a SIGIO arrives between now and the select
2708 and indicates that a frame is trashed, the select may block
2709 displaying a trashed screen. */
2710 if (frame_garbaged
&& do_display
)
2712 clear_waiting_for_input ();
2713 redisplay_preserve_echo_area (11);
2714 if (XINT (read_kbd
) < 0)
2715 set_waiting_for_input (&timeout
);
2719 if (XINT (read_kbd
) && detect_input_pending ())
2727 Connecting
= connect_wait_mask
;
2728 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
2730 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
2731 (SELECT_TYPE
*)0, &timeout
);
2736 /* Make C-g and alarm signals set flags again */
2737 clear_waiting_for_input ();
2739 /* If we woke up due to SIGWINCH, actually change size now. */
2740 do_pending_window_change (0);
2742 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
2743 /* We wanted the full specified time, so return now. */
2747 if (xerrno
== EINTR
)
2750 /* Ultrix select seems to return ENOMEM when it is
2751 interrupted. Treat it just like EINTR. Bleah. Note
2752 that we want to test for the "ultrix" CPP symbol, not
2753 "__ultrix__"; the latter is only defined under GCC, but
2754 not by DEC's bundled CC. -JimB */
2755 else if (xerrno
== ENOMEM
)
2759 /* This happens for no known reason on ALLIANT.
2760 I am guessing that this is the right response. -- RMS. */
2761 else if (xerrno
== EFAULT
)
2764 else if (xerrno
== EBADF
)
2767 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
2768 the child's closure of the pts gives the parent a SIGHUP, and
2769 the ptc file descriptor is automatically closed,
2770 yielding EBADF here or at select() call above.
2771 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
2772 in m/ibmrt-aix.h), and here we just ignore the select error.
2773 Cleanup occurs c/o status_notify after SIGCLD. */
2774 no_avail
= 1; /* Cannot depend on values returned */
2780 error ("select error: %s", emacs_strerror (xerrno
));
2785 FD_ZERO (&Available
);
2789 #if defined(sun) && !defined(USG5_4)
2790 if (nfds
> 0 && keyboard_bit_set (&Available
)
2792 /* System sometimes fails to deliver SIGIO.
2794 David J. Mackenzie says that Emacs doesn't compile under
2795 Solaris if this code is enabled, thus the USG5_4 in the CPP
2796 conditional. "I haven't noticed any ill effects so far.
2797 If you find a Solaris expert somewhere, they might know
2799 kill (getpid (), SIGIO
);
2802 #if 0 /* When polling is used, interrupt_input is 0,
2803 so get_input_pending should read the input.
2804 So this should not be needed. */
2805 /* If we are using polling for input,
2806 and we see input available, make it get read now.
2807 Otherwise it might not actually get read for a second.
2808 And on hpux, since we turn off polling in wait_reading_process_input,
2809 it might never get read at all if we don't spend much time
2810 outside of wait_reading_process_input. */
2811 if (XINT (read_kbd
) && interrupt_input
2812 && keyboard_bit_set (&Available
)
2813 && input_polling_used ())
2814 kill (getpid (), SIGALRM
);
2817 /* Check for keyboard input */
2818 /* If there is any, return immediately
2819 to give it higher priority than subprocesses */
2821 if (XINT (read_kbd
) != 0)
2823 int old_timers_run
= timers_run
;
2824 struct buffer
*old_buffer
= current_buffer
;
2827 if (detect_input_pending_run_timers (do_display
))
2829 swallow_events (do_display
);
2830 if (detect_input_pending_run_timers (do_display
))
2834 /* If a timer has run, this might have changed buffers
2835 an alike. Make read_key_sequence aware of that. */
2836 if (timers_run
!= old_timers_run
2837 && waiting_for_user_input_p
== -1
2838 && old_buffer
!= current_buffer
)
2839 record_asynch_buffer_change ();
2845 /* If there is unread keyboard input, also return. */
2846 if (XINT (read_kbd
) != 0
2847 && requeued_events_pending_p ())
2850 /* If we are not checking for keyboard input now,
2851 do process events (but don't run any timers).
2852 This is so that X events will be processed.
2853 Otherwise they may have to wait until polling takes place.
2854 That would causes delays in pasting selections, for example.
2856 (We used to do this only if wait_for_cell.) */
2857 if (XINT (read_kbd
) == 0 && detect_input_pending ())
2859 swallow_events (do_display
);
2860 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
2861 if (detect_input_pending ())
2866 /* Exit now if the cell we're waiting for became non-nil. */
2867 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
2871 /* If we think we have keyboard input waiting, but didn't get SIGIO,
2872 go read it. This can happen with X on BSD after logging out.
2873 In that case, there really is no input and no SIGIO,
2874 but select says there is input. */
2876 if (XINT (read_kbd
) && interrupt_input
2877 && keyboard_bit_set (&Available
))
2878 kill (getpid (), SIGIO
);
2882 got_some_input
|= nfds
> 0;
2884 /* If checking input just got us a size-change event from X,
2885 obey it now if we should. */
2886 if (XINT (read_kbd
) || ! NILP (wait_for_cell
))
2887 do_pending_window_change (0);
2889 /* Check for data from a process. */
2890 if (no_avail
|| nfds
== 0)
2893 /* Really FIRST_PROC_DESC should be 0 on Unix,
2894 but this is safer in the short run. */
2895 for (channel
= 0; channel
<= max_process_desc
; channel
++)
2897 if (FD_ISSET (channel
, &Available
)
2898 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
2902 /* If waiting for this channel, arrange to return as
2903 soon as no more input to be processed. No more
2905 if (wait_channel
== channel
)
2911 proc
= chan_process
[channel
];
2915 /* Read data from the process, starting with our
2916 buffered-ahead character if we have one. */
2918 nread
= read_process_output (proc
, channel
);
2921 /* Since read_process_output can run a filter,
2922 which can call accept-process-output,
2923 don't try to read from any other processes
2924 before doing the select again. */
2925 FD_ZERO (&Available
);
2928 redisplay_preserve_echo_area (12);
2931 else if (nread
== -1 && errno
== EWOULDBLOCK
)
2934 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
2935 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
2937 else if (nread
== -1 && errno
== EAGAIN
)
2941 else if (nread
== -1 && errno
== EAGAIN
)
2943 /* Note that we cannot distinguish between no input
2944 available now and a closed pipe.
2945 With luck, a closed pipe will be accompanied by
2946 subprocess termination and SIGCHLD. */
2947 else if (nread
== 0 && !NETCONN_P (proc
))
2949 #endif /* O_NDELAY */
2950 #endif /* O_NONBLOCK */
2952 /* On some OSs with ptys, when the process on one end of
2953 a pty exits, the other end gets an error reading with
2954 errno = EIO instead of getting an EOF (0 bytes read).
2955 Therefore, if we get an error reading and errno =
2956 EIO, just continue, because the child process has
2957 exited and should clean itself up soon (e.g. when we
2960 However, it has been known to happen that the SIGCHLD
2961 got lost. So raise the signl again just in case.
2963 else if (nread
== -1 && errno
== EIO
)
2964 kill (getpid (), SIGCHLD
);
2965 #endif /* HAVE_PTYS */
2966 /* If we can detect process termination, don't consider the process
2967 gone just because its pipe is closed. */
2969 else if (nread
== 0 && !NETCONN_P (proc
))
2974 /* Preserve status of processes already terminated. */
2975 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
2976 deactivate_process (proc
);
2977 if (!NILP (XPROCESS (proc
)->raw_status_low
))
2978 update_status (XPROCESS (proc
));
2979 if (EQ (XPROCESS (proc
)->status
, Qrun
))
2980 XPROCESS (proc
)->status
2981 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
2984 #ifdef NON_BLOCKING_CONNECT
2985 if (check_connect
&& FD_ISSET (channel
, &Connecting
))
2987 struct Lisp_Process
*p
;
2988 struct sockaddr pname
;
2989 socklen_t pnamelen
= sizeof(pname
);
2991 FD_CLR (channel
, &connect_wait_mask
);
2992 if (--num_pending_connects
< 0)
2995 proc
= chan_process
[channel
];
2999 p
= XPROCESS (proc
);
3002 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
3003 So only use it on systems where it is known to work. */
3005 socklen_t xlen
= sizeof(xerrno
);
3006 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
3010 /* If connection failed, getpeername will fail. */
3012 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
3014 /* Obtain connect failure code through error slippage. */
3017 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
3023 XSETINT (p
->tick
, ++process_tick
);
3024 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
3025 deactivate_process (proc
);
3030 /* Execute the sentinel here. If we had relied on
3031 status_notify to do it later, it will read input
3032 from the process before calling the sentinel. */
3033 exec_sentinel (proc
, build_string ("open\n"));
3034 if (!EQ (p
->filter
, Qt
))
3036 FD_SET (XINT (p
->infd
), &input_wait_mask
);
3037 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
3041 #endif /* NON_BLOCKING_CONNECT */
3042 } /* end for each file descriptor */
3043 } /* end while exit conditions not met */
3045 waiting_for_user_input_p
= 0;
3047 /* If calling from keyboard input, do not quit
3048 since we want to return C-g as an input character.
3049 Otherwise, do pending quit if requested. */
3050 if (XINT (read_kbd
) >= 0)
3052 /* Prevent input_pending from remaining set if we quit. */
3053 clear_input_pending ();
3057 /* AlainF 5-Jul-1996
3058 HP-UX 10.10 seems to have problems with signals coming in
3059 Causes "poll: interrupted system call" messages when Emacs is run
3061 Turn periodic alarms back on */
3065 return got_some_input
;
3068 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
3071 read_process_output_call (fun_and_args
)
3072 Lisp_Object fun_and_args
;
3074 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
3078 read_process_output_error_handler (error
)
3081 cmd_error_internal (error
, "error in process filter: ");
3083 update_echo_area ();
3084 Fsleep_for (make_number (2), Qnil
);
3088 /* Read pending output from the process channel,
3089 starting with our buffered-ahead character if we have one.
3090 Yield number of decoded characters read.
3092 This function reads at most 1024 characters.
3093 If you want to read all available subprocess output,
3094 you must call it repeatedly until it returns zero.
3096 The characters read are decoded according to PROC's coding-system
3100 read_process_output (proc
, channel
)
3102 register int channel
;
3104 register int nchars
, nbytes
;
3106 register Lisp_Object outstream
;
3107 register struct buffer
*old
= current_buffer
;
3108 register struct Lisp_Process
*p
= XPROCESS (proc
);
3109 register int opoint
;
3110 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
3111 int carryover
= XINT (p
->decoding_carryover
);
3114 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
3116 vs
= get_vms_process_pointer (p
->pid
);
3120 return (0); /* Really weird if it does this */
3121 if (!(vs
->iosb
[0] & 1))
3122 return -1; /* I/O error */
3125 error ("Could not get VMS process pointer");
3126 chars
= vs
->inputBuffer
;
3127 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
3130 start_vms_process_read (vs
); /* Crank up the next read on the process */
3131 return 1; /* Nothing worth printing, say we got 1 */
3135 /* The data carried over in the previous decoding (which are at
3136 the tail of decoding buffer) should be prepended to the new
3137 data read to decode all together. */
3138 chars
= (char *) alloca (nbytes
+ carryover
);
3139 bcopy (XSTRING (p
->decoding_buf
)->data
, buf
, carryover
);
3140 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
3143 chars
= (char *) alloca (carryover
+ 1024);
3145 /* See the comment above. */
3146 bcopy (XSTRING (p
->decoding_buf
)->data
, chars
, carryover
);
3148 if (proc_buffered_char
[channel
] < 0)
3149 nbytes
= emacs_read (channel
, chars
+ carryover
, 1024 - carryover
);
3152 chars
[carryover
] = proc_buffered_char
[channel
];
3153 proc_buffered_char
[channel
] = -1;
3154 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, 1023 - carryover
);
3158 nbytes
= nbytes
+ 1;
3160 #endif /* not VMS */
3162 XSETINT (p
->decoding_carryover
, 0);
3164 /* At this point, NBYTES holds number of bytes just received
3165 (including the one in proc_buffered_char[channel]). */
3168 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
3170 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
3173 /* Now set NBYTES how many bytes we must decode. */
3174 nbytes
+= carryover
;
3176 /* Read and dispose of the process output. */
3177 outstream
= p
->filter
;
3178 if (!NILP (outstream
))
3180 /* We inhibit quit here instead of just catching it so that
3181 hitting ^G when a filter happens to be running won't screw
3183 int count
= specpdl_ptr
- specpdl
;
3184 Lisp_Object odeactivate
;
3185 Lisp_Object obuffer
, okeymap
;
3187 int outer_running_asynch_code
= running_asynch_code
;
3188 int waiting
= waiting_for_user_input_p
;
3190 /* No need to gcpro these, because all we do with them later
3191 is test them for EQness, and none of them should be a string. */
3192 odeactivate
= Vdeactivate_mark
;
3193 XSETBUFFER (obuffer
, current_buffer
);
3194 okeymap
= current_buffer
->keymap
;
3196 specbind (Qinhibit_quit
, Qt
);
3197 specbind (Qlast_nonmenu_event
, Qt
);
3199 /* In case we get recursively called,
3200 and we already saved the match data nonrecursively,
3201 save the same match data in safely recursive fashion. */
3202 if (outer_running_asynch_code
)
3205 /* Don't clobber the CURRENT match data, either! */
3206 tem
= Fmatch_data (Qnil
, Qnil
);
3207 restore_match_data ();
3208 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
3209 Fset_match_data (tem
);
3212 /* For speed, if a search happens within this code,
3213 save the match data in a special nonrecursive fashion. */
3214 running_asynch_code
= 1;
3216 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
3218 if (NILP (buffer_defaults
.enable_multibyte_characters
))
3219 /* We had better return unibyte string. */
3220 text
= string_make_unibyte (text
);
3222 Vlast_coding_system_used
= coding
->symbol
;
3223 /* A new coding system might be found. */
3224 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
3226 p
->decode_coding_system
= coding
->symbol
;
3228 /* Don't call setup_coding_system for
3229 proc_decode_coding_system[channel] here. It is done in
3230 detect_coding called via decode_coding above. */
3232 /* If a coding system for encoding is not yet decided, we set
3233 it as the same as coding-system for decoding.
3235 But, before doing that we must check if
3236 proc_encode_coding_system[p->outfd] surely points to a
3237 valid memory because p->outfd will be changed once EOF is
3238 sent to the process. */
3239 if (NILP (p
->encode_coding_system
)
3240 && proc_encode_coding_system
[XINT (p
->outfd
)])
3242 p
->encode_coding_system
= coding
->symbol
;
3243 setup_coding_system (coding
->symbol
,
3244 proc_encode_coding_system
[XINT (p
->outfd
)]);
3248 carryover
= nbytes
- coding
->consumed
;
3249 bcopy (chars
+ coding
->consumed
, XSTRING (p
->decoding_buf
)->data
,
3251 XSETINT (p
->decoding_carryover
, carryover
);
3252 nbytes
= STRING_BYTES (XSTRING (text
));
3253 nchars
= XSTRING (text
)->size
;
3255 internal_condition_case_1 (read_process_output_call
,
3257 Fcons (proc
, Fcons (text
, Qnil
))),
3258 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
3259 read_process_output_error_handler
);
3261 /* If we saved the match data nonrecursively, restore it now. */
3262 restore_match_data ();
3263 running_asynch_code
= outer_running_asynch_code
;
3265 /* Handling the process output should not deactivate the mark. */
3266 Vdeactivate_mark
= odeactivate
;
3268 /* Restore waiting_for_user_input_p as it was
3269 when we were called, in case the filter clobbered it. */
3270 waiting_for_user_input_p
= waiting
;
3272 #if 0 /* Call record_asynch_buffer_change unconditionally,
3273 because we might have changed minor modes or other things
3274 that affect key bindings. */
3275 if (! EQ (Fcurrent_buffer (), obuffer
)
3276 || ! EQ (current_buffer
->keymap
, okeymap
))
3278 /* But do it only if the caller is actually going to read events.
3279 Otherwise there's no need to make him wake up, and it could
3280 cause trouble (for example it would make Fsit_for return). */
3281 if (waiting_for_user_input_p
== -1)
3282 record_asynch_buffer_change ();
3285 start_vms_process_read (vs
);
3287 unbind_to (count
, Qnil
);
3291 /* If no filter, write into buffer if it isn't dead. */
3292 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
3294 Lisp_Object old_read_only
;
3295 int old_begv
, old_zv
;
3296 int old_begv_byte
, old_zv_byte
;
3297 Lisp_Object odeactivate
;
3298 int before
, before_byte
;
3303 odeactivate
= Vdeactivate_mark
;
3305 Fset_buffer (p
->buffer
);
3307 opoint_byte
= PT_BYTE
;
3308 old_read_only
= current_buffer
->read_only
;
3311 old_begv_byte
= BEGV_BYTE
;
3312 old_zv_byte
= ZV_BYTE
;
3314 current_buffer
->read_only
= Qnil
;
3316 /* Insert new output into buffer
3317 at the current end-of-output marker,
3318 thus preserving logical ordering of input and output. */
3319 if (XMARKER (p
->mark
)->buffer
)
3320 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
3321 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
3324 SET_PT_BOTH (ZV
, ZV_BYTE
);
3326 before_byte
= PT_BYTE
;
3328 /* If the output marker is outside of the visible region, save
3329 the restriction and widen. */
3330 if (! (BEGV
<= PT
&& PT
<= ZV
))
3333 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
3335 Vlast_coding_system_used
= coding
->symbol
;
3336 /* A new coding system might be found. See the comment in the
3337 similar code in the previous `if' block. */
3338 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
3340 p
->decode_coding_system
= coding
->symbol
;
3341 if (NILP (p
->encode_coding_system
)
3342 && proc_encode_coding_system
[XINT (p
->outfd
)])
3344 p
->encode_coding_system
= coding
->symbol
;
3345 setup_coding_system (coding
->symbol
,
3346 proc_encode_coding_system
[XINT (p
->outfd
)]);
3349 carryover
= nbytes
- coding
->consumed
;
3350 bcopy (chars
+ coding
->consumed
, XSTRING (p
->decoding_buf
)->data
,
3352 XSETINT (p
->decoding_carryover
, carryover
);
3353 /* Adjust the multibyteness of TEXT to that of the buffer. */
3354 if (NILP (current_buffer
->enable_multibyte_characters
)
3355 != ! STRING_MULTIBYTE (text
))
3356 text
= (STRING_MULTIBYTE (text
)
3357 ? Fstring_as_unibyte (text
)
3358 : Fstring_as_multibyte (text
));
3359 nbytes
= STRING_BYTES (XSTRING (text
));
3360 nchars
= XSTRING (text
)->size
;
3361 /* Insert before markers in case we are inserting where
3362 the buffer's mark is, and the user's next command is Meta-y. */
3363 insert_from_string_before_markers (text
, 0, 0, nchars
, nbytes
, 0);
3365 /* Make sure the process marker's position is valid when the
3366 process buffer is changed in the signal_after_change above.
3367 W3 is known to do that. */
3368 if (BUFFERP (p
->buffer
)
3369 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
3370 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
3372 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
3374 update_mode_lines
++;
3376 /* Make sure opoint and the old restrictions
3377 float ahead of any new text just as point would. */
3378 if (opoint
>= before
)
3380 opoint
+= PT
- before
;
3381 opoint_byte
+= PT_BYTE
- before_byte
;
3383 if (old_begv
> before
)
3385 old_begv
+= PT
- before
;
3386 old_begv_byte
+= PT_BYTE
- before_byte
;
3388 if (old_zv
>= before
)
3390 old_zv
+= PT
- before
;
3391 old_zv_byte
+= PT_BYTE
- before_byte
;
3394 /* If the restriction isn't what it should be, set it. */
3395 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
3396 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
3398 /* Handling the process output should not deactivate the mark. */
3399 Vdeactivate_mark
= odeactivate
;
3401 current_buffer
->read_only
= old_read_only
;
3402 SET_PT_BOTH (opoint
, opoint_byte
);
3403 set_buffer_internal (old
);
3406 start_vms_process_read (vs
);
3411 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
3413 doc
: /* Returns non-nil if emacs is waiting for input from the user.
3414 This is intended for use by asynchronous process output filters and sentinels. */)
3417 return (waiting_for_user_input_p
? Qt
: Qnil
);
3420 /* Sending data to subprocess */
3422 jmp_buf send_process_frame
;
3423 Lisp_Object process_sent_to
;
3426 send_process_trap ()
3432 longjmp (send_process_frame
, 1);
3435 /* Send some data to process PROC.
3436 BUF is the beginning of the data; LEN is the number of characters.
3437 OBJECT is the Lisp object that the data comes from. If OBJECT is
3438 nil or t, it means that the data comes from C string.
3440 If OBJECT is not nil, the data is encoded by PROC's coding-system
3441 for encoding before it is sent.
3443 This function can evaluate Lisp code and can garbage collect. */
3446 send_process (proc
, buf
, len
, object
)
3447 volatile Lisp_Object proc
;
3448 unsigned char *volatile buf
;
3450 volatile Lisp_Object object
;
3452 /* Use volatile to protect variables from being clobbered by longjmp. */
3454 struct coding_system
*coding
;
3455 struct gcpro gcpro1
;
3460 struct Lisp_Process
*p
= XPROCESS (proc
);
3461 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
3464 if (! NILP (XPROCESS (proc
)->raw_status_low
))
3465 update_status (XPROCESS (proc
));
3466 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
3467 error ("Process %s not running",
3468 XSTRING (XPROCESS (proc
)->name
)->data
);
3469 if (XINT (XPROCESS (proc
)->outfd
) < 0)
3470 error ("Output file descriptor of %s is closed",
3471 XSTRING (XPROCESS (proc
)->name
)->data
);
3473 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
3474 Vlast_coding_system_used
= coding
->symbol
;
3476 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
3477 || (BUFFERP (object
)
3478 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
3481 if (!EQ (coding
->symbol
, XPROCESS (proc
)->encode_coding_system
))
3482 /* The coding system for encoding was changed to raw-text
3483 because we sent a unibyte text previously. Now we are
3484 sending a multibyte text, thus we must encode it by the
3485 original coding system specified for the current
3487 setup_coding_system (XPROCESS (proc
)->encode_coding_system
, coding
);
3488 /* src_multibyte should be set to 1 _after_ a call to
3489 setup_coding_system, since it resets src_multibyte to
3491 coding
->src_multibyte
= 1;
3495 /* For sending a unibyte text, character code conversion should
3496 not take place but EOL conversion should. So, setup raw-text
3497 or one of the subsidiary if we have not yet done it. */
3498 if (coding
->type
!= coding_type_raw_text
)
3500 if (CODING_REQUIRE_FLUSHING (coding
))
3502 /* But, before changing the coding, we must flush out data. */
3503 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
3504 send_process (proc
, "", 0, Qt
);
3506 coding
->src_multibyte
= 0;
3507 setup_raw_text_coding_system (coding
);
3510 coding
->dst_multibyte
= 0;
3512 if (CODING_REQUIRE_ENCODING (coding
))
3514 int require
= encoding_buffer_size (coding
, len
);
3515 int from_byte
= -1, from
= -1, to
= -1;
3516 unsigned char *temp_buf
= NULL
;
3518 if (BUFFERP (object
))
3520 from_byte
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
3521 from
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
);
3522 to
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
+ len
);
3524 else if (STRINGP (object
))
3526 from_byte
= buf
- XSTRING (object
)->data
;
3527 from
= string_byte_to_char (object
, from_byte
);
3528 to
= string_byte_to_char (object
, from_byte
+ len
);
3531 if (coding
->composing
!= COMPOSITION_DISABLED
)
3534 coding_save_composition (coding
, from
, to
, object
);
3536 coding
->composing
= COMPOSITION_DISABLED
;
3539 if (STRING_BYTES (XSTRING (XPROCESS (proc
)->encoding_buf
)) < require
)
3540 XPROCESS (proc
)->encoding_buf
= make_uninit_string (require
);
3543 buf
= (BUFFERP (object
)
3544 ? BUF_BYTE_ADDRESS (XBUFFER (object
), from_byte
)
3545 : XSTRING (object
)->data
+ from_byte
);
3547 object
= XPROCESS (proc
)->encoding_buf
;
3548 encode_coding (coding
, (char *) buf
, XSTRING (object
)->data
,
3549 len
, STRING_BYTES (XSTRING (object
)));
3550 len
= coding
->produced
;
3551 buf
= XSTRING (object
)->data
;
3557 vs
= get_vms_process_pointer (p
->pid
);
3559 error ("Could not find this process: %x", p
->pid
);
3560 else if (write_to_vms_process (vs
, buf
, len
))
3564 if (pty_max_bytes
== 0)
3566 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
3567 pty_max_bytes
= fpathconf (XFASTINT (XPROCESS (proc
)->outfd
),
3569 if (pty_max_bytes
< 0)
3570 pty_max_bytes
= 250;
3572 pty_max_bytes
= 250;
3574 /* Deduct one, to leave space for the eof. */
3578 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
3579 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
3580 when returning with longjmp despite being declared volatile. */
3581 if (!setjmp (send_process_frame
))
3583 process_sent_to
= proc
;
3587 SIGTYPE (*old_sigpipe
)();
3589 /* Decide how much data we can send in one batch.
3590 Long lines need to be split into multiple batches. */
3591 if (!NILP (XPROCESS (proc
)->pty_flag
))
3593 /* Starting this at zero is always correct when not the first
3594 iteration because the previous iteration ended by sending C-d.
3595 It may not be correct for the first iteration
3596 if a partial line was sent in a separate send_process call.
3597 If that proves worth handling, we need to save linepos
3598 in the process object. */
3600 unsigned char *ptr
= (unsigned char *) buf
;
3601 unsigned char *end
= (unsigned char *) buf
+ len
;
3603 /* Scan through this text for a line that is too long. */
3604 while (ptr
!= end
&& linepos
< pty_max_bytes
)
3612 /* If we found one, break the line there
3613 and put in a C-d to force the buffer through. */
3617 /* Send this batch, using one or more write calls. */
3620 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
3621 rv
= emacs_write (XINT (XPROCESS (proc
)->outfd
),
3622 (char *) buf
, this);
3623 signal (SIGPIPE
, old_sigpipe
);
3629 || errno
== EWOULDBLOCK
3635 /* Buffer is full. Wait, accepting input;
3636 that may allow the program
3637 to finish doing output and read more. */
3642 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
3643 /* A gross hack to work around a bug in FreeBSD.
3644 In the following sequence, read(2) returns
3648 write(2) 954 bytes, get EAGAIN
3649 read(2) 1024 bytes in process_read_output
3650 read(2) 11 bytes in process_read_output
3652 That is, read(2) returns more bytes than have
3653 ever been written successfully. The 1033 bytes
3654 read are the 1022 bytes written successfully
3655 after processing (for example with CRs added if
3656 the terminal is set up that way which it is
3657 here). The same bytes will be seen again in a
3658 later read(2), without the CRs. */
3660 if (errno
== EAGAIN
)
3663 ioctl (XINT (XPROCESS (proc
)->outfd
), TIOCFLUSH
,
3666 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
3668 /* Running filters might relocate buffers or strings.
3669 Arrange to relocate BUF. */
3670 if (BUFFERP (object
))
3671 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
3672 else if (STRINGP (object
))
3673 offset
= buf
- XSTRING (object
)->data
;
3675 XSETFASTINT (zero
, 0);
3676 #ifdef EMACS_HAS_USECS
3677 wait_reading_process_input (0, 20000, zero
, 0);
3679 wait_reading_process_input (1, 0, zero
, 0);
3682 if (BUFFERP (object
))
3683 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
3684 else if (STRINGP (object
))
3685 buf
= offset
+ XSTRING (object
)->data
;
3690 /* This is a real error. */
3691 report_file_error ("writing to process", Fcons (proc
, Qnil
));
3698 /* If we sent just part of the string, put in an EOF
3699 to force it through, before we send the rest. */
3701 Fprocess_send_eof (proc
);
3704 #endif /* not VMS */
3708 proc
= process_sent_to
;
3710 XPROCESS (proc
)->raw_status_low
= Qnil
;
3711 XPROCESS (proc
)->raw_status_high
= Qnil
;
3712 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
3713 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
3714 deactivate_process (proc
);
3716 error ("Error writing to process %s; closed it",
3717 XSTRING (XPROCESS (proc
)->name
)->data
);
3719 error ("SIGPIPE raised on process %s; closed it",
3720 XSTRING (XPROCESS (proc
)->name
)->data
);
3727 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
3729 doc
: /* Send current contents of region as input to PROCESS.
3730 PROCESS may be a process, a buffer, the name of a process or buffer, or
3731 nil, indicating the current buffer's process.
3732 Called from program, takes three arguments, PROCESS, START and END.
3733 If the region is more than 500 characters long,
3734 it is sent in several bunches. This may happen even for shorter regions.
3735 Output from processes can arrive in between bunches. */)
3736 (process
, start
, end
)
3737 Lisp_Object process
, start
, end
;
3742 proc
= get_process (process
);
3743 validate_region (&start
, &end
);
3745 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
3746 move_gap (XINT (start
));
3748 start1
= CHAR_TO_BYTE (XINT (start
));
3749 end1
= CHAR_TO_BYTE (XINT (end
));
3750 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
3751 Fcurrent_buffer ());
3756 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
3758 doc
: /* Send PROCESS the contents of STRING as input.
3759 PROCESS may be a process, a buffer, the name of a process or buffer, or
3760 nil, indicating the current buffer's process.
3761 If STRING is more than 500 characters long,
3762 it is sent in several bunches. This may happen even for shorter strings.
3763 Output from processes can arrive in between bunches. */)
3765 Lisp_Object process
, string
;
3768 CHECK_STRING (string
);
3769 proc
= get_process (process
);
3770 send_process (proc
, XSTRING (string
)->data
,
3771 STRING_BYTES (XSTRING (string
)), string
);
3775 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
3776 Sprocess_running_child_p
, 0, 1, 0,
3777 doc
: /* Return t if PROCESS has given the terminal to a child.
3778 If the operating system does not make it possible to find out,
3779 return t unconditionally. */)
3781 Lisp_Object process
;
3783 /* Initialize in case ioctl doesn't exist or gives an error,
3784 in a way that will cause returning t. */
3787 struct Lisp_Process
*p
;
3789 proc
= get_process (process
);
3790 p
= XPROCESS (proc
);
3792 if (!EQ (p
->childp
, Qt
))
3793 error ("Process %s is not a subprocess",
3794 XSTRING (p
->name
)->data
);
3795 if (XINT (p
->infd
) < 0)
3796 error ("Process %s is not active",
3797 XSTRING (p
->name
)->data
);
3800 if (!NILP (p
->subtty
))
3801 ioctl (XFASTINT (p
->subtty
), TIOCGPGRP
, &gid
);
3803 ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
);
3804 #endif /* defined (TIOCGPGRP ) */
3806 if (gid
== XFASTINT (p
->pid
))
3811 /* send a signal number SIGNO to PROCESS.
3812 If CURRENT_GROUP is t, that means send to the process group
3813 that currently owns the terminal being used to communicate with PROCESS.
3814 This is used for various commands in shell mode.
3815 If CURRENT_GROUP is lambda, that means send to the process group
3816 that currently owns the terminal, but only if it is NOT the shell itself.
3818 If NOMSG is zero, insert signal-announcements into process's buffers
3821 If we can, we try to signal PROCESS by sending control characters
3822 down the pty. This allows us to signal inferiors who have changed
3823 their uid, for which killpg would return an EPERM error. */
3826 process_send_signal (process
, signo
, current_group
, nomsg
)
3827 Lisp_Object process
;
3829 Lisp_Object current_group
;
3833 register struct Lisp_Process
*p
;
3837 proc
= get_process (process
);
3838 p
= XPROCESS (proc
);
3840 if (!EQ (p
->childp
, Qt
))
3841 error ("Process %s is not a subprocess",
3842 XSTRING (p
->name
)->data
);
3843 if (XINT (p
->infd
) < 0)
3844 error ("Process %s is not active",
3845 XSTRING (p
->name
)->data
);
3847 if (NILP (p
->pty_flag
))
3848 current_group
= Qnil
;
3850 /* If we are using pgrps, get a pgrp number and make it negative. */
3851 if (!NILP (current_group
))
3853 #ifdef SIGNALS_VIA_CHARACTERS
3854 /* If possible, send signals to the entire pgrp
3855 by sending an input character to it. */
3857 /* TERMIOS is the latest and bestest, and seems most likely to
3858 work. If the system has it, use it. */
3865 tcgetattr (XINT (p
->infd
), &t
);
3866 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
3870 tcgetattr (XINT (p
->infd
), &t
);
3871 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
3875 tcgetattr (XINT (p
->infd
), &t
);
3876 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
3877 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
3879 send_process (proc
, &t
.c_cc
[VSUSP
], 1, Qnil
);
3884 #else /* ! HAVE_TERMIOS */
3886 /* On Berkeley descendants, the following IOCTL's retrieve the
3887 current control characters. */
3888 #if defined (TIOCGLTC) && defined (TIOCGETC)
3896 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
3897 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
3900 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
3901 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
3905 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
3906 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
3908 #endif /* ! defined (SIGTSTP) */
3911 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
3913 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
3920 ioctl (XINT (p
->infd
), TCGETA
, &t
);
3921 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
3924 ioctl (XINT (p
->infd
), TCGETA
, &t
);
3925 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
3929 ioctl (XINT (p
->infd
), TCGETA
, &t
);
3930 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
3932 #endif /* ! defined (SIGTSTP) */
3934 #else /* ! defined (TCGETA) */
3935 Your configuration files are messed up
.
3936 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
3937 you'd better be using one of the alternatives above! */
3938 #endif /* ! defined (TCGETA) */
3939 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
3940 #endif /* ! defined HAVE_TERMIOS */
3941 #endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
3944 /* Get the pgrp using the tty itself, if we have that.
3945 Otherwise, use the pty to get the pgrp.
3946 On pfa systems, saka@pfu.fujitsu.co.JP writes:
3947 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
3948 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
3949 His patch indicates that if TIOCGPGRP returns an error, then
3950 we should just assume that p->pid is also the process group id. */
3954 if (!NILP (p
->subtty
))
3955 err
= ioctl (XFASTINT (p
->subtty
), TIOCGPGRP
, &gid
);
3957 err
= ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
);
3961 gid
= - XFASTINT (p
->pid
);
3962 #endif /* ! defined (pfa) */
3968 #else /* ! defined (TIOCGPGRP ) */
3969 /* Can't select pgrps on this system, so we know that
3970 the child itself heads the pgrp. */
3971 gid
= - XFASTINT (p
->pid
);
3972 #endif /* ! defined (TIOCGPGRP ) */
3974 /* If current_group is lambda, and the shell owns the terminal,
3975 don't send any signal. */
3976 if (EQ (current_group
, Qlambda
) && gid
== - XFASTINT (p
->pid
))
3980 gid
= - XFASTINT (p
->pid
);
3986 p
->raw_status_low
= Qnil
;
3987 p
->raw_status_high
= Qnil
;
3989 XSETINT (p
->tick
, ++process_tick
);
3993 #endif /* ! defined (SIGCONT) */
3996 send_process (proc
, "\003", 1, Qnil
); /* ^C */
4001 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
4006 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
4009 flush_pending_output (XINT (p
->infd
));
4013 /* If we don't have process groups, send the signal to the immediate
4014 subprocess. That isn't really right, but it's better than any
4015 obvious alternative. */
4018 kill (XFASTINT (p
->pid
), signo
);
4022 /* gid may be a pid, or minus a pgrp's number */
4024 if (!NILP (current_group
))
4025 ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
);
4028 gid
= - XFASTINT (p
->pid
);
4031 #else /* ! defined (TIOCSIGSEND) */
4032 EMACS_KILLPG (-gid
, signo
);
4033 #endif /* ! defined (TIOCSIGSEND) */
4036 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
4037 doc
: /* Interrupt process PROCESS.
4038 PROCESS may be a process, a buffer, or the name of a process or buffer.
4039 nil or no arg means current buffer's process.
4040 Second arg CURRENT-GROUP non-nil means send signal to
4041 the current process-group of the process's controlling terminal
4042 rather than to the process's own process group.
4043 If the process is a shell, this means interrupt current subjob
4044 rather than the shell.
4046 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
4047 don't send the signal. */)
4048 (process
, current_group
)
4049 Lisp_Object process
, current_group
;
4051 process_send_signal (process
, SIGINT
, current_group
, 0);
4055 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
4056 doc
: /* Kill process PROCESS. May be process or name of one.
4057 See function `interrupt-process' for more details on usage. */)
4058 (process
, current_group
)
4059 Lisp_Object process
, current_group
;
4061 process_send_signal (process
, SIGKILL
, current_group
, 0);
4065 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
4066 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
4067 See function `interrupt-process' for more details on usage. */)
4068 (process
, current_group
)
4069 Lisp_Object process
, current_group
;
4071 process_send_signal (process
, SIGQUIT
, current_group
, 0);
4075 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
4076 doc
: /* Stop process PROCESS. May be process or name of one.
4077 See function `interrupt-process' for more details on usage. */)
4078 (process
, current_group
)
4079 Lisp_Object process
, current_group
;
4082 error ("no SIGTSTP support");
4084 process_send_signal (process
, SIGTSTP
, current_group
, 0);
4089 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
4090 doc
: /* Continue process PROCESS. May be process or name of one.
4091 See function `interrupt-process' for more details on usage. */)
4092 (process
, current_group
)
4093 Lisp_Object process
, current_group
;
4096 process_send_signal (process
, SIGCONT
, current_group
, 0);
4098 error ("no SIGCONT support");
4103 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
4104 2, 2, "nProcess number: \nnSignal code: ",
4105 doc
: /* Send the process with process id PID the signal with code SIGCODE.
4106 PID must be an integer. The process need not be a child of this Emacs.
4107 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
4109 Lisp_Object pid
, sigcode
;
4113 #define handle_signal(NAME, VALUE) \
4114 else if (!strcmp (name, NAME)) \
4115 XSETINT (sigcode, VALUE)
4117 if (INTEGERP (sigcode
))
4121 unsigned char *name
;
4123 CHECK_SYMBOL (sigcode
);
4124 name
= XSYMBOL (sigcode
)->name
->data
;
4129 handle_signal ("SIGHUP", SIGHUP
);
4132 handle_signal ("SIGINT", SIGINT
);
4135 handle_signal ("SIGQUIT", SIGQUIT
);
4138 handle_signal ("SIGILL", SIGILL
);
4141 handle_signal ("SIGABRT", SIGABRT
);
4144 handle_signal ("SIGEMT", SIGEMT
);
4147 handle_signal ("SIGKILL", SIGKILL
);
4150 handle_signal ("SIGFPE", SIGFPE
);
4153 handle_signal ("SIGBUS", SIGBUS
);
4156 handle_signal ("SIGSEGV", SIGSEGV
);
4159 handle_signal ("SIGSYS", SIGSYS
);
4162 handle_signal ("SIGPIPE", SIGPIPE
);
4165 handle_signal ("SIGALRM", SIGALRM
);
4168 handle_signal ("SIGTERM", SIGTERM
);
4171 handle_signal ("SIGURG", SIGURG
);
4174 handle_signal ("SIGSTOP", SIGSTOP
);
4177 handle_signal ("SIGTSTP", SIGTSTP
);
4180 handle_signal ("SIGCONT", SIGCONT
);
4183 handle_signal ("SIGCHLD", SIGCHLD
);
4186 handle_signal ("SIGTTIN", SIGTTIN
);
4189 handle_signal ("SIGTTOU", SIGTTOU
);
4192 handle_signal ("SIGIO", SIGIO
);
4195 handle_signal ("SIGXCPU", SIGXCPU
);
4198 handle_signal ("SIGXFSZ", SIGXFSZ
);
4201 handle_signal ("SIGVTALRM", SIGVTALRM
);
4204 handle_signal ("SIGPROF", SIGPROF
);
4207 handle_signal ("SIGWINCH", SIGWINCH
);
4210 handle_signal ("SIGINFO", SIGINFO
);
4213 handle_signal ("SIGUSR1", SIGUSR1
);
4216 handle_signal ("SIGUSR2", SIGUSR2
);
4219 error ("Undefined signal name %s", name
);
4222 #undef handle_signal
4224 return make_number (kill (XINT (pid
), XINT (sigcode
)));
4227 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
4228 doc
: /* Make PROCESS see end-of-file in its input.
4229 EOF comes after any text already sent to it.
4230 PROCESS may be a process, a buffer, the name of a process or buffer, or
4231 nil, indicating the current buffer's process.
4232 If PROCESS is a network connection, or is a process communicating
4233 through a pipe (as opposed to a pty), then you cannot send any more
4234 text to PROCESS after you call this function. */)
4236 Lisp_Object process
;
4239 struct coding_system
*coding
;
4241 proc
= get_process (process
);
4242 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
4244 /* Make sure the process is really alive. */
4245 if (! NILP (XPROCESS (proc
)->raw_status_low
))
4246 update_status (XPROCESS (proc
));
4247 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
4248 error ("Process %s not running", XSTRING (XPROCESS (proc
)->name
)->data
);
4250 if (CODING_REQUIRE_FLUSHING (coding
))
4252 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4253 send_process (proc
, "", 0, Qnil
);
4257 send_process (proc
, "\032", 1, Qnil
); /* ^z */
4259 if (!NILP (XPROCESS (proc
)->pty_flag
))
4260 send_process (proc
, "\004", 1, Qnil
);
4263 int old_outfd
, new_outfd
;
4265 #ifdef HAVE_SHUTDOWN
4266 /* If this is a network connection, or socketpair is used
4267 for communication with the subprocess, call shutdown to cause EOF.
4268 (In some old system, shutdown to socketpair doesn't work.
4269 Then we just can't win.) */
4270 if (NILP (XPROCESS (proc
)->pid
)
4271 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
4272 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
4273 /* In case of socketpair, outfd == infd, so don't close it. */
4274 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
4275 emacs_close (XINT (XPROCESS (proc
)->outfd
));
4276 #else /* not HAVE_SHUTDOWN */
4277 emacs_close (XINT (XPROCESS (proc
)->outfd
));
4278 #endif /* not HAVE_SHUTDOWN */
4279 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
4280 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
4282 if (!proc_encode_coding_system
[new_outfd
])
4283 proc_encode_coding_system
[new_outfd
]
4284 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
4285 bcopy (proc_encode_coding_system
[old_outfd
],
4286 proc_encode_coding_system
[new_outfd
],
4287 sizeof (struct coding_system
));
4288 bzero (proc_encode_coding_system
[old_outfd
],
4289 sizeof (struct coding_system
));
4291 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
4297 /* Kill all processes associated with `buffer'.
4298 If `buffer' is nil, kill all processes */
4301 kill_buffer_processes (buffer
)
4304 Lisp_Object tail
, proc
;
4306 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
4308 proc
= XCDR (XCAR (tail
));
4309 if (GC_PROCESSP (proc
)
4310 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
4312 if (NETCONN_P (proc
))
4313 Fdelete_process (proc
);
4314 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
4315 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
4320 /* On receipt of a signal that a child status has changed, loop asking
4321 about children with changed statuses until the system says there
4324 All we do is change the status; we do not run sentinels or print
4325 notifications. That is saved for the next time keyboard input is
4326 done, in order to avoid timing errors.
4328 ** WARNING: this can be called during garbage collection.
4329 Therefore, it must not be fooled by the presence of mark bits in
4332 ** USG WARNING: Although it is not obvious from the documentation
4333 in signal(2), on a USG system the SIGCLD handler MUST NOT call
4334 signal() before executing at least one wait(), otherwise the
4335 handler will be called again, resulting in an infinite loop. The
4336 relevant portion of the documentation reads "SIGCLD signals will be
4337 queued and the signal-catching function will be continually
4338 reentered until the queue is empty". Invoking signal() causes the
4339 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
4343 sigchld_handler (signo
)
4346 int old_errno
= errno
;
4348 register struct Lisp_Process
*p
;
4349 extern EMACS_TIME
*input_available_clear_time
;
4353 sigheld
|= sigbit (SIGCHLD
);
4365 #endif /* no WUNTRACED */
4366 /* Keep trying to get a status until we get a definitive result. */
4370 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
4372 while (pid
< 0 && errno
== EINTR
);
4376 /* PID == 0 means no processes found, PID == -1 means a real
4377 failure. We have done all our job, so return. */
4379 /* USG systems forget handlers when they are used;
4380 must reestablish each time */
4381 #if defined (USG) && !defined (POSIX_SIGNALS)
4382 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
4385 sigheld
&= ~sigbit (SIGCHLD
);
4393 #endif /* no WNOHANG */
4395 /* Find the process that signaled us, and record its status. */
4398 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
4400 proc
= XCDR (XCAR (tail
));
4401 p
= XPROCESS (proc
);
4402 if (GC_EQ (p
->childp
, Qt
) && XINT (p
->pid
) == pid
)
4407 /* Look for an asynchronous process whose pid hasn't been filled
4410 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
4412 proc
= XCDR (XCAR (tail
));
4413 p
= XPROCESS (proc
);
4414 if (GC_INTEGERP (p
->pid
) && XINT (p
->pid
) == -1)
4419 /* Change the status of the process that was found. */
4422 union { int i
; WAITTYPE wt
; } u
;
4423 int clear_desc_flag
= 0;
4425 XSETINT (p
->tick
, ++process_tick
);
4427 XSETINT (p
->raw_status_low
, u
.i
& 0xffff);
4428 XSETINT (p
->raw_status_high
, u
.i
>> 16);
4430 /* If process has terminated, stop waiting for its output. */
4431 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
4432 && XINT (p
->infd
) >= 0)
4433 clear_desc_flag
= 1;
4435 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
4436 if (clear_desc_flag
)
4438 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
4439 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
4442 /* Tell wait_reading_process_input that it needs to wake up and
4444 if (input_available_clear_time
)
4445 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
4448 /* There was no asynchronous process found for that id. Check
4449 if we have a synchronous process. */
4452 synch_process_alive
= 0;
4454 /* Report the status of the synchronous process. */
4456 synch_process_retcode
= WRETCODE (w
);
4457 else if (WIFSIGNALED (w
))
4459 int code
= WTERMSIG (w
);
4462 synchronize_system_messages_locale ();
4463 signame
= strsignal (code
);
4466 signame
= "unknown";
4468 synch_process_death
= signame
;
4471 /* Tell wait_reading_process_input that it needs to wake up and
4473 if (input_available_clear_time
)
4474 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
4477 /* On some systems, we must return right away.
4478 If any more processes want to signal us, we will
4480 Otherwise (on systems that have WNOHANG), loop around
4481 to use up all the processes that have something to tell us. */
4482 #if (defined WINDOWSNT \
4483 || (defined USG && !defined GNU_LINUX \
4484 && !(defined HPUX && defined WNOHANG)))
4485 #if defined (USG) && ! defined (POSIX_SIGNALS)
4486 signal (signo
, sigchld_handler
);
4490 #endif /* USG, but not HPUX with WNOHANG */
4496 exec_sentinel_unwind (data
)
4499 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
4504 exec_sentinel_error_handler (error
)
4507 cmd_error_internal (error
, "error in process sentinel: ");
4509 update_echo_area ();
4510 Fsleep_for (make_number (2), Qnil
);
4515 exec_sentinel (proc
, reason
)
4516 Lisp_Object proc
, reason
;
4518 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
4519 register struct Lisp_Process
*p
= XPROCESS (proc
);
4520 int count
= specpdl_ptr
- specpdl
;
4521 int outer_running_asynch_code
= running_asynch_code
;
4522 int waiting
= waiting_for_user_input_p
;
4524 /* No need to gcpro these, because all we do with them later
4525 is test them for EQness, and none of them should be a string. */
4526 odeactivate
= Vdeactivate_mark
;
4527 XSETBUFFER (obuffer
, current_buffer
);
4528 okeymap
= current_buffer
->keymap
;
4530 sentinel
= p
->sentinel
;
4531 if (NILP (sentinel
))
4534 /* Zilch the sentinel while it's running, to avoid recursive invocations;
4535 assure that it gets restored no matter how the sentinel exits. */
4537 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
4538 /* Inhibit quit so that random quits don't screw up a running filter. */
4539 specbind (Qinhibit_quit
, Qt
);
4540 specbind (Qlast_nonmenu_event
, Qt
);
4542 /* In case we get recursively called,
4543 and we already saved the match data nonrecursively,
4544 save the same match data in safely recursive fashion. */
4545 if (outer_running_asynch_code
)
4548 tem
= Fmatch_data (Qnil
, Qnil
);
4549 restore_match_data ();
4550 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
4551 Fset_match_data (tem
);
4554 /* For speed, if a search happens within this code,
4555 save the match data in a special nonrecursive fashion. */
4556 running_asynch_code
= 1;
4558 internal_condition_case_1 (read_process_output_call
,
4560 Fcons (proc
, Fcons (reason
, Qnil
))),
4561 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
4562 exec_sentinel_error_handler
);
4564 /* If we saved the match data nonrecursively, restore it now. */
4565 restore_match_data ();
4566 running_asynch_code
= outer_running_asynch_code
;
4568 Vdeactivate_mark
= odeactivate
;
4570 /* Restore waiting_for_user_input_p as it was
4571 when we were called, in case the filter clobbered it. */
4572 waiting_for_user_input_p
= waiting
;
4575 if (! EQ (Fcurrent_buffer (), obuffer
)
4576 || ! EQ (current_buffer
->keymap
, okeymap
))
4578 /* But do it only if the caller is actually going to read events.
4579 Otherwise there's no need to make him wake up, and it could
4580 cause trouble (for example it would make Fsit_for return). */
4581 if (waiting_for_user_input_p
== -1)
4582 record_asynch_buffer_change ();
4584 unbind_to (count
, Qnil
);
4587 /* Report all recent events of a change in process status
4588 (either run the sentinel or output a message).
4589 This is done while Emacs is waiting for keyboard input. */
4594 register Lisp_Object proc
, buffer
;
4595 Lisp_Object tail
, msg
;
4596 struct gcpro gcpro1
, gcpro2
;
4600 /* We need to gcpro tail; if read_process_output calls a filter
4601 which deletes a process and removes the cons to which tail points
4602 from Vprocess_alist, and then causes a GC, tail is an unprotected
4606 /* Set this now, so that if new processes are created by sentinels
4607 that we run, we get called again to handle their status changes. */
4608 update_tick
= process_tick
;
4610 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
4613 register struct Lisp_Process
*p
;
4615 proc
= Fcdr (Fcar (tail
));
4616 p
= XPROCESS (proc
);
4618 if (XINT (p
->tick
) != XINT (p
->update_tick
))
4620 XSETINT (p
->update_tick
, XINT (p
->tick
));
4622 /* If process is still active, read any output that remains. */
4623 while (! EQ (p
->filter
, Qt
)
4624 && ! EQ (p
->status
, Qconnect
)
4625 && XINT (p
->infd
) >= 0
4626 && read_process_output (proc
, XINT (p
->infd
)) > 0);
4630 /* Get the text to use for the message. */
4631 if (!NILP (p
->raw_status_low
))
4633 msg
= status_message (p
->status
);
4635 /* If process is terminated, deactivate it or delete it. */
4637 if (CONSP (p
->status
))
4638 symbol
= XCAR (p
->status
);
4640 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
4641 || EQ (symbol
, Qclosed
))
4643 if (delete_exited_processes
)
4644 remove_process (proc
);
4646 deactivate_process (proc
);
4649 /* The actions above may have further incremented p->tick.
4650 So set p->update_tick again
4651 so that an error in the sentinel will not cause
4652 this code to be run again. */
4653 XSETINT (p
->update_tick
, XINT (p
->tick
));
4654 /* Now output the message suitably. */
4655 if (!NILP (p
->sentinel
))
4656 exec_sentinel (proc
, msg
);
4657 /* Don't bother with a message in the buffer
4658 when a process becomes runnable. */
4659 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
4661 Lisp_Object ro
, tem
;
4662 struct buffer
*old
= current_buffer
;
4663 int opoint
, opoint_byte
;
4664 int before
, before_byte
;
4666 ro
= XBUFFER (buffer
)->read_only
;
4668 /* Avoid error if buffer is deleted
4669 (probably that's why the process is dead, too) */
4670 if (NILP (XBUFFER (buffer
)->name
))
4672 Fset_buffer (buffer
);
4675 opoint_byte
= PT_BYTE
;
4676 /* Insert new output into buffer
4677 at the current end-of-output marker,
4678 thus preserving logical ordering of input and output. */
4679 if (XMARKER (p
->mark
)->buffer
)
4680 Fgoto_char (p
->mark
);
4682 SET_PT_BOTH (ZV
, ZV_BYTE
);
4685 before_byte
= PT_BYTE
;
4687 tem
= current_buffer
->read_only
;
4688 current_buffer
->read_only
= Qnil
;
4689 insert_string ("\nProcess ");
4690 Finsert (1, &p
->name
);
4691 insert_string (" ");
4693 current_buffer
->read_only
= tem
;
4694 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
4696 if (opoint
>= before
)
4697 SET_PT_BOTH (opoint
+ (PT
- before
),
4698 opoint_byte
+ (PT_BYTE
- before_byte
));
4700 SET_PT_BOTH (opoint
, opoint_byte
);
4702 set_buffer_internal (old
);
4707 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
4708 redisplay_preserve_echo_area (13);
4714 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
4715 Sset_process_coding_system
, 1, 3, 0,
4716 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
4717 DECODING will be used to decode subprocess output and ENCODING to
4718 encode subprocess input. */)
4719 (proc
, decoding
, encoding
)
4720 register Lisp_Object proc
, decoding
, encoding
;
4722 register struct Lisp_Process
*p
;
4724 CHECK_PROCESS (proc
);
4725 p
= XPROCESS (proc
);
4726 if (XINT (p
->infd
) < 0)
4727 error ("Input file descriptor of %s closed", XSTRING (p
->name
)->data
);
4728 if (XINT (p
->outfd
) < 0)
4729 error ("Output file descriptor of %s closed", XSTRING (p
->name
)->data
);
4731 p
->decode_coding_system
= Fcheck_coding_system (decoding
);
4732 p
->encode_coding_system
= Fcheck_coding_system (encoding
);
4733 setup_coding_system (decoding
,
4734 proc_decode_coding_system
[XINT (p
->infd
)]);
4735 setup_coding_system (encoding
,
4736 proc_encode_coding_system
[XINT (p
->outfd
)]);
4741 DEFUN ("process-coding-system",
4742 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
4743 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
4745 register Lisp_Object proc
;
4747 CHECK_PROCESS (proc
);
4748 return Fcons (XPROCESS (proc
)->decode_coding_system
,
4749 XPROCESS (proc
)->encode_coding_system
);
4752 /* The first time this is called, assume keyboard input comes from DESC
4753 instead of from where we used to expect it.
4754 Subsequent calls mean assume input keyboard can come from DESC
4755 in addition to other places. */
4757 static int add_keyboard_wait_descriptor_called_flag
;
4760 add_keyboard_wait_descriptor (desc
)
4763 if (! add_keyboard_wait_descriptor_called_flag
)
4764 FD_CLR (0, &input_wait_mask
);
4765 add_keyboard_wait_descriptor_called_flag
= 1;
4766 FD_SET (desc
, &input_wait_mask
);
4767 FD_SET (desc
, &non_process_wait_mask
);
4768 if (desc
> max_keyboard_desc
)
4769 max_keyboard_desc
= desc
;
4772 /* From now on, do not expect DESC to give keyboard input. */
4775 delete_keyboard_wait_descriptor (desc
)
4779 int lim
= max_keyboard_desc
;
4781 FD_CLR (desc
, &input_wait_mask
);
4782 FD_CLR (desc
, &non_process_wait_mask
);
4784 if (desc
== max_keyboard_desc
)
4785 for (fd
= 0; fd
< lim
; fd
++)
4786 if (FD_ISSET (fd
, &input_wait_mask
)
4787 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
4788 max_keyboard_desc
= fd
;
4791 /* Return nonzero if *MASK has a bit set
4792 that corresponds to one of the keyboard input descriptors. */
4795 keyboard_bit_set (mask
)
4800 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
4801 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
4802 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
4815 if (! noninteractive
|| initialized
)
4817 signal (SIGCHLD
, sigchld_handler
);
4820 FD_ZERO (&input_wait_mask
);
4821 FD_ZERO (&non_keyboard_wait_mask
);
4822 FD_ZERO (&non_process_wait_mask
);
4823 max_process_desc
= 0;
4825 FD_SET (0, &input_wait_mask
);
4827 Vprocess_alist
= Qnil
;
4828 for (i
= 0; i
< MAXDESC
; i
++)
4830 chan_process
[i
] = Qnil
;
4831 proc_buffered_char
[i
] = -1;
4833 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
4834 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
4840 Qprocessp
= intern ("processp");
4841 staticpro (&Qprocessp
);
4842 Qrun
= intern ("run");
4844 Qstop
= intern ("stop");
4846 Qsignal
= intern ("signal");
4847 staticpro (&Qsignal
);
4849 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
4852 Qexit = intern ("exit");
4853 staticpro (&Qexit); */
4855 Qopen
= intern ("open");
4857 Qclosed
= intern ("closed");
4858 staticpro (&Qclosed
);
4859 Qconnect
= intern ("connect");
4860 staticpro (&Qconnect
);
4861 Qfailed
= intern ("failed");
4862 staticpro (&Qfailed
);
4864 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
4865 staticpro (&Qlast_nonmenu_event
);
4867 staticpro (&Vprocess_alist
);
4869 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
4870 doc
: /* *Non-nil means delete processes immediately when they exit.
4871 nil means don't delete them until `list-processes' is run. */);
4873 delete_exited_processes
= 1;
4875 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
4876 doc
: /* Control type of device used to communicate with subprocesses.
4877 Values are nil to use a pipe, or t or `pty' to use a pty.
4878 The value has no effect if the system has no ptys or if all ptys are busy:
4879 then a pipe is used in any case.
4880 The value takes effect when `start-process' is called. */);
4881 Vprocess_connection_type
= Qt
;
4883 defsubr (&Sprocessp
);
4884 defsubr (&Sget_process
);
4885 defsubr (&Sget_buffer_process
);
4886 defsubr (&Sdelete_process
);
4887 defsubr (&Sprocess_status
);
4888 defsubr (&Sprocess_exit_status
);
4889 defsubr (&Sprocess_id
);
4890 defsubr (&Sprocess_name
);
4891 defsubr (&Sprocess_tty_name
);
4892 defsubr (&Sprocess_command
);
4893 defsubr (&Sset_process_buffer
);
4894 defsubr (&Sprocess_buffer
);
4895 defsubr (&Sprocess_mark
);
4896 defsubr (&Sset_process_filter
);
4897 defsubr (&Sprocess_filter
);
4898 defsubr (&Sset_process_sentinel
);
4899 defsubr (&Sprocess_sentinel
);
4900 defsubr (&Sset_process_window_size
);
4901 defsubr (&Sset_process_inherit_coding_system_flag
);
4902 defsubr (&Sprocess_inherit_coding_system_flag
);
4903 defsubr (&Sprocess_kill_without_query
);
4904 defsubr (&Sprocess_contact
);
4905 defsubr (&Slist_processes
);
4906 defsubr (&Sprocess_list
);
4907 defsubr (&Sstart_process
);
4909 defsubr (&Sopen_network_stream
);
4910 #endif /* HAVE_SOCKETS */
4911 defsubr (&Saccept_process_output
);
4912 defsubr (&Sprocess_send_region
);
4913 defsubr (&Sprocess_send_string
);
4914 defsubr (&Sinterrupt_process
);
4915 defsubr (&Skill_process
);
4916 defsubr (&Squit_process
);
4917 defsubr (&Sstop_process
);
4918 defsubr (&Scontinue_process
);
4919 defsubr (&Sprocess_running_child_p
);
4920 defsubr (&Sprocess_send_eof
);
4921 defsubr (&Ssignal_process
);
4922 defsubr (&Swaiting_for_user_input_p
);
4923 /* defsubr (&Sprocess_connection); */
4924 defsubr (&Sset_process_coding_system
);
4925 defsubr (&Sprocess_coding_system
);
4929 #else /* not subprocesses */
4931 #include <sys/types.h>
4935 #include "systime.h"
4936 #include "charset.h"
4938 #include "termopts.h"
4939 #include "sysselect.h"
4941 extern int frame_garbaged
;
4943 extern EMACS_TIME
timer_check ();
4944 extern int timers_run
;
4946 /* As described above, except assuming that there are no subprocesses:
4948 Wait for timeout to elapse and/or keyboard input to be available.
4951 timeout in seconds, or
4952 zero for no limit, or
4953 -1 means gobble data immediately available but don't wait for any.
4955 read_kbd is a Lisp_Object:
4956 0 to ignore keyboard input, or
4957 1 to return when input is available, or
4958 -1 means caller will actually read the input, so don't throw to
4960 a cons cell, meaning wait until its car is non-nil
4961 (and gobble terminal input into the buffer if any arrives), or
4962 We know that read_kbd will never be a Lisp_Process, since
4963 `subprocesses' isn't defined.
4965 do_display != 0 means redisplay should be done to show subprocess
4966 output that arrives.
4968 Return true iff we received input from any process. */
4971 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
4972 int time_limit
, microsecs
;
4973 Lisp_Object read_kbd
;
4977 EMACS_TIME end_time
, timeout
;
4978 SELECT_TYPE waitchannels
;
4980 /* Either nil or a cons cell, the car of which is of interest and
4981 may be changed outside of this routine. */
4982 Lisp_Object wait_for_cell
= Qnil
;
4984 /* If waiting for non-nil in a cell, record where. */
4985 if (CONSP (read_kbd
))
4987 wait_for_cell
= read_kbd
;
4988 XSETFASTINT (read_kbd
, 0);
4991 /* What does time_limit really mean? */
4992 if (time_limit
|| microsecs
)
4994 EMACS_GET_TIME (end_time
);
4995 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4996 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4999 /* Turn off periodic alarms (in case they are in use)
5000 because the select emulator uses alarms. */
5001 turn_on_atimers (0);
5005 int timeout_reduced_for_timers
= 0;
5007 /* If calling from keyboard input, do not quit
5008 since we want to return C-g as an input character.
5009 Otherwise, do pending quit if requested. */
5010 if (XINT (read_kbd
) >= 0)
5013 /* Exit now if the cell we're waiting for became non-nil. */
5014 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
5017 /* Compute time from now till when time limit is up */
5018 /* Exit if already run out */
5019 if (time_limit
== -1)
5021 /* -1 specified for timeout means
5022 gobble output available now
5023 but don't wait at all. */
5025 EMACS_SET_SECS_USECS (timeout
, 0, 0);
5027 else if (time_limit
|| microsecs
)
5029 EMACS_GET_TIME (timeout
);
5030 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
5031 if (EMACS_TIME_NEG_P (timeout
))
5036 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
5039 /* If our caller will not immediately handle keyboard events,
5040 run timer events directly.
5041 (Callers that will immediately read keyboard events
5042 call timer_delay on their own.) */
5043 if (NILP (wait_for_cell
))
5045 EMACS_TIME timer_delay
;
5049 int old_timers_run
= timers_run
;
5050 timer_delay
= timer_check (1);
5051 if (timers_run
!= old_timers_run
&& do_display
)
5052 /* We must retry, since a timer may have requeued itself
5053 and that could alter the time delay. */
5054 redisplay_preserve_echo_area (14);
5058 while (!detect_input_pending ());
5060 /* If there is unread keyboard input, also return. */
5061 if (XINT (read_kbd
) != 0
5062 && requeued_events_pending_p ())
5065 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
5067 EMACS_TIME difference
;
5068 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
5069 if (EMACS_TIME_NEG_P (difference
))
5071 timeout
= timer_delay
;
5072 timeout_reduced_for_timers
= 1;
5077 /* Cause C-g and alarm signals to take immediate action,
5078 and cause input available signals to zero out timeout. */
5079 if (XINT (read_kbd
) < 0)
5080 set_waiting_for_input (&timeout
);
5082 /* Wait till there is something to do. */
5084 if (! XINT (read_kbd
) && NILP (wait_for_cell
))
5085 FD_ZERO (&waitchannels
);
5087 FD_SET (0, &waitchannels
);
5089 /* If a frame has been newly mapped and needs updating,
5090 reprocess its display stuff. */
5091 if (frame_garbaged
&& do_display
)
5093 clear_waiting_for_input ();
5094 redisplay_preserve_echo_area (15);
5095 if (XINT (read_kbd
) < 0)
5096 set_waiting_for_input (&timeout
);
5099 if (XINT (read_kbd
) && detect_input_pending ())
5102 FD_ZERO (&waitchannels
);
5105 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
5110 /* Make C-g and alarm signals set flags again */
5111 clear_waiting_for_input ();
5113 /* If we woke up due to SIGWINCH, actually change size now. */
5114 do_pending_window_change (0);
5116 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
5117 /* We waited the full specified time, so return now. */
5122 /* If the system call was interrupted, then go around the
5124 if (xerrno
== EINTR
)
5125 FD_ZERO (&waitchannels
);
5127 error ("select error: %s", emacs_strerror (xerrno
));
5130 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
5131 /* System sometimes fails to deliver SIGIO. */
5132 kill (getpid (), SIGIO
);
5135 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
5136 kill (getpid (), SIGIO
);
5139 /* Check for keyboard input */
5141 if ((XINT (read_kbd
) != 0)
5142 && detect_input_pending_run_timers (do_display
))
5144 swallow_events (do_display
);
5145 if (detect_input_pending_run_timers (do_display
))
5149 /* If there is unread keyboard input, also return. */
5150 if (XINT (read_kbd
) != 0
5151 && requeued_events_pending_p ())
5154 /* If wait_for_cell. check for keyboard input
5155 but don't run any timers.
5156 ??? (It seems wrong to me to check for keyboard
5157 input at all when wait_for_cell, but the code
5158 has been this way since July 1994.
5159 Try changing this after version 19.31.) */
5160 if (! NILP (wait_for_cell
)
5161 && detect_input_pending ())
5163 swallow_events (do_display
);
5164 if (detect_input_pending ())
5168 /* Exit now if the cell we're waiting for became non-nil. */
5169 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
5179 /* Don't confuse make-docfile by having two doc strings for this function.
5180 make-docfile does not pay attention to #if, for good reason! */
5181 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
5184 register Lisp_Object name
;
5189 /* Don't confuse make-docfile by having two doc strings for this function.
5190 make-docfile does not pay attention to #if, for good reason! */
5191 DEFUN ("process-inherit-coding-system-flag",
5192 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
5196 register Lisp_Object process
;
5198 /* Ignore the argument and return the value of
5199 inherit-process-coding-system. */
5200 return inherit_process_coding_system
? Qt
: Qnil
;
5203 /* Kill all processes associated with `buffer'.
5204 If `buffer' is nil, kill all processes.
5205 Since we have no subprocesses, this does nothing. */
5208 kill_buffer_processes (buffer
)
5221 defsubr (&Sget_buffer_process
);
5222 defsubr (&Sprocess_inherit_coding_system_flag
);
5226 #endif /* not subprocesses */