1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
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" */
105 #include "character.h"
108 #include "termhooks.h"
109 #include "termopts.h"
110 #include "commands.h"
111 #include "keyboard.h"
113 #include "blockinput.h"
114 #include "dispextern.h"
115 #include "composite.h"
118 Lisp_Object Qprocessp
;
119 Lisp_Object Qrun
, Qstop
, Qsignal
, Qopen
, Qclosed
;
120 Lisp_Object Qlast_nonmenu_event
;
121 /* Qexit is declared and initialized in eval.c. */
123 /* a process object is a network connection when its childp field is neither
124 Qt nor Qnil but is instead a cons cell (HOSTNAME PORTNUM). */
127 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
129 #define NETCONN_P(p) 0
130 #endif /* HAVE_SOCKETS */
132 /* Define first descriptor number available for subprocesses. */
134 #define FIRST_PROC_DESC 1
136 #define FIRST_PROC_DESC 3
139 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
142 #if !defined (SIGCHLD) && defined (SIGCLD)
143 #define SIGCHLD SIGCLD
146 #include "syssignal.h"
150 extern void set_waiting_for_input
P_ ((EMACS_TIME
*));
156 extern char *sys_errlist
[];
163 /* t means use pty, nil means use a pipe,
164 maybe other values to come. */
165 static Lisp_Object Vprocess_connection_type
;
169 #include <sys/socket.h>
173 /* These next two vars are non-static since sysdep.c uses them in the
174 emulation of `select'. */
175 /* Number of events of change of status of a process. */
177 /* Number of events for which the user or sentinel has been notified. */
180 #include "sysselect.h"
182 extern int keyboard_bit_set
P_ ((SELECT_TYPE
*));
184 /* If we support a window system, turn on the code to poll periodically
185 to detect C-g. It isn't actually used when doing interrupt input. */
186 #ifdef HAVE_WINDOW_SYSTEM
187 #define POLL_FOR_INPUT
190 /* Mask of bits indicating the descriptors that we wait for input on. */
192 static SELECT_TYPE input_wait_mask
;
194 /* Mask that excludes keyboard input descriptor (s). */
196 static SELECT_TYPE non_keyboard_wait_mask
;
198 /* Mask that excludes process input descriptor (s). */
200 static SELECT_TYPE non_process_wait_mask
;
202 /* The largest descriptor currently in use for a process object. */
203 static int max_process_desc
;
205 /* The largest descriptor currently in use for keyboard input. */
206 static int max_keyboard_desc
;
208 /* Nonzero means delete a process right away if it exits. */
209 static int delete_exited_processes
;
211 /* Indexed by descriptor, gives the process (if any) for that descriptor */
212 Lisp_Object chan_process
[MAXDESC
];
214 /* Alist of elements (NAME . PROCESS) */
215 Lisp_Object Vprocess_alist
;
217 /* Buffered-ahead input char from process, indexed by channel.
218 -1 means empty (no char is buffered).
219 Used on sys V where the only way to tell if there is any
220 output from the process is to read at least one char.
221 Always -1 on systems that support FIONREAD. */
223 /* Don't make static; need to access externally. */
224 int proc_buffered_char
[MAXDESC
];
226 /* Table of `struct coding-system' for each process. */
227 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
228 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
230 static Lisp_Object
get_process ();
232 extern EMACS_TIME
timer_check ();
233 extern int timers_run
;
235 /* Maximum number of bytes to send to a pty without an eof. */
236 static int pty_max_bytes
;
238 extern Lisp_Object Vfile_name_coding_system
, Vdefault_file_name_coding_system
;
244 /* The file name of the pty opened by allocate_pty. */
246 static char pty_name
[24];
249 /* Compute the Lisp form of the process status, p->status, from
250 the numeric status that was returned by `wait'. */
252 Lisp_Object
status_convert ();
256 struct Lisp_Process
*p
;
258 union { int i
; WAITTYPE wt
; } u
;
259 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
260 p
->status
= status_convert (u
.wt
);
261 p
->raw_status_low
= Qnil
;
262 p
->raw_status_high
= Qnil
;
265 /* Convert a process status word in Unix format to
266 the list that we use internally. */
273 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
274 else if (WIFEXITED (w
))
275 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
276 WCOREDUMP (w
) ? Qt
: Qnil
));
277 else if (WIFSIGNALED (w
))
278 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
279 WCOREDUMP (w
) ? Qt
: Qnil
));
284 /* Given a status-list, extract the three pieces of information
285 and store them individually through the three pointers. */
288 decode_status (l
, symbol
, code
, coredump
)
306 *code
= XFASTINT (XCAR (tem
));
308 *coredump
= !NILP (tem
);
312 /* Return a string describing a process status list. */
315 status_message (status
)
320 Lisp_Object string
, string2
;
322 decode_status (status
, &symbol
, &code
, &coredump
);
324 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
327 synchronize_system_messages_locale ();
328 signame
= strsignal (code
);
331 string
= build_string (signame
);
332 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
333 XSTRING (string
)->data
[0] = DOWNCASE (XSTRING (string
)->data
[0]);
334 return concat2 (string
, string2
);
336 else if (EQ (symbol
, Qexit
))
339 return build_string ("finished\n");
340 string
= Fnumber_to_string (make_number (code
));
341 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
342 return concat2 (build_string ("exited abnormally with code "),
343 concat2 (string
, string2
));
346 return Fcopy_sequence (Fsymbol_name (symbol
));
351 /* Open an available pty, returning a file descriptor.
352 Return -1 on failure.
353 The file name of the terminal corresponding to the pty
354 is left in the variable pty_name. */
363 /* Some systems name their pseudoterminals so that there are gaps in
364 the usual sequence - for example, on HP9000/S700 systems, there
365 are no pseudoterminals with names ending in 'f'. So we wait for
366 three failures in a row before deciding that we've reached the
368 int failed_count
= 0;
373 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
374 for (i
= 0; i
< 16; i
++)
377 #ifdef PTY_NAME_SPRINTF
380 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
381 #endif /* no PTY_NAME_SPRINTF */
385 #else /* no PTY_OPEN */
387 /* Unusual IRIS code */
388 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
391 if (fstat (fd
, &stb
) < 0)
394 if (stat (pty_name
, &stb
) < 0)
397 if (failed_count
>= 3)
403 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
405 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
407 #endif /* not IRIS */
408 #endif /* no PTY_OPEN */
412 /* check to make certain that both sides are available
413 this avoids a nasty yet stupid bug in rlogins */
414 #ifdef PTY_TTY_NAME_SPRINTF
417 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
418 #endif /* no PTY_TTY_NAME_SPRINTF */
420 if (access (pty_name
, 6) != 0)
423 #if !defined(IRIS) && !defined(__sgi)
429 #endif /* not UNIPLUS */
436 #endif /* HAVE_PTYS */
442 register Lisp_Object val
, tem
, name1
;
443 register struct Lisp_Process
*p
;
447 p
= allocate_process ();
449 XSETINT (p
->infd
, -1);
450 XSETINT (p
->outfd
, -1);
451 XSETFASTINT (p
->pid
, 0);
452 XSETFASTINT (p
->tick
, 0);
453 XSETFASTINT (p
->update_tick
, 0);
454 p
->raw_status_low
= Qnil
;
455 p
->raw_status_high
= Qnil
;
457 p
->mark
= Fmake_marker ();
459 /* If name is already in use, modify it until it is unused. */
464 tem
= Fget_process (name1
);
465 if (NILP (tem
)) break;
466 sprintf (suffix
, "<%d>", i
);
467 name1
= concat2 (name
, build_string (suffix
));
471 XSETPROCESS (val
, p
);
472 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
477 remove_process (proc
)
478 register Lisp_Object proc
;
480 register Lisp_Object pair
;
482 pair
= Frassq (proc
, Vprocess_alist
);
483 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
485 deactivate_process (proc
);
488 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
489 doc
: /* Return t if OBJECT is a process. */)
493 return PROCESSP (object
) ? Qt
: Qnil
;
496 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
497 doc
: /* Return the process named NAME, or nil if there is none. */)
499 register Lisp_Object name
;
504 return Fcdr (Fassoc (name
, Vprocess_alist
));
507 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
508 doc
: /* Return the (or a) process associated with BUFFER.
509 BUFFER may be a buffer or the name of one. */)
511 register Lisp_Object buffer
;
513 register Lisp_Object buf
, tail
, proc
;
515 if (NILP (buffer
)) return Qnil
;
516 buf
= Fget_buffer (buffer
);
517 if (NILP (buf
)) return Qnil
;
519 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
521 proc
= Fcdr (Fcar (tail
));
522 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
528 /* This is how commands for the user decode process arguments. It
529 accepts a process, a process name, a buffer, a buffer name, or nil.
530 Buffers denote the first process in the buffer, and nil denotes the
535 register Lisp_Object name
;
537 register Lisp_Object proc
, obj
;
540 obj
= Fget_process (name
);
542 obj
= Fget_buffer (name
);
544 error ("Process %s does not exist", XSTRING (name
)->data
);
546 else if (NILP (name
))
547 obj
= Fcurrent_buffer ();
551 /* Now obj should be either a buffer object or a process object.
555 proc
= Fget_buffer_process (obj
);
557 error ("Buffer %s has no process", XSTRING (XBUFFER (obj
)->name
)->data
);
567 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
568 doc
: /* Delete PROCESS: kill it and forget about it immediately.
569 PROCESS may be a process, a buffer, the name of a process or buffer, or
570 nil, indicating the current buffer's process. */)
572 register Lisp_Object process
;
574 process
= get_process (process
);
575 XPROCESS (process
)->raw_status_low
= Qnil
;
576 XPROCESS (process
)->raw_status_high
= Qnil
;
577 if (NETCONN_P (process
))
579 XPROCESS (process
)->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
580 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
582 else if (XINT (XPROCESS (process
)->infd
) >= 0)
584 Fkill_process (process
, Qnil
);
585 /* Do this now, since remove_process will make sigchld_handler do nothing. */
586 XPROCESS (process
)->status
587 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
588 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
591 remove_process (process
);
595 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
596 doc
: /* Return the status of PROCESS.
597 The returned value is one of the following symbols:
598 run -- for a process that is running.
599 stop -- for a process stopped but continuable.
600 exit -- for a process that has exited.
601 signal -- for a process that has got a fatal signal.
602 open -- for a network stream connection that is open.
603 closed -- for a network stream connection that is closed.
604 nil -- if arg is a process name and no such process exists.
605 PROCESS may be a process, a buffer, the name of a process, or
606 nil, indicating the current buffer's process. */)
608 register Lisp_Object process
;
610 register struct Lisp_Process
*p
;
611 register Lisp_Object status
;
613 if (STRINGP (process
))
614 process
= Fget_process (process
);
616 process
= get_process (process
);
621 p
= XPROCESS (process
);
622 if (!NILP (p
->raw_status_low
))
626 status
= XCAR (status
);
627 if (NETCONN_P (process
))
629 if (EQ (status
, Qrun
))
631 else if (EQ (status
, Qexit
))
637 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
639 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
640 If PROCESS has not yet exited or died, return 0. */)
642 register Lisp_Object process
;
644 CHECK_PROCESS (process
);
645 if (!NILP (XPROCESS (process
)->raw_status_low
))
646 update_status (XPROCESS (process
));
647 if (CONSP (XPROCESS (process
)->status
))
648 return XCAR (XCDR (XPROCESS (process
)->status
));
649 return make_number (0);
652 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
653 doc
: /* Return the process id of PROCESS.
654 This is the pid of the Unix process which PROCESS uses or talks to.
655 For a network connection, this value is nil. */)
657 register Lisp_Object process
;
659 CHECK_PROCESS (process
);
660 return XPROCESS (process
)->pid
;
663 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
664 doc
: /* Return the name of PROCESS, as a string.
665 This is the name of the program invoked in PROCESS,
666 possibly modified to make it unique among process names. */)
668 register Lisp_Object process
;
670 CHECK_PROCESS (process
);
671 return XPROCESS (process
)->name
;
674 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
675 doc
: /* Return the command that was executed to start PROCESS.
676 This is a list of strings, the first string being the program executed
677 and the rest of the strings being the arguments given to it.
678 For a non-child channel, this is nil. */)
680 register Lisp_Object process
;
682 CHECK_PROCESS (process
);
683 return XPROCESS (process
)->command
;
686 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
687 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
688 This is the terminal that the process itself reads and writes on,
689 not the name of the pty that Emacs uses to talk with that terminal. */)
691 register Lisp_Object process
;
693 CHECK_PROCESS (process
);
694 return XPROCESS (process
)->tty_name
;
697 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
699 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
701 register Lisp_Object process
, buffer
;
703 CHECK_PROCESS (process
);
705 CHECK_BUFFER (buffer
);
706 XPROCESS (process
)->buffer
= buffer
;
710 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
712 doc
: /* Return the buffer PROCESS is associated with.
713 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
715 register Lisp_Object process
;
717 CHECK_PROCESS (process
);
718 return XPROCESS (process
)->buffer
;
721 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
723 doc
: /* Return the marker for the end of the last output from PROCESS. */)
725 register Lisp_Object process
;
727 CHECK_PROCESS (process
);
728 return XPROCESS (process
)->mark
;
731 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
733 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
734 t means stop accepting output from the process.
735 When a process has a filter, each time it does output
736 the entire string of output is passed to the filter.
737 The filter gets two arguments: the process and the string of output.
738 If the process has a filter, its buffer is not used for output. */)
740 register Lisp_Object process
, filter
;
742 struct Lisp_Process
*p
;
744 CHECK_PROCESS (process
);
745 p
= XPROCESS (process
);
747 /* Don't signal an error if the process' input file descriptor
748 is closed. This could make debugging Lisp more difficult,
749 for example when doing something like
751 (setq process (start-process ...))
753 (set-process-filter process ...) */
755 if (XINT (p
->infd
) >= 0)
759 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
760 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
762 else if (EQ (XPROCESS (process
)->filter
, Qt
))
764 FD_SET (XINT (p
->infd
), &input_wait_mask
);
765 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
773 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
775 doc
: /* Returns the filter function of PROCESS; nil if none.
776 See `set-process-filter' for more info on filter functions. */)
778 register Lisp_Object process
;
780 CHECK_PROCESS (process
);
781 return XPROCESS (process
)->filter
;
784 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
786 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
787 The sentinel is called as a function when the process changes state.
788 It gets two arguments: the process, and a string describing the change. */)
790 register Lisp_Object process
, sentinel
;
792 CHECK_PROCESS (process
);
793 XPROCESS (process
)->sentinel
= sentinel
;
797 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
799 doc
: /* Return the sentinel of PROCESS; nil if none.
800 See `set-process-sentinel' for more info on sentinels. */)
802 register Lisp_Object process
;
804 CHECK_PROCESS (process
);
805 return XPROCESS (process
)->sentinel
;
808 DEFUN ("set-process-window-size", Fset_process_window_size
,
809 Sset_process_window_size
, 3, 3, 0,
810 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
811 (process
, height
, width
)
812 register Lisp_Object process
, height
, width
;
814 CHECK_PROCESS (process
);
815 CHECK_NATNUM (height
);
816 CHECK_NATNUM (width
);
818 if (XINT (XPROCESS (process
)->infd
) < 0
819 || set_window_size (XINT (XPROCESS (process
)->infd
),
820 XINT (height
), XINT (width
)) <= 0)
826 DEFUN ("set-process-inherit-coding-system-flag",
827 Fset_process_inherit_coding_system_flag
,
828 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
829 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
830 If the second argument FLAG is non-nil, then the variable
831 `buffer-file-coding-system' of the buffer associated with PROCESS
832 will be bound to the value of the coding system used to decode
835 This is useful when the coding system specified for the process buffer
836 leaves either the character code conversion or the end-of-line conversion
837 unspecified, or if the coding system used to decode the process output
838 is more appropriate for saving the process buffer.
840 Binding the variable `inherit-process-coding-system' to non-nil before
841 starting the process is an alternative way of setting the inherit flag
842 for the process which will run. */)
844 register Lisp_Object process
, flag
;
846 CHECK_PROCESS (process
);
847 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
851 DEFUN ("process-inherit-coding-system-flag",
852 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
854 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
855 If this flag is t, `buffer-file-coding-system' of the buffer
856 associated with PROCESS will inherit the coding system used to decode
857 the process output. */)
859 register Lisp_Object process
;
861 CHECK_PROCESS (process
);
862 return XPROCESS (process
)->inherit_coding_system_flag
;
865 DEFUN ("process-kill-without-query", Fprocess_kill_without_query
,
866 Sprocess_kill_without_query
, 1, 2, 0,
867 doc
: /* Say no query needed if PROCESS is running when Emacs is exited.
868 Optional second argument if non-nil says to require a query.
869 Value is t if a query was formerly required. */)
871 register Lisp_Object process
, value
;
875 CHECK_PROCESS (process
);
876 tem
= XPROCESS (process
)->kill_without_query
;
877 XPROCESS (process
)->kill_without_query
= Fnull (value
);
882 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
884 doc
: /* Return the contact info of PROCESS; t for a real child.
885 For a net connection, the value is a cons cell of the form (HOST SERVICE). */)
887 register Lisp_Object process
;
889 CHECK_PROCESS (process
);
890 return XPROCESS (process
)->childp
;
893 #if 0 /* Turned off because we don't currently record this info
894 in the process. Perhaps add it. */
895 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
896 doc
: /* Return the connection type of PROCESS.
897 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
898 a socket connection. */)
902 return XPROCESS (process
)->type
;
909 register Lisp_Object tail
, tem
;
910 Lisp_Object proc
, minspace
, tem1
;
911 register struct Lisp_Process
*p
;
914 XSETFASTINT (minspace
, 1);
916 set_buffer_internal (XBUFFER (Vstandard_output
));
917 Fbuffer_disable_undo (Vstandard_output
);
919 current_buffer
->truncate_lines
= Qt
;
922 Proc Status Buffer Tty Command\n\
923 ---- ------ ------ --- -------\n", -1);
925 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
929 proc
= Fcdr (Fcar (tail
));
931 if (NILP (p
->childp
))
934 Finsert (1, &p
->name
);
935 Findent_to (make_number (13), minspace
);
937 if (!NILP (p
->raw_status_low
))
940 if (CONSP (p
->status
))
941 symbol
= XCAR (p
->status
);
944 if (EQ (symbol
, Qsignal
))
947 tem
= Fcar (Fcdr (p
->status
));
949 if (XINT (tem
) < NSIG
)
950 write_string (sys_errlist
[XINT (tem
)], -1);
953 Fprinc (symbol
, Qnil
);
955 else if (NETCONN_P (proc
))
957 if (EQ (symbol
, Qrun
))
958 write_string ("open", -1);
959 else if (EQ (symbol
, Qexit
))
960 write_string ("closed", -1);
962 Fprinc (symbol
, Qnil
);
965 Fprinc (symbol
, Qnil
);
967 if (EQ (symbol
, Qexit
))
970 tem
= Fcar (Fcdr (p
->status
));
973 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
974 write_string (tembuf
, -1);
978 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
979 remove_process (proc
);
981 Findent_to (make_number (22), minspace
);
982 if (NILP (p
->buffer
))
983 insert_string ("(none)");
984 else if (NILP (XBUFFER (p
->buffer
)->name
))
985 insert_string ("(Killed)");
987 Finsert (1, &XBUFFER (p
->buffer
)->name
);
989 Findent_to (make_number (37), minspace
);
991 if (STRINGP (p
->tty_name
))
992 Finsert (1, &p
->tty_name
);
994 insert_string ("(none)");
996 Findent_to (make_number (49), minspace
);
998 if (NETCONN_P (proc
))
1000 sprintf (tembuf
, "(network stream connection to %s)\n",
1001 XSTRING (XCAR (p
->childp
))->data
);
1002 insert_string (tembuf
);
1014 insert_string (" ");
1016 insert_string ("\n");
1022 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 0, "",
1023 doc
: /* Display a list of all processes.
1024 Any process listed as exited or signaled is actually eliminated
1025 after the listing is made. */)
1028 internal_with_output_to_temp_buffer ("*Process List*",
1029 list_processes_1
, Qnil
);
1033 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1034 doc
: /* Return a list of all processes. */)
1037 return Fmapcar (Qcdr
, Vprocess_alist
);
1040 /* Starting asynchronous inferior processes. */
1042 static Lisp_Object
start_process_unwind ();
1044 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1045 doc
: /* Start a program in a subprocess. Return the process object for it.
1046 NAME is name for process. It is modified if necessary to make it unique.
1047 BUFFER is the buffer or (buffer-name) to associate with the process.
1048 Process output goes at end of that buffer, unless you specify
1049 an output stream or filter function to handle the output.
1050 BUFFER may be also nil, meaning that this process is not associated
1052 Third arg is program file name. It is searched for in PATH.
1053 Remaining arguments are strings to give program as arguments.
1054 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1057 register Lisp_Object
*args
;
1059 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1061 register unsigned char *new_argv
;
1064 register unsigned char **new_argv
;
1067 int count
= specpdl_ptr
- specpdl
;
1071 buffer
= Fget_buffer_create (buffer
);
1073 /* Make sure that the child will be able to chdir to the current
1074 buffer's current directory, or its unhandled equivalent. We
1075 can't just have the child check for an error when it does the
1076 chdir, since it's in a vfork.
1078 We have to GCPRO around this because Fexpand_file_name and
1079 Funhandled_file_name_directory might call a file name handling
1080 function. The argument list is protected by the caller, so all
1081 we really have to worry about is buffer. */
1083 struct gcpro gcpro1
, gcpro2
;
1085 current_dir
= current_buffer
->directory
;
1087 GCPRO2 (buffer
, current_dir
);
1090 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1092 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1093 report_file_error ("Setting current directory",
1094 Fcons (current_buffer
->directory
, Qnil
));
1100 CHECK_STRING (name
);
1104 CHECK_STRING (program
);
1106 proc
= make_process (name
);
1107 /* If an error occurs and we can't start the process, we want to
1108 remove it from the process list. This means that each error
1109 check in create_process doesn't need to call remove_process
1110 itself; it's all taken care of here. */
1111 record_unwind_protect (start_process_unwind
, proc
);
1113 XPROCESS (proc
)->childp
= Qt
;
1114 XPROCESS (proc
)->command_channel_p
= Qnil
;
1115 XPROCESS (proc
)->buffer
= buffer
;
1116 XPROCESS (proc
)->sentinel
= Qnil
;
1117 XPROCESS (proc
)->filter
= Qnil
;
1118 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1120 /* Make the process marker point into the process buffer (if any). */
1122 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1123 BUF_ZV (XBUFFER (buffer
)),
1124 BUF_ZV_BYTE (XBUFFER (buffer
)));
1127 /* Decide coding systems for communicating with the process. Here
1128 we don't setup the structure coding_system nor pay attention to
1129 unibyte mode. They are done in create_process. */
1131 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1132 Lisp_Object coding_systems
= Qt
;
1133 Lisp_Object val
, *args2
;
1134 struct gcpro gcpro1
, gcpro2
;
1136 val
= Vcoding_system_for_read
;
1139 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1140 args2
[0] = Qstart_process
;
1141 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1142 GCPRO2 (proc
, current_dir
);
1143 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1145 if (CONSP (coding_systems
))
1146 val
= XCAR (coding_systems
);
1147 else if (CONSP (Vdefault_process_coding_system
))
1148 val
= XCAR (Vdefault_process_coding_system
);
1150 XPROCESS (proc
)->decode_coding_system
= val
;
1152 val
= Vcoding_system_for_write
;
1155 if (EQ (coding_systems
, Qt
))
1157 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1158 args2
[0] = Qstart_process
;
1159 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1160 GCPRO2 (proc
, current_dir
);
1161 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1164 if (CONSP (coding_systems
))
1165 val
= XCDR (coding_systems
);
1166 else if (CONSP (Vdefault_process_coding_system
))
1167 val
= XCDR (Vdefault_process_coding_system
);
1169 XPROCESS (proc
)->encode_coding_system
= val
;
1173 /* Make a one member argv with all args concatenated
1174 together separated by a blank. */
1175 len
= STRING_BYTES (XSTRING (program
)) + 2;
1176 for (i
= 3; i
< nargs
; i
++)
1180 len
+= STRING_BYTES (XSTRING (tem
)) + 1; /* count the blank */
1182 new_argv
= (unsigned char *) alloca (len
);
1183 strcpy (new_argv
, XSTRING (program
)->data
);
1184 for (i
= 3; i
< nargs
; i
++)
1188 strcat (new_argv
, " ");
1189 strcat (new_argv
, XSTRING (tem
)->data
);
1191 /* Need to add code here to check for program existence on VMS */
1194 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1196 /* If program file name is not absolute, search our path for it */
1197 if (!IS_DIRECTORY_SEP (XSTRING (program
)->data
[0])
1198 && !(XSTRING (program
)->size
> 1
1199 && IS_DEVICE_SEP (XSTRING (program
)->data
[1])))
1201 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1204 GCPRO4 (name
, program
, buffer
, current_dir
);
1205 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, 1);
1208 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1209 tem
= Fexpand_file_name (tem
, Qnil
);
1210 tem
= ENCODE_FILE (tem
);
1211 new_argv
[0] = XSTRING (tem
)->data
;
1215 if (!NILP (Ffile_directory_p (program
)))
1216 error ("Specified program for new process is a directory");
1218 tem
= ENCODE_FILE (program
);
1219 new_argv
[0] = XSTRING (tem
)->data
;
1222 /* Here we encode arguments by the coding system used for sending
1223 data to the process. We don't support using different coding
1224 systems for encoding arguments and for encoding data sent to the
1227 for (i
= 3; i
< nargs
; i
++)
1231 if (STRING_MULTIBYTE (tem
))
1232 tem
= (code_convert_string_norecord
1233 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1234 new_argv
[i
- 2] = XSTRING (tem
)->data
;
1236 new_argv
[i
- 2] = 0;
1237 #endif /* not VMS */
1239 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1240 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1241 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1242 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1244 XPROCESS (proc
)->inherit_coding_system_flag
1245 = (NILP (buffer
) || !inherit_process_coding_system
1248 create_process (proc
, (char **) new_argv
, current_dir
);
1250 return unbind_to (count
, proc
);
1253 /* This function is the unwind_protect form for Fstart_process. If
1254 PROC doesn't have its pid set, then we know someone has signaled
1255 an error and the process wasn't started successfully, so we should
1256 remove it from the process list. */
1258 start_process_unwind (proc
)
1261 if (!PROCESSP (proc
))
1264 /* Was PROC started successfully? */
1265 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1266 remove_process (proc
);
1272 create_process_1 (timer
)
1273 struct atimer
*timer
;
1275 /* Nothing to do. */
1279 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1282 /* Mimic blocking of signals on system V, which doesn't really have it. */
1284 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1285 int sigchld_deferred
;
1288 create_process_sigchld ()
1290 signal (SIGCHLD
, create_process_sigchld
);
1292 sigchld_deferred
= 1;
1298 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1300 create_process (process
, new_argv
, current_dir
)
1301 Lisp_Object process
;
1303 Lisp_Object current_dir
;
1305 int pid
, inchannel
, outchannel
;
1307 #ifdef POSIX_SIGNALS
1310 struct sigaction sigint_action
;
1311 struct sigaction sigquit_action
;
1313 struct sigaction sighup_action
;
1315 #else /* !POSIX_SIGNALS */
1318 SIGTYPE (*sigchld
)();
1321 #endif /* !POSIX_SIGNALS */
1322 /* Use volatile to protect variables from being clobbered by longjmp. */
1323 volatile int forkin
, forkout
;
1324 volatile int pty_flag
= 0;
1326 extern char **environ
;
1329 inchannel
= outchannel
= -1;
1332 if (!NILP (Vprocess_connection_type
))
1333 outchannel
= inchannel
= allocate_pty ();
1338 /* On USG systems it does not work to open the pty's tty here
1339 and then close and reopen it in the child. */
1341 /* Don't let this terminal become our controlling terminal
1342 (in case we don't have one). */
1343 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1345 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1348 report_file_error ("Opening pty", Qnil
);
1350 forkin
= forkout
= -1;
1351 #endif /* not USG */
1355 #endif /* HAVE_PTYS */
1358 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1359 report_file_error ("Opening socketpair", Qnil
);
1360 outchannel
= inchannel
= sv
[0];
1361 forkout
= forkin
= sv
[1];
1363 #else /* not SKTPAIR */
1368 report_file_error ("Creating pipe", Qnil
);
1374 emacs_close (inchannel
);
1375 emacs_close (forkout
);
1376 report_file_error ("Creating pipe", Qnil
);
1381 #endif /* not SKTPAIR */
1384 /* Replaced by close_process_descs */
1385 set_exclusive_use (inchannel
);
1386 set_exclusive_use (outchannel
);
1389 /* Stride people say it's a mystery why this is needed
1390 as well as the O_NDELAY, but that it fails without this. */
1391 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1394 ioctl (inchannel
, FIONBIO
, &one
);
1399 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1400 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1403 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1404 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1408 /* Record this as an active process, with its channels.
1409 As a result, child_setup will close Emacs's side of the pipes. */
1410 chan_process
[inchannel
] = process
;
1411 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1412 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1413 /* Record the tty descriptor used in the subprocess. */
1415 XPROCESS (process
)->subtty
= Qnil
;
1417 XSETFASTINT (XPROCESS (process
)->subtty
, forkin
);
1418 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1419 XPROCESS (process
)->status
= Qrun
;
1420 if (!proc_decode_coding_system
[inchannel
])
1421 proc_decode_coding_system
[inchannel
]
1422 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
1423 setup_coding_system (XPROCESS (process
)->decode_coding_system
,
1424 proc_decode_coding_system
[inchannel
]);
1425 if (!proc_encode_coding_system
[outchannel
])
1426 proc_encode_coding_system
[outchannel
]
1427 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
1428 setup_coding_system (XPROCESS (process
)->encode_coding_system
,
1429 proc_encode_coding_system
[outchannel
]);
1431 /* Delay interrupts until we have a chance to store
1432 the new fork's pid in its process structure */
1433 #ifdef POSIX_SIGNALS
1434 sigemptyset (&blocked
);
1436 sigaddset (&blocked
, SIGCHLD
);
1438 #ifdef HAVE_WORKING_VFORK
1439 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1440 this sets the parent's signal handlers as well as the child's.
1441 So delay all interrupts whose handlers the child might munge,
1442 and record the current handlers so they can be restored later. */
1443 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1444 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1446 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1448 #endif /* HAVE_WORKING_VFORK */
1449 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1450 #else /* !POSIX_SIGNALS */
1454 #else /* not BSD4_1 */
1455 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1456 sigsetmask (sigmask (SIGCHLD
));
1457 #else /* ordinary USG */
1459 sigchld_deferred
= 0;
1460 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1462 #endif /* ordinary USG */
1463 #endif /* not BSD4_1 */
1464 #endif /* SIGCHLD */
1465 #endif /* !POSIX_SIGNALS */
1467 FD_SET (inchannel
, &input_wait_mask
);
1468 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1469 if (inchannel
> max_process_desc
)
1470 max_process_desc
= inchannel
;
1472 /* Until we store the proper pid, enable sigchld_handler
1473 to recognize an unknown pid as standing for this process.
1474 It is very important not to let this `marker' value stay
1475 in the table after this function has returned; if it does
1476 it might cause call-process to hang and subsequent asynchronous
1477 processes to get their return values scrambled. */
1478 XSETINT (XPROCESS (process
)->pid
, -1);
1483 /* child_setup must clobber environ on systems with true vfork.
1484 Protect it from permanent change. */
1485 char **save_environ
= environ
;
1487 current_dir
= ENCODE_FILE (current_dir
);
1492 #endif /* not WINDOWSNT */
1494 int xforkin
= forkin
;
1495 int xforkout
= forkout
;
1497 #if 0 /* This was probably a mistake--it duplicates code later on,
1498 but fails to handle all the cases. */
1499 /* Make sure SIGCHLD is not blocked in the child. */
1500 sigsetmask (SIGEMPTYMASK
);
1503 /* Make the pty be the controlling terminal of the process. */
1505 /* First, disconnect its current controlling terminal. */
1507 /* We tried doing setsid only if pty_flag, but it caused
1508 process_set_signal to fail on SGI when using a pipe. */
1510 /* Make the pty's terminal the controlling terminal. */
1514 /* We ignore the return value
1515 because faith@cs.unc.edu says that is necessary on Linux. */
1516 ioctl (xforkin
, TIOCSCTTY
, 0);
1519 #else /* not HAVE_SETSID */
1521 /* It's very important to call setpgrp here and no time
1522 afterwards. Otherwise, we lose our controlling tty which
1523 is set when we open the pty. */
1526 #endif /* not HAVE_SETSID */
1527 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1528 if (pty_flag
&& xforkin
>= 0)
1531 tcgetattr (xforkin
, &t
);
1533 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1534 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1537 #if defined (NTTYDISC) && defined (TIOCSETD)
1538 if (pty_flag
&& xforkin
>= 0)
1540 /* Use new line discipline. */
1541 int ldisc
= NTTYDISC
;
1542 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1547 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1548 can do TIOCSPGRP only to the process's controlling tty. */
1551 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1552 I can't test it since I don't have 4.3. */
1553 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
1554 ioctl (j
, TIOCNOTTY
, 0);
1557 /* In order to get a controlling terminal on some versions
1558 of BSD, it is necessary to put the process in pgrp 0
1559 before it opens the terminal. */
1567 #endif /* TIOCNOTTY */
1569 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
1570 /*** There is a suggestion that this ought to be a
1571 conditional on TIOCSPGRP,
1572 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1573 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1574 that system does seem to need this code, even though
1575 both HAVE_SETSID and TIOCSCTTY are defined. */
1576 /* Now close the pty (if we had it open) and reopen it.
1577 This makes the pty the controlling terminal of the subprocess. */
1580 #ifdef SET_CHILD_PTY_PGRP
1581 int pgrp
= getpid ();
1584 /* I wonder if emacs_close (emacs_open (pty_name, ...))
1587 emacs_close (xforkin
);
1588 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
1592 emacs_write (1, "Couldn't open the pty terminal ", 31);
1593 emacs_write (1, pty_name
, strlen (pty_name
));
1594 emacs_write (1, "\n", 1);
1598 #ifdef SET_CHILD_PTY_PGRP
1599 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
1600 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
1603 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
1605 #ifdef SETUP_SLAVE_PTY
1610 #endif /* SETUP_SLAVE_PTY */
1612 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1613 Now reenable it in the child, so it will die when we want it to. */
1615 signal (SIGHUP
, SIG_DFL
);
1617 #endif /* HAVE_PTYS */
1619 signal (SIGINT
, SIG_DFL
);
1620 signal (SIGQUIT
, SIG_DFL
);
1622 /* Stop blocking signals in the child. */
1623 #ifdef POSIX_SIGNALS
1624 sigprocmask (SIG_SETMASK
, &procmask
, 0);
1625 #else /* !POSIX_SIGNALS */
1629 #else /* not BSD4_1 */
1630 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1631 sigsetmask (SIGEMPTYMASK
);
1632 #else /* ordinary USG */
1634 signal (SIGCHLD
, sigchld
);
1636 #endif /* ordinary USG */
1637 #endif /* not BSD4_1 */
1638 #endif /* SIGCHLD */
1639 #endif /* !POSIX_SIGNALS */
1642 child_setup_tty (xforkout
);
1644 pid
= child_setup (xforkin
, xforkout
, xforkout
,
1645 new_argv
, 1, current_dir
);
1646 #else /* not WINDOWSNT */
1647 child_setup (xforkin
, xforkout
, xforkout
,
1648 new_argv
, 1, current_dir
);
1649 #endif /* not WINDOWSNT */
1651 environ
= save_environ
;
1656 /* This runs in the Emacs process. */
1660 emacs_close (forkin
);
1661 if (forkin
!= forkout
&& forkout
>= 0)
1662 emacs_close (forkout
);
1666 /* vfork succeeded. */
1667 XSETFASTINT (XPROCESS (process
)->pid
, pid
);
1670 register_child (pid
, inchannel
);
1671 #endif /* WINDOWSNT */
1673 /* If the subfork execv fails, and it exits,
1674 this close hangs. I don't know why.
1675 So have an interrupt jar it loose. */
1677 struct atimer
*timer
;
1681 EMACS_SET_SECS_USECS (offset
, 1, 0);
1682 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
1684 XPROCESS (process
)->subtty
= Qnil
;
1686 emacs_close (forkin
);
1688 cancel_atimer (timer
);
1692 if (forkin
!= forkout
&& forkout
>= 0)
1693 emacs_close (forkout
);
1697 XPROCESS (process
)->tty_name
= build_string (pty_name
);
1700 XPROCESS (process
)->tty_name
= Qnil
;
1703 /* Restore the signal state whether vfork succeeded or not.
1704 (We will signal an error, below, if it failed.) */
1705 #ifdef POSIX_SIGNALS
1706 #ifdef HAVE_WORKING_VFORK
1707 /* Restore the parent's signal handlers. */
1708 sigaction (SIGINT
, &sigint_action
, 0);
1709 sigaction (SIGQUIT
, &sigquit_action
, 0);
1711 sigaction (SIGHUP
, &sighup_action
, 0);
1713 #endif /* HAVE_WORKING_VFORK */
1714 /* Stop blocking signals in the parent. */
1715 sigprocmask (SIG_SETMASK
, &procmask
, 0);
1716 #else /* !POSIX_SIGNALS */
1720 #else /* not BSD4_1 */
1721 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1722 sigsetmask (SIGEMPTYMASK
);
1723 #else /* ordinary USG */
1725 signal (SIGCHLD
, sigchld
);
1726 /* Now really handle any of these signals
1727 that came in during this function. */
1728 if (sigchld_deferred
)
1729 kill (getpid (), SIGCHLD
);
1731 #endif /* ordinary USG */
1732 #endif /* not BSD4_1 */
1733 #endif /* SIGCHLD */
1734 #endif /* !POSIX_SIGNALS */
1736 /* Now generate the error if vfork failed. */
1738 report_file_error ("Doing vfork", Qnil
);
1740 #endif /* not VMS */
1744 /* open a TCP network connection to a given HOST/SERVICE. Treated
1745 exactly like a normal process when reading and writing. Only
1746 differences are in status display and process deletion. A network
1747 connection has no PID; you cannot signal it. All you can do is
1748 deactivate and close it via delete-process */
1750 DEFUN ("open-network-stream", Fopen_network_stream
, Sopen_network_stream
,
1752 doc
: /* Open a TCP connection for a service to a host.
1753 Returns a subprocess-object to represent the connection.
1754 Input and output work as for subprocesses; `delete-process' closes it.
1755 Args are NAME BUFFER HOST SERVICE.
1756 NAME is name for process. It is modified if necessary to make it unique.
1757 BUFFER is the buffer (or buffer-name) to associate with the process.
1758 Process output goes at end of that buffer, unless you specify
1759 an output stream or filter function to handle the output.
1760 BUFFER may be also nil, meaning that this process is not associated
1762 Third arg is name of the host to connect to, or its IP address.
1763 Fourth arg SERVICE is name of the service desired, or an integer
1764 specifying a port number to connect to. */)
1765 (name
, buffer
, host
, service
)
1766 Lisp_Object name
, buffer
, host
, service
;
1769 #ifdef HAVE_GETADDRINFO
1770 struct addrinfo hints
, *res
, *lres
;
1773 char *portstring
, portbuf
[128];
1774 #else /* HAVE_GETADDRINFO */
1775 struct sockaddr_in address
;
1776 struct servent
*svc_info
;
1777 struct hostent
*host_info_ptr
, host_info
;
1778 char *(addr_list
[2]);
1779 IN_ADDR numeric_addr
;
1781 #endif /* HAVE_GETADDRINFO */
1782 int s
= -1, outch
, inch
;
1783 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1785 int count
= specpdl_ptr
- specpdl
;
1789 /* Ensure socket support is loaded if available. */
1790 init_winsock (TRUE
);
1793 GCPRO4 (name
, buffer
, host
, service
);
1794 CHECK_STRING (name
);
1795 CHECK_STRING (host
);
1797 #ifdef HAVE_GETADDRINFO
1798 /* SERVICE can either be a string or int.
1799 Convert to a C string for later use by getaddrinfo. */
1800 if (INTEGERP (service
))
1802 sprintf (portbuf
, "%ld", (long) XINT (service
));
1803 portstring
= portbuf
;
1807 CHECK_STRING (service
);
1808 portstring
= XSTRING (service
)->data
;
1810 #else /* HAVE_GETADDRINFO */
1811 if (INTEGERP (service
))
1812 port
= htons ((unsigned short) XINT (service
));
1815 CHECK_STRING (service
);
1816 svc_info
= getservbyname (XSTRING (service
)->data
, "tcp");
1818 error ("Unknown service \"%s\"", XSTRING (service
)->data
);
1819 port
= svc_info
->s_port
;
1821 #endif /* HAVE_GETADDRINFO */
1824 /* Slow down polling to every ten seconds.
1825 Some kernels have a bug which causes retrying connect to fail
1826 after a connect. Polling can interfere with gethostbyname too. */
1827 #ifdef POLL_FOR_INPUT
1828 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
1829 bind_polling_period (10);
1833 #ifdef HAVE_GETADDRINFO
1836 memset (&hints
, 0, sizeof (hints
));
1838 hints
.ai_family
= AF_UNSPEC
;
1839 hints
.ai_socktype
= SOCK_STREAM
;
1840 hints
.ai_protocol
= 0;
1841 ret
= getaddrinfo (XSTRING (host
)->data
, portstring
, &hints
, &res
);
1843 #ifdef HAVE_GAI_STRERROR
1844 error ("%s/%s %s", XSTRING (host
)->data
, portstring
, gai_strerror(ret
));
1846 error ("%s/%s getaddrinfo error %d", XSTRING (host
)->data
, portstring
,
1851 /* Do this in case we never enter the for-loop below. */
1852 count1
= specpdl_ptr
- specpdl
;
1855 for (lres
= res
; lres
; lres
= lres
->ai_next
)
1857 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
1864 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1865 when connect is interrupted. So let's not let it get interrupted.
1866 Note we do not turn off polling, because polling is only used
1867 when not interrupt_input, and thus not normally used on the systems
1868 which have this bug. On systems which use polling, there's no way
1869 to quit if polling is turned off. */
1870 if (interrupt_input
)
1873 /* Make us close S if quit. */
1874 count1
= specpdl_ptr
- specpdl
;
1875 record_unwind_protect (close_file_unwind
, make_number (s
));
1882 /* This turns off all alarm-based interrupts; the
1883 bind_polling_period call above doesn't always turn all the
1884 short-interval ones off, especially if interrupt_input is
1887 It'd be nice to be able to control the connect timeout
1888 though. Would non-blocking connect calls be portable? */
1889 turn_on_atimers (0);
1890 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
1892 turn_on_atimers (1);
1894 if (ret
== 0 || xerrno
== EISCONN
)
1895 /* The unwind-protect will be discarded afterwards.
1896 Likewise for immediate_quit. */
1901 if (xerrno
== EINTR
)
1903 if (xerrno
== EADDRINUSE
&& retry
< 20)
1905 /* A delay here is needed on some FreeBSD systems,
1906 and it is harmless, since this retrying takes time anyway
1907 and should be infrequent. */
1908 Fsleep_for (make_number (1), Qnil
);
1913 /* Discard the unwind protect closing S. */
1914 specpdl_ptr
= specpdl
+ count1
;
1915 count1
= specpdl_ptr
- specpdl
;
1924 if (interrupt_input
)
1928 report_file_error ("connection failed",
1929 Fcons (host
, Fcons (name
, Qnil
)));
1932 #else /* not HAVE_GETADDRINFO */
1943 host_info_ptr
= gethostbyname (XSTRING (host
)->data
);
1947 if (! (host_info_ptr
== 0 && h_errno
== TRY_AGAIN
))
1951 Fsleep_for (make_number (1), Qnil
);
1954 if (host_info_ptr
== 0)
1955 /* Attempt to interpret host as numeric inet address */
1957 numeric_addr
= inet_addr ((char *) XSTRING (host
)->data
);
1958 if (NUMERIC_ADDR_ERROR
)
1959 error ("Unknown host \"%s\"", XSTRING (host
)->data
);
1961 host_info_ptr
= &host_info
;
1962 host_info
.h_name
= 0;
1963 host_info
.h_aliases
= 0;
1964 host_info
.h_addrtype
= AF_INET
;
1966 /* Older machines have only one address slot called h_addr.
1967 Newer machines have h_addr_list, but #define h_addr to
1968 be its first element. */
1969 host_info
.h_addr_list
= &(addr_list
[0]);
1971 host_info
.h_addr
= (char*)(&numeric_addr
);
1973 /* numeric_addr isn't null-terminated; it has fixed length. */
1974 host_info
.h_length
= sizeof (numeric_addr
);
1977 bzero (&address
, sizeof address
);
1978 bcopy (host_info_ptr
->h_addr
, (char *) &address
.sin_addr
,
1979 host_info_ptr
->h_length
);
1980 address
.sin_family
= host_info_ptr
->h_addrtype
;
1981 address
.sin_port
= port
;
1983 s
= socket (host_info_ptr
->h_addrtype
, SOCK_STREAM
, 0);
1985 report_file_error ("error creating socket", Fcons (name
, Qnil
));
1987 count1
= specpdl_ptr
- specpdl
;
1988 record_unwind_protect (close_file_unwind
, make_number (s
));
1990 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1991 when connect is interrupted. So let's not let it get interrupted.
1992 Note we do not turn off polling, because polling is only used
1993 when not interrupt_input, and thus not normally used on the systems
1994 which have this bug. On systems which use polling, there's no way
1995 to quit if polling is turned off. */
1996 if (interrupt_input
)
2004 if (connect (s
, (struct sockaddr
*) &address
, sizeof address
) == -1
2005 && errno
!= EISCONN
)
2013 if (errno
== EADDRINUSE
&& retry
< 20)
2015 /* A delay here is needed on some FreeBSD systems,
2016 and it is harmless, since this retrying takes time anyway
2017 and should be infrequent. */
2018 Fsleep_for (make_number (1), Qnil
);
2023 /* Discard the unwind protect. */
2024 specpdl_ptr
= specpdl
+ count1
;
2028 if (interrupt_input
)
2032 report_file_error ("connection failed",
2033 Fcons (host
, Fcons (name
, Qnil
)));
2036 #endif /* not HAVE_GETADDRINFO */
2040 /* Discard the unwind protect, if any. */
2041 specpdl_ptr
= specpdl
+ count1
;
2043 #ifdef POLL_FOR_INPUT
2044 unbind_to (count
, Qnil
);
2047 if (interrupt_input
)
2051 s
= connect_server (0);
2053 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2054 send_command (s
, C_PORT
, 0, "%s:%d", XSTRING (host
)->data
, ntohs (port
));
2055 send_command (s
, C_DUMB
, 1, 0);
2062 buffer
= Fget_buffer_create (buffer
);
2063 proc
= make_process (name
);
2065 chan_process
[inch
] = proc
;
2068 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
2071 fcntl (inch
, F_SETFL
, O_NDELAY
);
2075 XPROCESS (proc
)->childp
= Fcons (host
, Fcons (service
, Qnil
));
2076 XPROCESS (proc
)->command_channel_p
= Qnil
;
2077 XPROCESS (proc
)->buffer
= buffer
;
2078 XPROCESS (proc
)->sentinel
= Qnil
;
2079 XPROCESS (proc
)->filter
= Qnil
;
2080 XPROCESS (proc
)->command
= Qnil
;
2081 XPROCESS (proc
)->pid
= Qnil
;
2082 XSETINT (XPROCESS (proc
)->infd
, inch
);
2083 XSETINT (XPROCESS (proc
)->outfd
, outch
);
2084 XPROCESS (proc
)->status
= Qrun
;
2085 FD_SET (inch
, &input_wait_mask
);
2086 FD_SET (inch
, &non_keyboard_wait_mask
);
2087 if (inch
> max_process_desc
)
2088 max_process_desc
= inch
;
2091 /* Setup coding systems for communicating with the network stream. */
2092 struct gcpro gcpro1
;
2093 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
2094 Lisp_Object coding_systems
= Qt
;
2095 Lisp_Object args
[5], val
;
2097 if (!NILP (Vcoding_system_for_read
))
2098 val
= Vcoding_system_for_read
;
2099 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
2100 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
2101 /* We dare not decode end-of-line format by setting VAL to
2102 Qraw_text, because the existing Emacs Lisp libraries
2103 assume that they receive bare code including a sequene of
2108 args
[0] = Qopen_network_stream
, args
[1] = name
,
2109 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
2111 coding_systems
= Ffind_operation_coding_system (5, args
);
2113 if (CONSP (coding_systems
))
2114 val
= XCAR (coding_systems
);
2115 else if (CONSP (Vdefault_process_coding_system
))
2116 val
= XCAR (Vdefault_process_coding_system
);
2120 XPROCESS (proc
)->decode_coding_system
= val
;
2122 if (!NILP (Vcoding_system_for_write
))
2123 val
= Vcoding_system_for_write
;
2124 else if (NILP (current_buffer
->enable_multibyte_characters
))
2128 if (EQ (coding_systems
, Qt
))
2130 args
[0] = Qopen_network_stream
, args
[1] = name
,
2131 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
2133 coding_systems
= Ffind_operation_coding_system (5, args
);
2136 if (CONSP (coding_systems
))
2137 val
= XCDR (coding_systems
);
2138 else if (CONSP (Vdefault_process_coding_system
))
2139 val
= XCDR (Vdefault_process_coding_system
);
2143 XPROCESS (proc
)->encode_coding_system
= val
;
2146 if (!proc_decode_coding_system
[inch
])
2147 proc_decode_coding_system
[inch
]
2148 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
2149 setup_coding_system (XPROCESS (proc
)->decode_coding_system
,
2150 proc_decode_coding_system
[inch
]);
2151 if (!proc_encode_coding_system
[outch
])
2152 proc_encode_coding_system
[outch
]
2153 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
2154 setup_coding_system (XPROCESS (proc
)->encode_coding_system
,
2155 proc_encode_coding_system
[outch
]);
2157 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
2158 XPROCESS (proc
)->decoding_carryover
= make_number (0);
2159 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
2160 XPROCESS (proc
)->encoding_carryover
= make_number (0);
2162 XPROCESS (proc
)->inherit_coding_system_flag
2163 = (NILP (buffer
) || !inherit_process_coding_system
2169 #endif /* HAVE_SOCKETS */
2172 deactivate_process (proc
)
2175 register int inchannel
, outchannel
;
2176 register struct Lisp_Process
*p
= XPROCESS (proc
);
2178 inchannel
= XINT (p
->infd
);
2179 outchannel
= XINT (p
->outfd
);
2183 /* Beware SIGCHLD hereabouts. */
2184 flush_pending_output (inchannel
);
2187 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
2188 sys$
dassgn (outchannel
);
2189 vs
= get_vms_process_pointer (p
->pid
);
2191 give_back_vms_process_stuff (vs
);
2194 emacs_close (inchannel
);
2195 if (outchannel
>= 0 && outchannel
!= inchannel
)
2196 emacs_close (outchannel
);
2199 XSETINT (p
->infd
, -1);
2200 XSETINT (p
->outfd
, -1);
2201 chan_process
[inchannel
] = Qnil
;
2202 FD_CLR (inchannel
, &input_wait_mask
);
2203 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
2204 if (inchannel
== max_process_desc
)
2207 /* We just closed the highest-numbered process input descriptor,
2208 so recompute the highest-numbered one now. */
2209 max_process_desc
= 0;
2210 for (i
= 0; i
< MAXDESC
; i
++)
2211 if (!NILP (chan_process
[i
]))
2212 max_process_desc
= i
;
2217 /* Close all descriptors currently in use for communication
2218 with subprocess. This is used in a newly-forked subprocess
2219 to get rid of irrelevant descriptors. */
2222 close_process_descs ()
2226 for (i
= 0; i
< MAXDESC
; i
++)
2228 Lisp_Object process
;
2229 process
= chan_process
[i
];
2230 if (!NILP (process
))
2232 int in
= XINT (XPROCESS (process
)->infd
);
2233 int out
= XINT (XPROCESS (process
)->outfd
);
2236 if (out
>= 0 && in
!= out
)
2243 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
2245 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
2246 It is read into the process' buffers or given to their filter functions.
2247 Non-nil arg PROCESS means do not return until some output has been received
2249 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of
2250 seconds and microseconds to wait; return after that much time whether
2251 or not there is input.
2252 Return non-nil iff we received any output before the timeout expired. */)
2253 (process
, timeout
, timeout_msecs
)
2254 register Lisp_Object process
, timeout
, timeout_msecs
;
2259 if (! NILP (process
))
2260 CHECK_PROCESS (process
);
2262 if (! NILP (timeout_msecs
))
2264 CHECK_NUMBER (timeout_msecs
);
2265 useconds
= XINT (timeout_msecs
);
2266 if (!INTEGERP (timeout
))
2267 XSETINT (timeout
, 0);
2270 int carry
= useconds
/ 1000000;
2272 XSETINT (timeout
, XINT (timeout
) + carry
);
2273 useconds
-= carry
* 1000000;
2275 /* I think this clause is necessary because C doesn't
2276 guarantee a particular rounding direction for negative
2280 XSETINT (timeout
, XINT (timeout
) - 1);
2281 useconds
+= 1000000;
2288 if (! NILP (timeout
))
2290 CHECK_NUMBER (timeout
);
2291 seconds
= XINT (timeout
);
2292 if (seconds
< 0 || (seconds
== 0 && useconds
== 0))
2304 XSETFASTINT (process
, 0);
2307 (wait_reading_process_input (seconds
, useconds
, process
, 0)
2311 /* This variable is different from waiting_for_input in keyboard.c.
2312 It is used to communicate to a lisp process-filter/sentinel (via the
2313 function Fwaiting_for_user_input_p below) whether emacs was waiting
2314 for user-input when that process-filter was called.
2315 waiting_for_input cannot be used as that is by definition 0 when
2316 lisp code is being evalled.
2317 This is also used in record_asynch_buffer_change.
2318 For that purpose, this must be 0
2319 when not inside wait_reading_process_input. */
2320 static int waiting_for_user_input_p
;
2322 /* This is here so breakpoints can be put on it. */
2324 wait_reading_process_input_1 ()
2328 /* Read and dispose of subprocess output while waiting for timeout to
2329 elapse and/or keyboard input to be available.
2332 timeout in seconds, or
2333 zero for no limit, or
2334 -1 means gobble data immediately available but don't wait for any.
2337 an additional duration to wait, measured in microseconds.
2338 If this is nonzero and time_limit is 0, then the timeout
2339 consists of MICROSECS only.
2341 READ_KBD is a lisp value:
2342 0 to ignore keyboard input, or
2343 1 to return when input is available, or
2344 -1 meaning caller will actually read the input, so don't throw to
2345 the quit handler, or
2346 a cons cell, meaning wait until its car is non-nil
2347 (and gobble terminal input into the buffer if any arrives), or
2348 a process object, meaning wait until something arrives from that
2349 process. The return value is true iff we read some input from
2352 DO_DISPLAY != 0 means redisplay should be done to show subprocess
2353 output that arrives.
2355 If READ_KBD is a pointer to a struct Lisp_Process, then the
2356 function returns true iff we received input from that process
2357 before the timeout elapsed.
2358 Otherwise, return true iff we received input from any process. */
2361 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
2362 int time_limit
, microsecs
;
2363 Lisp_Object read_kbd
;
2366 register int channel
, nfds
;
2367 static SELECT_TYPE Available
;
2370 EMACS_TIME timeout
, end_time
;
2372 int wait_channel
= -1;
2373 struct Lisp_Process
*wait_proc
= 0;
2374 int got_some_input
= 0;
2375 /* Either nil or a cons cell, the car of which is of interest and
2376 may be changed outside of this routine. */
2377 Lisp_Object wait_for_cell
= Qnil
;
2379 FD_ZERO (&Available
);
2381 /* If read_kbd is a process to watch, set wait_proc and wait_channel
2383 if (PROCESSP (read_kbd
))
2385 wait_proc
= XPROCESS (read_kbd
);
2386 wait_channel
= XINT (wait_proc
->infd
);
2387 XSETFASTINT (read_kbd
, 0);
2390 /* If waiting for non-nil in a cell, record where. */
2391 if (CONSP (read_kbd
))
2393 wait_for_cell
= read_kbd
;
2394 XSETFASTINT (read_kbd
, 0);
2397 waiting_for_user_input_p
= XINT (read_kbd
);
2399 /* Since we may need to wait several times,
2400 compute the absolute time to return at. */
2401 if (time_limit
|| microsecs
)
2403 EMACS_GET_TIME (end_time
);
2404 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
2405 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
2408 /* AlainF 5-Jul-1996
2409 HP-UX 10.10 seem to have problems with signals coming in
2410 Causes "poll: interrupted system call" messages when Emacs is run
2412 Turn off periodic alarms (in case they are in use) */
2413 turn_on_atimers (0);
2418 int timeout_reduced_for_timers
= 0;
2420 /* If calling from keyboard input, do not quit
2421 since we want to return C-g as an input character.
2422 Otherwise, do pending quit if requested. */
2423 if (XINT (read_kbd
) >= 0)
2426 /* Exit now if the cell we're waiting for became non-nil. */
2427 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
2430 /* Compute time from now till when time limit is up */
2431 /* Exit if already run out */
2432 if (time_limit
== -1)
2434 /* -1 specified for timeout means
2435 gobble output available now
2436 but don't wait at all. */
2438 EMACS_SET_SECS_USECS (timeout
, 0, 0);
2440 else if (time_limit
|| microsecs
)
2442 EMACS_GET_TIME (timeout
);
2443 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
2444 if (EMACS_TIME_NEG_P (timeout
))
2449 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
2452 /* Normally we run timers here.
2453 But not if wait_for_cell; in those cases,
2454 the wait is supposed to be short,
2455 and those callers cannot handle running arbitrary Lisp code here. */
2456 if (NILP (wait_for_cell
))
2458 EMACS_TIME timer_delay
;
2462 int old_timers_run
= timers_run
;
2463 struct buffer
*old_buffer
= current_buffer
;
2465 timer_delay
= timer_check (1);
2467 /* If a timer has run, this might have changed buffers
2468 an alike. Make read_key_sequence aware of that. */
2469 if (timers_run
!= old_timers_run
2470 && old_buffer
!= current_buffer
2471 && waiting_for_user_input_p
== -1)
2472 record_asynch_buffer_change ();
2474 if (timers_run
!= old_timers_run
&& do_display
)
2475 /* We must retry, since a timer may have requeued itself
2476 and that could alter the time_delay. */
2477 redisplay_preserve_echo_area (9);
2481 while (!detect_input_pending ());
2483 /* If there is unread keyboard input, also return. */
2484 if (XINT (read_kbd
) != 0
2485 && requeued_events_pending_p ())
2488 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
2490 EMACS_TIME difference
;
2491 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
2492 if (EMACS_TIME_NEG_P (difference
))
2494 timeout
= timer_delay
;
2495 timeout_reduced_for_timers
= 1;
2498 /* If time_limit is -1, we are not going to wait at all. */
2499 else if (time_limit
!= -1)
2501 /* This is so a breakpoint can be put here. */
2502 wait_reading_process_input_1 ();
2506 /* Cause C-g and alarm signals to take immediate action,
2507 and cause input available signals to zero out timeout.
2509 It is important that we do this before checking for process
2510 activity. If we get a SIGCHLD after the explicit checks for
2511 process activity, timeout is the only way we will know. */
2512 if (XINT (read_kbd
) < 0)
2513 set_waiting_for_input (&timeout
);
2515 /* If status of something has changed, and no input is
2516 available, notify the user of the change right away. After
2517 this explicit check, we'll let the SIGCHLD handler zap
2518 timeout to get our attention. */
2519 if (update_tick
!= process_tick
&& do_display
)
2521 Atemp
= input_wait_mask
;
2522 EMACS_SET_SECS_USECS (timeout
, 0, 0);
2523 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
2524 &Atemp
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
2528 /* It's okay for us to do this and then continue with
2529 the loop, since timeout has already been zeroed out. */
2530 clear_waiting_for_input ();
2535 /* Don't wait for output from a non-running process. */
2536 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
2537 update_status (wait_proc
);
2539 && ! EQ (wait_proc
->status
, Qrun
))
2541 int nread
, total_nread
= 0;
2543 clear_waiting_for_input ();
2544 XSETPROCESS (proc
, wait_proc
);
2546 /* Read data from the process, until we exhaust it. */
2547 while (XINT (wait_proc
->infd
) >= 0)
2549 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
2555 total_nread
+= nread
;
2557 else if (nread
== -1 && EIO
== errno
)
2561 else if (nread
== -1 && EAGAIN
== errno
)
2565 else if (nread
== -1 && EWOULDBLOCK
== errno
)
2569 if (total_nread
> 0 && do_display
)
2570 redisplay_preserve_echo_area (10);
2575 /* Wait till there is something to do */
2577 if (!NILP (wait_for_cell
))
2578 Available
= non_process_wait_mask
;
2579 else if (! XINT (read_kbd
))
2580 Available
= non_keyboard_wait_mask
;
2582 Available
= input_wait_mask
;
2584 /* If frame size has changed or the window is newly mapped,
2585 redisplay now, before we start to wait. There is a race
2586 condition here; if a SIGIO arrives between now and the select
2587 and indicates that a frame is trashed, the select may block
2588 displaying a trashed screen. */
2589 if (frame_garbaged
&& do_display
)
2591 clear_waiting_for_input ();
2592 redisplay_preserve_echo_area (11);
2593 if (XINT (read_kbd
) < 0)
2594 set_waiting_for_input (&timeout
);
2597 if (XINT (read_kbd
) && detect_input_pending ())
2600 FD_ZERO (&Available
);
2603 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
2604 &Available
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
2609 /* Make C-g and alarm signals set flags again */
2610 clear_waiting_for_input ();
2612 /* If we woke up due to SIGWINCH, actually change size now. */
2613 do_pending_window_change (0);
2615 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
2616 /* We wanted the full specified time, so return now. */
2620 if (xerrno
== EINTR
)
2621 FD_ZERO (&Available
);
2623 /* Ultrix select seems to return ENOMEM when it is
2624 interrupted. Treat it just like EINTR. Bleah. Note
2625 that we want to test for the "ultrix" CPP symbol, not
2626 "__ultrix__"; the latter is only defined under GCC, but
2627 not by DEC's bundled CC. -JimB */
2628 else if (xerrno
== ENOMEM
)
2629 FD_ZERO (&Available
);
2632 /* This happens for no known reason on ALLIANT.
2633 I am guessing that this is the right response. -- RMS. */
2634 else if (xerrno
== EFAULT
)
2635 FD_ZERO (&Available
);
2637 else if (xerrno
== EBADF
)
2640 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
2641 the child's closure of the pts gives the parent a SIGHUP, and
2642 the ptc file descriptor is automatically closed,
2643 yielding EBADF here or at select() call above.
2644 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
2645 in m/ibmrt-aix.h), and here we just ignore the select error.
2646 Cleanup occurs c/o status_notify after SIGCLD. */
2647 FD_ZERO (&Available
); /* Cannot depend on values returned */
2653 error ("select error: %s", emacs_strerror (xerrno
));
2655 #if defined(sun) && !defined(USG5_4)
2656 else if (nfds
> 0 && keyboard_bit_set (&Available
)
2658 /* System sometimes fails to deliver SIGIO.
2660 David J. Mackenzie says that Emacs doesn't compile under
2661 Solaris if this code is enabled, thus the USG5_4 in the CPP
2662 conditional. "I haven't noticed any ill effects so far.
2663 If you find a Solaris expert somewhere, they might know
2665 kill (getpid (), SIGIO
);
2668 #if 0 /* When polling is used, interrupt_input is 0,
2669 so get_input_pending should read the input.
2670 So this should not be needed. */
2671 /* If we are using polling for input,
2672 and we see input available, make it get read now.
2673 Otherwise it might not actually get read for a second.
2674 And on hpux, since we turn off polling in wait_reading_process_input,
2675 it might never get read at all if we don't spend much time
2676 outside of wait_reading_process_input. */
2677 if (XINT (read_kbd
) && interrupt_input
2678 && keyboard_bit_set (&Available
)
2679 && input_polling_used ())
2680 kill (getpid (), SIGALRM
);
2683 /* Check for keyboard input */
2684 /* If there is any, return immediately
2685 to give it higher priority than subprocesses */
2687 if (XINT (read_kbd
) != 0)
2689 int old_timers_run
= timers_run
;
2690 struct buffer
*old_buffer
= current_buffer
;
2693 if (detect_input_pending_run_timers (do_display
))
2695 swallow_events (do_display
);
2696 if (detect_input_pending_run_timers (do_display
))
2700 /* If a timer has run, this might have changed buffers
2701 an alike. Make read_key_sequence aware of that. */
2702 if (timers_run
!= old_timers_run
2703 && waiting_for_user_input_p
== -1
2704 && old_buffer
!= current_buffer
)
2705 record_asynch_buffer_change ();
2711 /* If there is unread keyboard input, also return. */
2712 if (XINT (read_kbd
) != 0
2713 && requeued_events_pending_p ())
2716 /* If we are not checking for keyboard input now,
2717 do process events (but don't run any timers).
2718 This is so that X events will be processed.
2719 Otherwise they may have to wait until polling takes place.
2720 That would causes delays in pasting selections, for example.
2722 (We used to do this only if wait_for_cell.) */
2723 if (XINT (read_kbd
) == 0 && detect_input_pending ())
2725 swallow_events (do_display
);
2726 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
2727 if (detect_input_pending ())
2732 /* Exit now if the cell we're waiting for became non-nil. */
2733 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
2737 /* If we think we have keyboard input waiting, but didn't get SIGIO,
2738 go read it. This can happen with X on BSD after logging out.
2739 In that case, there really is no input and no SIGIO,
2740 but select says there is input. */
2742 if (XINT (read_kbd
) && interrupt_input
2743 && keyboard_bit_set (&Available
))
2744 kill (getpid (), SIGIO
);
2748 got_some_input
|= nfds
> 0;
2750 /* If checking input just got us a size-change event from X,
2751 obey it now if we should. */
2752 if (XINT (read_kbd
) || ! NILP (wait_for_cell
))
2753 do_pending_window_change (0);
2755 /* Check for data from a process. */
2756 /* Really FIRST_PROC_DESC should be 0 on Unix,
2757 but this is safer in the short run. */
2758 for (channel
= 0; channel
<= max_process_desc
; channel
++)
2760 if (FD_ISSET (channel
, &Available
)
2761 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
2765 /* If waiting for this channel, arrange to return as
2766 soon as no more input to be processed. No more
2768 if (wait_channel
== channel
)
2774 proc
= chan_process
[channel
];
2778 /* Read data from the process, starting with our
2779 buffered-ahead character if we have one. */
2781 nread
= read_process_output (proc
, channel
);
2784 /* Since read_process_output can run a filter,
2785 which can call accept-process-output,
2786 don't try to read from any other processes
2787 before doing the select again. */
2788 FD_ZERO (&Available
);
2791 redisplay_preserve_echo_area (12);
2794 else if (nread
== -1 && errno
== EWOULDBLOCK
)
2797 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
2798 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
2800 else if (nread
== -1 && errno
== EAGAIN
)
2804 else if (nread
== -1 && errno
== EAGAIN
)
2806 /* Note that we cannot distinguish between no input
2807 available now and a closed pipe.
2808 With luck, a closed pipe will be accompanied by
2809 subprocess termination and SIGCHLD. */
2810 else if (nread
== 0 && !NETCONN_P (proc
))
2812 #endif /* O_NDELAY */
2813 #endif /* O_NONBLOCK */
2815 /* On some OSs with ptys, when the process on one end of
2816 a pty exits, the other end gets an error reading with
2817 errno = EIO instead of getting an EOF (0 bytes read).
2818 Therefore, if we get an error reading and errno =
2819 EIO, just continue, because the child process has
2820 exited and should clean itself up soon (e.g. when we
2823 However, it has been known to happen that the SIGCHLD
2824 got lost. So raise the signl again just in case.
2826 else if (nread
== -1 && errno
== EIO
)
2827 kill (getpid (), SIGCHLD
);
2828 #endif /* HAVE_PTYS */
2829 /* If we can detect process termination, don't consider the process
2830 gone just because its pipe is closed. */
2832 else if (nread
== 0 && !NETCONN_P (proc
))
2837 /* Preserve status of processes already terminated. */
2838 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
2839 deactivate_process (proc
);
2840 if (!NILP (XPROCESS (proc
)->raw_status_low
))
2841 update_status (XPROCESS (proc
));
2842 if (EQ (XPROCESS (proc
)->status
, Qrun
))
2843 XPROCESS (proc
)->status
2844 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
2847 } /* end for each file descriptor */
2848 } /* end while exit conditions not met */
2850 waiting_for_user_input_p
= 0;
2852 /* If calling from keyboard input, do not quit
2853 since we want to return C-g as an input character.
2854 Otherwise, do pending quit if requested. */
2855 if (XINT (read_kbd
) >= 0)
2857 /* Prevent input_pending from remaining set if we quit. */
2858 clear_input_pending ();
2862 /* AlainF 5-Jul-1996
2863 HP-UX 10.10 seems to have problems with signals coming in
2864 Causes "poll: interrupted system call" messages when Emacs is run
2866 Turn periodic alarms back on */
2870 return got_some_input
;
2873 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
2876 read_process_output_call (fun_and_args
)
2877 Lisp_Object fun_and_args
;
2879 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
2883 read_process_output_error_handler (error
)
2886 cmd_error_internal (error
, "error in process filter: ");
2888 update_echo_area ();
2889 Fsleep_for (make_number (2), Qnil
);
2893 /* Read pending output from the process channel,
2894 starting with our buffered-ahead character if we have one.
2895 Yield number of decoded characters read.
2897 This function reads at most 1024 characters.
2898 If you want to read all available subprocess output,
2899 you must call it repeatedly until it returns zero.
2901 The characters read are decoded according to PROC's coding-system
2905 read_process_output (proc
, channel
)
2907 register int channel
;
2909 register int nchars
, nbytes
;
2911 register Lisp_Object outstream
;
2912 register struct buffer
*old
= current_buffer
;
2913 register struct Lisp_Process
*p
= XPROCESS (proc
);
2914 register int opoint
;
2915 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
2916 int carryover
= XINT (p
->decoding_carryover
);
2919 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
2921 vs
= get_vms_process_pointer (p
->pid
);
2925 return (0); /* Really weird if it does this */
2926 if (!(vs
->iosb
[0] & 1))
2927 return -1; /* I/O error */
2930 error ("Could not get VMS process pointer");
2931 chars
= vs
->inputBuffer
;
2932 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
2935 start_vms_process_read (vs
); /* Crank up the next read on the process */
2936 return 1; /* Nothing worth printing, say we got 1 */
2940 /* The data carried over in the previous decoding (which are at
2941 the tail of decoding buffer) should be prepended to the new
2942 data read to decode all together. */
2943 chars
= (char *) alloca (nbytes
+ carryover
);
2944 bcopy (XSTRING (p
->decoding_buf
)->data
, buf
, carryover
);
2945 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
2948 chars
= (char *) alloca (carryover
+ 1024);
2950 /* See the comment above. */
2951 bcopy (XSTRING (p
->decoding_buf
)->data
, chars
, carryover
);
2953 if (proc_buffered_char
[channel
] < 0)
2954 nbytes
= emacs_read (channel
, chars
+ carryover
, 1024 - carryover
);
2957 chars
[carryover
] = proc_buffered_char
[channel
];
2958 proc_buffered_char
[channel
] = -1;
2959 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, 1023 - carryover
);
2963 nbytes
= nbytes
+ 1;
2965 #endif /* not VMS */
2967 XSETINT (p
->decoding_carryover
, 0);
2969 /* At this point, NBYTES holds number of bytes just received
2970 (including the one in proc_buffered_char[channel]). */
2973 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
2975 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
2978 /* Now set NBYTES how many bytes we must decode. */
2979 nbytes
+= carryover
;
2981 /* Read and dispose of the process output. */
2982 outstream
= p
->filter
;
2983 if (!NILP (outstream
))
2985 /* We inhibit quit here instead of just catching it so that
2986 hitting ^G when a filter happens to be running won't screw
2988 int count
= specpdl_ptr
- specpdl
;
2989 Lisp_Object odeactivate
;
2990 Lisp_Object obuffer
, okeymap
;
2992 int outer_running_asynch_code
= running_asynch_code
;
2993 int waiting
= waiting_for_user_input_p
;
2995 /* No need to gcpro these, because all we do with them later
2996 is test them for EQness, and none of them should be a string. */
2997 odeactivate
= Vdeactivate_mark
;
2998 XSETBUFFER (obuffer
, current_buffer
);
2999 okeymap
= current_buffer
->keymap
;
3001 specbind (Qinhibit_quit
, Qt
);
3002 specbind (Qlast_nonmenu_event
, Qt
);
3004 /* In case we get recursively called,
3005 and we already saved the match data nonrecursively,
3006 save the same match data in safely recursive fashion. */
3007 if (outer_running_asynch_code
)
3010 /* Don't clobber the CURRENT match data, either! */
3011 tem
= Fmatch_data (Qnil
, Qnil
);
3012 restore_match_data ();
3013 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
3014 Fset_match_data (tem
);
3017 /* For speed, if a search happens within this code,
3018 save the match data in a special nonrecursive fashion. */
3019 running_asynch_code
= 1;
3021 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
3022 text
= coding
->dst_object
;
3023 if (NILP (buffer_defaults
.enable_multibyte_characters
))
3024 /* We had better return unibyte string. */
3025 text
= string_make_unibyte (text
);
3027 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
3028 /* A new coding system might be found. */
3029 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
3031 p
->decode_coding_system
= Vlast_coding_system_used
;
3033 /* Don't call setup_coding_system for
3034 proc_decode_coding_system[channel] here. It is done in
3035 detect_coding called via decode_coding above. */
3037 /* If a coding system for encoding is not yet decided, we set
3038 it as the same as coding-system for decoding.
3040 But, before doing that we must check if
3041 proc_encode_coding_system[p->outfd] surely points to a
3042 valid memory because p->outfd will be changed once EOF is
3043 sent to the process. */
3044 if (NILP (p
->encode_coding_system
)
3045 && proc_encode_coding_system
[XINT (p
->outfd
)])
3047 p
->encode_coding_system
= Vlast_coding_system_used
;
3048 setup_coding_system (p
->encode_coding_system
,
3049 proc_encode_coding_system
[XINT (p
->outfd
)]);
3053 carryover
= nbytes
- coding
->consumed
;
3054 bcopy (chars
+ coding
->consumed
, XSTRING (p
->decoding_buf
)->data
,
3056 XSETINT (p
->decoding_carryover
, carryover
);
3057 nbytes
= STRING_BYTES (XSTRING (text
));
3058 nchars
= XSTRING (text
)->size
;
3060 internal_condition_case_1 (read_process_output_call
,
3062 Fcons (proc
, Fcons (text
, Qnil
))),
3063 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
3064 read_process_output_error_handler
);
3066 /* If we saved the match data nonrecursively, restore it now. */
3067 restore_match_data ();
3068 running_asynch_code
= outer_running_asynch_code
;
3070 /* Handling the process output should not deactivate the mark. */
3071 Vdeactivate_mark
= odeactivate
;
3073 /* Restore waiting_for_user_input_p as it was
3074 when we were called, in case the filter clobbered it. */
3075 waiting_for_user_input_p
= waiting
;
3077 #if 0 /* Call record_asynch_buffer_change unconditionally,
3078 because we might have changed minor modes or other things
3079 that affect key bindings. */
3080 if (! EQ (Fcurrent_buffer (), obuffer
)
3081 || ! EQ (current_buffer
->keymap
, okeymap
))
3083 /* But do it only if the caller is actually going to read events.
3084 Otherwise there's no need to make him wake up, and it could
3085 cause trouble (for example it would make Fsit_for return). */
3086 if (waiting_for_user_input_p
== -1)
3087 record_asynch_buffer_change ();
3090 start_vms_process_read (vs
);
3092 unbind_to (count
, Qnil
);
3096 /* If no filter, write into buffer if it isn't dead. */
3097 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
3099 Lisp_Object old_read_only
;
3100 int old_begv
, old_zv
;
3101 int old_begv_byte
, old_zv_byte
;
3102 Lisp_Object odeactivate
;
3103 int before
, before_byte
;
3108 odeactivate
= Vdeactivate_mark
;
3110 Fset_buffer (p
->buffer
);
3112 opoint_byte
= PT_BYTE
;
3113 old_read_only
= current_buffer
->read_only
;
3116 old_begv_byte
= BEGV_BYTE
;
3117 old_zv_byte
= ZV_BYTE
;
3119 current_buffer
->read_only
= Qnil
;
3121 /* Insert new output into buffer
3122 at the current end-of-output marker,
3123 thus preserving logical ordering of input and output. */
3124 if (XMARKER (p
->mark
)->buffer
)
3125 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
3126 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
3129 SET_PT_BOTH (ZV
, ZV_BYTE
);
3131 before_byte
= PT_BYTE
;
3133 /* If the output marker is outside of the visible region, save
3134 the restriction and widen. */
3135 if (! (BEGV
<= PT
&& PT
<= ZV
))
3138 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
3139 text
= coding
->dst_object
;
3140 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
3141 /* A new coding system might be found. See the comment in the
3142 similar code in the previous `if' block. */
3143 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
3145 p
->decode_coding_system
= Vlast_coding_system_used
;
3146 if (NILP (p
->encode_coding_system
)
3147 && proc_encode_coding_system
[XINT (p
->outfd
)])
3149 p
->encode_coding_system
= Vlast_coding_system_used
;
3150 setup_coding_system (p
->encode_coding_system
,
3151 proc_encode_coding_system
[XINT (p
->outfd
)]);
3154 carryover
= nbytes
- coding
->consumed
;
3155 bcopy (chars
+ coding
->consumed
, XSTRING (p
->decoding_buf
)->data
,
3157 XSETINT (p
->decoding_carryover
, carryover
);
3158 /* Adjust the multibyteness of TEXT to that of the buffer. */
3159 if (NILP (current_buffer
->enable_multibyte_characters
)
3160 != ! STRING_MULTIBYTE (text
))
3161 text
= (STRING_MULTIBYTE (text
)
3162 ? Fstring_as_unibyte (text
)
3163 : Fstring_as_multibyte (text
));
3164 nbytes
= STRING_BYTES (XSTRING (text
));
3165 nchars
= XSTRING (text
)->size
;
3166 /* Insert before markers in case we are inserting where
3167 the buffer's mark is, and the user's next command is Meta-y. */
3168 insert_from_string_before_markers (text
, 0, 0, nchars
, nbytes
, 0);
3170 /* Make sure the process marker's position is valid when the
3171 process buffer is changed in the signal_after_change above.
3172 W3 is known to do that. */
3173 if (BUFFERP (p
->buffer
)
3174 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
3175 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
3177 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
3179 update_mode_lines
++;
3181 /* Make sure opoint and the old restrictions
3182 float ahead of any new text just as point would. */
3183 if (opoint
>= before
)
3185 opoint
+= PT
- before
;
3186 opoint_byte
+= PT_BYTE
- before_byte
;
3188 if (old_begv
> before
)
3190 old_begv
+= PT
- before
;
3191 old_begv_byte
+= PT_BYTE
- before_byte
;
3193 if (old_zv
>= before
)
3195 old_zv
+= PT
- before
;
3196 old_zv_byte
+= PT_BYTE
- before_byte
;
3199 /* If the restriction isn't what it should be, set it. */
3200 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
3201 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
3203 /* Handling the process output should not deactivate the mark. */
3204 Vdeactivate_mark
= odeactivate
;
3206 current_buffer
->read_only
= old_read_only
;
3207 SET_PT_BOTH (opoint
, opoint_byte
);
3208 set_buffer_internal (old
);
3211 start_vms_process_read (vs
);
3216 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
3218 doc
: /* Returns non-nil if emacs is waiting for input from the user.
3219 This is intended for use by asynchronous process output filters and sentinels. */)
3222 return (waiting_for_user_input_p
? Qt
: Qnil
);
3225 /* Sending data to subprocess */
3227 jmp_buf send_process_frame
;
3228 Lisp_Object process_sent_to
;
3231 send_process_trap ()
3237 longjmp (send_process_frame
, 1);
3240 /* Send some data to process PROC.
3241 BUF is the beginning of the data; LEN is the number of characters.
3242 OBJECT is the Lisp object that the data comes from. If OBJECT is
3243 nil or t, it means that the data comes from C string.
3245 If OBJECT is not nil, the data is encoded by PROC's coding-system
3246 for encoding before it is sent.
3248 This function can evaluate Lisp code and can garbage collect. */
3251 send_process (proc
, buf
, len
, object
)
3252 volatile Lisp_Object proc
;
3253 unsigned char *volatile buf
;
3255 volatile Lisp_Object object
;
3257 /* Use volatile to protect variables from being clobbered by longjmp. */
3259 struct coding_system
*coding
;
3260 struct gcpro gcpro1
;
3265 struct Lisp_Process
*p
= XPROCESS (proc
);
3266 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
3269 if (! NILP (XPROCESS (proc
)->raw_status_low
))
3270 update_status (XPROCESS (proc
));
3271 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
3272 error ("Process %s not running",
3273 XSTRING (XPROCESS (proc
)->name
)->data
);
3274 if (XINT (XPROCESS (proc
)->outfd
) < 0)
3275 error ("Output file descriptor of %s is closed",
3276 XSTRING (XPROCESS (proc
)->name
)->data
);
3278 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
3279 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
3281 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
3282 || (BUFFERP (object
)
3283 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
3286 if (!EQ (Vlast_coding_system_used
,
3287 XPROCESS (proc
)->encode_coding_system
))
3288 /* The coding system for encoding was changed to raw-text
3289 because we sent a unibyte text previously. Now we are
3290 sending a multibyte text, thus we must encode it by the
3291 original coding system specified for the current
3293 setup_coding_system (XPROCESS (proc
)->encode_coding_system
, coding
);
3297 /* For sending a unibyte text, character code conversion should
3298 not take place but EOL conversion should. So, setup raw-text
3299 or one of the subsidiary if we have not yet done it. */
3300 if (CODING_REQUIRE_ENCODING (coding
))
3302 if (CODING_REQUIRE_FLUSHING (coding
))
3304 /* But, before changing the coding, we must flush out data. */
3305 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
3306 send_process (proc
, "", 0, Qt
);
3307 coding
->mode
&= ~CODING_MODE_LAST_BLOCK
;
3309 coding
->src_multibyte
= 0;
3310 setup_coding_system (raw_text_coding_system
3311 (Vlast_coding_system_used
),
3315 coding
->dst_multibyte
= 0;
3317 if (CODING_REQUIRE_ENCODING (coding
))
3319 coding
->dst_object
= Qt
;
3320 if (BUFFERP (object
))
3322 int from_byte
, from
, to
;
3323 int save_pt
, save_pt_byte
;
3324 struct buffer
*cur
= current_buffer
;
3326 set_buffer_internal (XBUFFER (object
));
3327 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
3329 from_byte
= PTR_BYTE_POS (buf
);
3330 from
= BYTE_TO_CHAR (from_byte
);
3331 to
= BYTE_TO_CHAR (from_byte
+ len
);
3332 TEMP_SET_PT_BOTH (from
, from_byte
);
3333 encode_coding_object (coding
, object
, from
, from_byte
,
3334 to
, from_byte
+ len
, Qt
);
3335 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
3336 set_buffer_internal (cur
);
3338 else if (STRINGP (object
))
3340 encode_coding_string (coding
, object
, 1);
3344 coding
->dst_object
= make_unibyte_string (buf
, len
);
3345 coding
->produced
= len
;
3348 len
= coding
->produced
;
3349 buf
= XSTRING (coding
->dst_object
)->data
;
3353 vs
= get_vms_process_pointer (p
->pid
);
3355 error ("Could not find this process: %x", p
->pid
);
3356 else if (write_to_vms_process (vs
, buf
, len
))
3360 if (pty_max_bytes
== 0)
3362 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
3363 pty_max_bytes
= fpathconf (XFASTINT (XPROCESS (proc
)->outfd
),
3365 if (pty_max_bytes
< 0)
3366 pty_max_bytes
= 250;
3368 pty_max_bytes
= 250;
3370 /* Deduct one, to leave space for the eof. */
3374 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
3375 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
3376 when returning with longjmp despite being declared volatile. */
3377 if (!setjmp (send_process_frame
))
3379 process_sent_to
= proc
;
3383 SIGTYPE (*old_sigpipe
)();
3385 /* Decide how much data we can send in one batch.
3386 Long lines need to be split into multiple batches. */
3387 if (!NILP (XPROCESS (proc
)->pty_flag
))
3389 /* Starting this at zero is always correct when not the first
3390 iteration because the previous iteration ended by sending C-d.
3391 It may not be correct for the first iteration
3392 if a partial line was sent in a separate send_process call.
3393 If that proves worth handling, we need to save linepos
3394 in the process object. */
3396 unsigned char *ptr
= (unsigned char *) buf
;
3397 unsigned char *end
= (unsigned char *) buf
+ len
;
3399 /* Scan through this text for a line that is too long. */
3400 while (ptr
!= end
&& linepos
< pty_max_bytes
)
3408 /* If we found one, break the line there
3409 and put in a C-d to force the buffer through. */
3413 /* Send this batch, using one or more write calls. */
3416 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
3417 rv
= emacs_write (XINT (XPROCESS (proc
)->outfd
),
3418 (char *) buf
, this);
3419 signal (SIGPIPE
, old_sigpipe
);
3425 || errno
== EWOULDBLOCK
3431 /* Buffer is full. Wait, accepting input;
3432 that may allow the program
3433 to finish doing output and read more. */
3438 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
3439 /* A gross hack to work around a bug in FreeBSD.
3440 In the following sequence, read(2) returns
3444 write(2) 954 bytes, get EAGAIN
3445 read(2) 1024 bytes in process_read_output
3446 read(2) 11 bytes in process_read_output
3448 That is, read(2) returns more bytes than have
3449 ever been written successfully. The 1033 bytes
3450 read are the 1022 bytes written successfully
3451 after processing (for example with CRs added if
3452 the terminal is set up that way which it is
3453 here). The same bytes will be seen again in a
3454 later read(2), without the CRs. */
3456 if (errno
== EAGAIN
)
3459 ioctl (XINT (XPROCESS (proc
)->outfd
), TIOCFLUSH
,
3462 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
3464 /* Running filters might relocate buffers or strings.
3465 Arrange to relocate BUF. */
3466 if (BUFFERP (object
))
3467 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
3468 else if (STRINGP (object
))
3469 offset
= buf
- XSTRING (object
)->data
;
3471 XSETFASTINT (zero
, 0);
3472 #ifdef EMACS_HAS_USECS
3473 wait_reading_process_input (0, 20000, zero
, 0);
3475 wait_reading_process_input (1, 0, zero
, 0);
3478 if (BUFFERP (object
))
3479 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
3480 else if (STRINGP (object
))
3481 buf
= offset
+ XSTRING (object
)->data
;
3486 /* This is a real error. */
3487 report_file_error ("writing to process", Fcons (proc
, Qnil
));
3494 /* If we sent just part of the string, put in an EOF
3495 to force it through, before we send the rest. */
3497 Fprocess_send_eof (proc
);
3500 #endif /* not VMS */
3504 proc
= process_sent_to
;
3506 XPROCESS (proc
)->raw_status_low
= Qnil
;
3507 XPROCESS (proc
)->raw_status_high
= Qnil
;
3508 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
3509 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
3510 deactivate_process (proc
);
3512 error ("Error writing to process %s; closed it",
3513 XSTRING (XPROCESS (proc
)->name
)->data
);
3515 error ("SIGPIPE raised on process %s; closed it",
3516 XSTRING (XPROCESS (proc
)->name
)->data
);
3523 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
3525 doc
: /* Send current contents of region as input to PROCESS.
3526 PROCESS may be a process, a buffer, the name of a process or buffer, or
3527 nil, indicating the current buffer's process.
3528 Called from program, takes three arguments, PROCESS, START and END.
3529 If the region is more than 500 characters long,
3530 it is sent in several bunches. This may happen even for shorter regions.
3531 Output from processes can arrive in between bunches. */)
3532 (process
, start
, end
)
3533 Lisp_Object process
, start
, end
;
3538 proc
= get_process (process
);
3539 validate_region (&start
, &end
);
3541 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
3542 move_gap (XINT (start
));
3544 start1
= CHAR_TO_BYTE (XINT (start
));
3545 end1
= CHAR_TO_BYTE (XINT (end
));
3546 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
3547 Fcurrent_buffer ());
3552 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
3554 doc
: /* Send PROCESS the contents of STRING as input.
3555 PROCESS may be a process, a buffer, the name of a process or buffer, or
3556 nil, indicating the current buffer's process.
3557 If STRING is more than 500 characters long,
3558 it is sent in several bunches. This may happen even for shorter strings.
3559 Output from processes can arrive in between bunches. */)
3561 Lisp_Object process
, string
;
3564 CHECK_STRING (string
);
3565 proc
= get_process (process
);
3566 send_process (proc
, XSTRING (string
)->data
,
3567 STRING_BYTES (XSTRING (string
)), string
);
3571 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
3572 Sprocess_running_child_p
, 0, 1, 0,
3573 doc
: /* Return t if PROCESS has given the terminal to a child.
3574 If the operating system does not make it possible to find out,
3575 return t unconditionally. */)
3577 Lisp_Object process
;
3579 /* Initialize in case ioctl doesn't exist or gives an error,
3580 in a way that will cause returning t. */
3583 struct Lisp_Process
*p
;
3585 proc
= get_process (process
);
3586 p
= XPROCESS (proc
);
3588 if (!EQ (p
->childp
, Qt
))
3589 error ("Process %s is not a subprocess",
3590 XSTRING (p
->name
)->data
);
3591 if (XINT (p
->infd
) < 0)
3592 error ("Process %s is not active",
3593 XSTRING (p
->name
)->data
);
3596 if (!NILP (p
->subtty
))
3597 ioctl (XFASTINT (p
->subtty
), TIOCGPGRP
, &gid
);
3599 ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
);
3600 #endif /* defined (TIOCGPGRP ) */
3602 if (gid
== XFASTINT (p
->pid
))
3607 /* send a signal number SIGNO to PROCESS.
3608 If CURRENT_GROUP is t, that means send to the process group
3609 that currently owns the terminal being used to communicate with PROCESS.
3610 This is used for various commands in shell mode.
3611 If CURRENT_GROUP is lambda, that means send to the process group
3612 that currently owns the terminal, but only if it is NOT the shell itself.
3614 If NOMSG is zero, insert signal-announcements into process's buffers
3617 If we can, we try to signal PROCESS by sending control characters
3618 down the pty. This allows us to signal inferiors who have changed
3619 their uid, for which killpg would return an EPERM error. */
3622 process_send_signal (process
, signo
, current_group
, nomsg
)
3623 Lisp_Object process
;
3625 Lisp_Object current_group
;
3629 register struct Lisp_Process
*p
;
3633 proc
= get_process (process
);
3634 p
= XPROCESS (proc
);
3636 if (!EQ (p
->childp
, Qt
))
3637 error ("Process %s is not a subprocess",
3638 XSTRING (p
->name
)->data
);
3639 if (XINT (p
->infd
) < 0)
3640 error ("Process %s is not active",
3641 XSTRING (p
->name
)->data
);
3643 if (NILP (p
->pty_flag
))
3644 current_group
= Qnil
;
3646 /* If we are using pgrps, get a pgrp number and make it negative. */
3647 if (!NILP (current_group
))
3649 #ifdef SIGNALS_VIA_CHARACTERS
3650 /* If possible, send signals to the entire pgrp
3651 by sending an input character to it. */
3653 /* TERMIOS is the latest and bestest, and seems most likely to
3654 work. If the system has it, use it. */
3661 tcgetattr (XINT (p
->infd
), &t
);
3662 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
3666 tcgetattr (XINT (p
->infd
), &t
);
3667 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
3671 tcgetattr (XINT (p
->infd
), &t
);
3672 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
3673 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
3675 send_process (proc
, &t
.c_cc
[VSUSP
], 1, Qnil
);
3680 #else /* ! HAVE_TERMIOS */
3682 /* On Berkeley descendants, the following IOCTL's retrieve the
3683 current control characters. */
3684 #if defined (TIOCGLTC) && defined (TIOCGETC)
3692 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
3693 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
3696 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
3697 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
3701 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
3702 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
3704 #endif /* ! defined (SIGTSTP) */
3707 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
3709 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
3716 ioctl (XINT (p
->infd
), TCGETA
, &t
);
3717 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
3720 ioctl (XINT (p
->infd
), TCGETA
, &t
);
3721 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
3725 ioctl (XINT (p
->infd
), TCGETA
, &t
);
3726 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
3728 #endif /* ! defined (SIGTSTP) */
3730 #else /* ! defined (TCGETA) */
3731 Your configuration files are messed up
.
3732 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
3733 you'd better be using one of the alternatives above! */
3734 #endif /* ! defined (TCGETA) */
3735 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
3736 #endif /* ! defined HAVE_TERMIOS */
3737 #endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
3740 /* Get the pgrp using the tty itself, if we have that.
3741 Otherwise, use the pty to get the pgrp.
3742 On pfa systems, saka@pfu.fujitsu.co.JP writes:
3743 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
3744 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
3745 His patch indicates that if TIOCGPGRP returns an error, then
3746 we should just assume that p->pid is also the process group id. */
3750 if (!NILP (p
->subtty
))
3751 err
= ioctl (XFASTINT (p
->subtty
), TIOCGPGRP
, &gid
);
3753 err
= ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
);
3757 gid
= - XFASTINT (p
->pid
);
3758 #endif /* ! defined (pfa) */
3764 #else /* ! defined (TIOCGPGRP ) */
3765 /* Can't select pgrps on this system, so we know that
3766 the child itself heads the pgrp. */
3767 gid
= - XFASTINT (p
->pid
);
3768 #endif /* ! defined (TIOCGPGRP ) */
3770 /* If current_group is lambda, and the shell owns the terminal,
3771 don't send any signal. */
3772 if (EQ (current_group
, Qlambda
) && gid
== - XFASTINT (p
->pid
))
3776 gid
= - XFASTINT (p
->pid
);
3782 p
->raw_status_low
= Qnil
;
3783 p
->raw_status_high
= Qnil
;
3785 XSETINT (p
->tick
, ++process_tick
);
3789 #endif /* ! defined (SIGCONT) */
3792 send_process (proc
, "\003", 1, Qnil
); /* ^C */
3797 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
3802 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
3805 flush_pending_output (XINT (p
->infd
));
3809 /* If we don't have process groups, send the signal to the immediate
3810 subprocess. That isn't really right, but it's better than any
3811 obvious alternative. */
3814 kill (XFASTINT (p
->pid
), signo
);
3818 /* gid may be a pid, or minus a pgrp's number */
3820 if (!NILP (current_group
))
3821 ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
);
3824 gid
= - XFASTINT (p
->pid
);
3827 #else /* ! defined (TIOCSIGSEND) */
3828 EMACS_KILLPG (-gid
, signo
);
3829 #endif /* ! defined (TIOCSIGSEND) */
3832 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
3833 doc
: /* Interrupt process PROCESS.
3834 PROCESS may be a process, a buffer, or the name of a process or buffer.
3835 nil or no arg means current buffer's process.
3836 Second arg CURRENT-GROUP non-nil means send signal to
3837 the current process-group of the process's controlling terminal
3838 rather than to the process's own process group.
3839 If the process is a shell, this means interrupt current subjob
3840 rather than the shell.
3842 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
3843 don't send the signal. */)
3844 (process
, current_group
)
3845 Lisp_Object process
, current_group
;
3847 process_send_signal (process
, SIGINT
, current_group
, 0);
3851 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
3852 doc
: /* Kill process PROCESS. May be process or name of one.
3853 See function `interrupt-process' for more details on usage. */)
3854 (process
, current_group
)
3855 Lisp_Object process
, current_group
;
3857 process_send_signal (process
, SIGKILL
, current_group
, 0);
3861 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
3862 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
3863 See function `interrupt-process' for more details on usage. */)
3864 (process
, current_group
)
3865 Lisp_Object process
, current_group
;
3867 process_send_signal (process
, SIGQUIT
, current_group
, 0);
3871 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
3872 doc
: /* Stop process PROCESS. May be process or name of one.
3873 See function `interrupt-process' for more details on usage. */)
3874 (process
, current_group
)
3875 Lisp_Object process
, current_group
;
3878 error ("no SIGTSTP support");
3880 process_send_signal (process
, SIGTSTP
, current_group
, 0);
3885 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
3886 doc
: /* Continue process PROCESS. May be process or name of one.
3887 See function `interrupt-process' for more details on usage. */)
3888 (process
, current_group
)
3889 Lisp_Object process
, current_group
;
3892 process_send_signal (process
, SIGCONT
, current_group
, 0);
3894 error ("no SIGCONT support");
3899 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
3900 2, 2, "nProcess number: \nnSignal code: ",
3901 doc
: /* Send the process with process id PID the signal with code SIGCODE.
3902 PID must be an integer. The process need not be a child of this Emacs.
3903 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
3905 Lisp_Object pid
, sigcode
;
3909 #define handle_signal(NAME, VALUE) \
3910 else if (!strcmp (name, NAME)) \
3911 XSETINT (sigcode, VALUE)
3913 if (INTEGERP (sigcode
))
3917 unsigned char *name
;
3919 CHECK_SYMBOL (sigcode
);
3920 name
= XSYMBOL (sigcode
)->name
->data
;
3925 handle_signal ("SIGHUP", SIGHUP
);
3928 handle_signal ("SIGINT", SIGINT
);
3931 handle_signal ("SIGQUIT", SIGQUIT
);
3934 handle_signal ("SIGILL", SIGILL
);
3937 handle_signal ("SIGABRT", SIGABRT
);
3940 handle_signal ("SIGEMT", SIGEMT
);
3943 handle_signal ("SIGKILL", SIGKILL
);
3946 handle_signal ("SIGFPE", SIGFPE
);
3949 handle_signal ("SIGBUS", SIGBUS
);
3952 handle_signal ("SIGSEGV", SIGSEGV
);
3955 handle_signal ("SIGSYS", SIGSYS
);
3958 handle_signal ("SIGPIPE", SIGPIPE
);
3961 handle_signal ("SIGALRM", SIGALRM
);
3964 handle_signal ("SIGTERM", SIGTERM
);
3967 handle_signal ("SIGURG", SIGURG
);
3970 handle_signal ("SIGSTOP", SIGSTOP
);
3973 handle_signal ("SIGTSTP", SIGTSTP
);
3976 handle_signal ("SIGCONT", SIGCONT
);
3979 handle_signal ("SIGCHLD", SIGCHLD
);
3982 handle_signal ("SIGTTIN", SIGTTIN
);
3985 handle_signal ("SIGTTOU", SIGTTOU
);
3988 handle_signal ("SIGIO", SIGIO
);
3991 handle_signal ("SIGXCPU", SIGXCPU
);
3994 handle_signal ("SIGXFSZ", SIGXFSZ
);
3997 handle_signal ("SIGVTALRM", SIGVTALRM
);
4000 handle_signal ("SIGPROF", SIGPROF
);
4003 handle_signal ("SIGWINCH", SIGWINCH
);
4006 handle_signal ("SIGINFO", SIGINFO
);
4009 handle_signal ("SIGUSR1", SIGUSR1
);
4012 handle_signal ("SIGUSR2", SIGUSR2
);
4015 error ("Undefined signal name %s", name
);
4018 #undef handle_signal
4020 return make_number (kill (XINT (pid
), XINT (sigcode
)));
4023 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
4024 doc
: /* Make PROCESS see end-of-file in its input.
4025 EOF comes after any text already sent to it.
4026 PROCESS may be a process, a buffer, the name of a process or buffer, or
4027 nil, indicating the current buffer's process.
4028 If PROCESS is a network connection, or is a process communicating
4029 through a pipe (as opposed to a pty), then you cannot send any more
4030 text to PROCESS after you call this function. */)
4032 Lisp_Object process
;
4035 struct coding_system
*coding
;
4037 proc
= get_process (process
);
4038 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
4040 /* Make sure the process is really alive. */
4041 if (! NILP (XPROCESS (proc
)->raw_status_low
))
4042 update_status (XPROCESS (proc
));
4043 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
4044 error ("Process %s not running", XSTRING (XPROCESS (proc
)->name
)->data
);
4046 if (CODING_REQUIRE_FLUSHING (coding
))
4048 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4049 send_process (proc
, "", 0, Qnil
);
4053 send_process (proc
, "\032", 1, Qnil
); /* ^z */
4055 if (!NILP (XPROCESS (proc
)->pty_flag
))
4056 send_process (proc
, "\004", 1, Qnil
);
4059 int old_outfd
, new_outfd
;
4061 #ifdef HAVE_SHUTDOWN
4062 /* If this is a network connection, or socketpair is used
4063 for communication with the subprocess, call shutdown to cause EOF.
4064 (In some old system, shutdown to socketpair doesn't work.
4065 Then we just can't win.) */
4066 if (NILP (XPROCESS (proc
)->pid
)
4067 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
4068 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
4069 /* In case of socketpair, outfd == infd, so don't close it. */
4070 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
4071 emacs_close (XINT (XPROCESS (proc
)->outfd
));
4072 #else /* not HAVE_SHUTDOWN */
4073 emacs_close (XINT (XPROCESS (proc
)->outfd
));
4074 #endif /* not HAVE_SHUTDOWN */
4075 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
4076 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
4078 if (!proc_encode_coding_system
[new_outfd
])
4079 proc_encode_coding_system
[new_outfd
]
4080 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
4081 bcopy (proc_encode_coding_system
[old_outfd
],
4082 proc_encode_coding_system
[new_outfd
],
4083 sizeof (struct coding_system
));
4084 bzero (proc_encode_coding_system
[old_outfd
],
4085 sizeof (struct coding_system
));
4087 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
4093 /* Kill all processes associated with `buffer'.
4094 If `buffer' is nil, kill all processes */
4097 kill_buffer_processes (buffer
)
4100 Lisp_Object tail
, proc
;
4102 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
4104 proc
= XCDR (XCAR (tail
));
4105 if (GC_PROCESSP (proc
)
4106 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
4108 if (NETCONN_P (proc
))
4109 Fdelete_process (proc
);
4110 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
4111 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
4116 /* On receipt of a signal that a child status has changed, loop asking
4117 about children with changed statuses until the system says there
4120 All we do is change the status; we do not run sentinels or print
4121 notifications. That is saved for the next time keyboard input is
4122 done, in order to avoid timing errors.
4124 ** WARNING: this can be called during garbage collection.
4125 Therefore, it must not be fooled by the presence of mark bits in
4128 ** USG WARNING: Although it is not obvious from the documentation
4129 in signal(2), on a USG system the SIGCLD handler MUST NOT call
4130 signal() before executing at least one wait(), otherwise the
4131 handler will be called again, resulting in an infinite loop. The
4132 relevant portion of the documentation reads "SIGCLD signals will be
4133 queued and the signal-catching function will be continually
4134 reentered until the queue is empty". Invoking signal() causes the
4135 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
4139 sigchld_handler (signo
)
4142 int old_errno
= errno
;
4144 register struct Lisp_Process
*p
;
4145 extern EMACS_TIME
*input_available_clear_time
;
4149 sigheld
|= sigbit (SIGCHLD
);
4161 #endif /* no WUNTRACED */
4162 /* Keep trying to get a status until we get a definitive result. */
4166 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
4168 while (pid
< 0 && errno
== EINTR
);
4172 /* PID == 0 means no processes found, PID == -1 means a real
4173 failure. We have done all our job, so return. */
4175 /* USG systems forget handlers when they are used;
4176 must reestablish each time */
4177 #if defined (USG) && !defined (POSIX_SIGNALS)
4178 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
4181 sigheld
&= ~sigbit (SIGCHLD
);
4189 #endif /* no WNOHANG */
4191 /* Find the process that signaled us, and record its status. */
4194 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
4196 proc
= XCDR (XCAR (tail
));
4197 p
= XPROCESS (proc
);
4198 if (GC_EQ (p
->childp
, Qt
) && XINT (p
->pid
) == pid
)
4203 /* Look for an asynchronous process whose pid hasn't been filled
4206 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
4208 proc
= XCDR (XCAR (tail
));
4209 p
= XPROCESS (proc
);
4210 if (GC_INTEGERP (p
->pid
) && XINT (p
->pid
) == -1)
4215 /* Change the status of the process that was found. */
4218 union { int i
; WAITTYPE wt
; } u
;
4219 int clear_desc_flag
= 0;
4221 XSETINT (p
->tick
, ++process_tick
);
4223 XSETINT (p
->raw_status_low
, u
.i
& 0xffff);
4224 XSETINT (p
->raw_status_high
, u
.i
>> 16);
4226 /* If process has terminated, stop waiting for its output. */
4227 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
4228 && XINT (p
->infd
) >= 0)
4229 clear_desc_flag
= 1;
4231 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
4232 if (clear_desc_flag
)
4234 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
4235 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
4238 /* Tell wait_reading_process_input that it needs to wake up and
4240 if (input_available_clear_time
)
4241 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
4244 /* There was no asynchronous process found for that id. Check
4245 if we have a synchronous process. */
4248 synch_process_alive
= 0;
4250 /* Report the status of the synchronous process. */
4252 synch_process_retcode
= WRETCODE (w
);
4253 else if (WIFSIGNALED (w
))
4255 int code
= WTERMSIG (w
);
4258 synchronize_system_messages_locale ();
4259 signame
= strsignal (code
);
4262 signame
= "unknown";
4264 synch_process_death
= signame
;
4267 /* Tell wait_reading_process_input that it needs to wake up and
4269 if (input_available_clear_time
)
4270 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
4273 /* On some systems, we must return right away.
4274 If any more processes want to signal us, we will
4276 Otherwise (on systems that have WNOHANG), loop around
4277 to use up all the processes that have something to tell us. */
4278 #if (defined WINDOWSNT \
4279 || (defined USG && !defined GNU_LINUX \
4280 && !(defined HPUX && defined WNOHANG)))
4281 #if defined (USG) && ! defined (POSIX_SIGNALS)
4282 signal (signo
, sigchld_handler
);
4286 #endif /* USG, but not HPUX with WNOHANG */
4292 exec_sentinel_unwind (data
)
4295 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
4300 exec_sentinel_error_handler (error
)
4303 cmd_error_internal (error
, "error in process sentinel: ");
4305 update_echo_area ();
4306 Fsleep_for (make_number (2), Qnil
);
4311 exec_sentinel (proc
, reason
)
4312 Lisp_Object proc
, reason
;
4314 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
4315 register struct Lisp_Process
*p
= XPROCESS (proc
);
4316 int count
= specpdl_ptr
- specpdl
;
4317 int outer_running_asynch_code
= running_asynch_code
;
4318 int waiting
= waiting_for_user_input_p
;
4320 /* No need to gcpro these, because all we do with them later
4321 is test them for EQness, and none of them should be a string. */
4322 odeactivate
= Vdeactivate_mark
;
4323 XSETBUFFER (obuffer
, current_buffer
);
4324 okeymap
= current_buffer
->keymap
;
4326 sentinel
= p
->sentinel
;
4327 if (NILP (sentinel
))
4330 /* Zilch the sentinel while it's running, to avoid recursive invocations;
4331 assure that it gets restored no matter how the sentinel exits. */
4333 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
4334 /* Inhibit quit so that random quits don't screw up a running filter. */
4335 specbind (Qinhibit_quit
, Qt
);
4336 specbind (Qlast_nonmenu_event
, Qt
);
4338 /* In case we get recursively called,
4339 and we already saved the match data nonrecursively,
4340 save the same match data in safely recursive fashion. */
4341 if (outer_running_asynch_code
)
4344 tem
= Fmatch_data (Qnil
, Qnil
);
4345 restore_match_data ();
4346 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
4347 Fset_match_data (tem
);
4350 /* For speed, if a search happens within this code,
4351 save the match data in a special nonrecursive fashion. */
4352 running_asynch_code
= 1;
4354 internal_condition_case_1 (read_process_output_call
,
4356 Fcons (proc
, Fcons (reason
, Qnil
))),
4357 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
4358 exec_sentinel_error_handler
);
4360 /* If we saved the match data nonrecursively, restore it now. */
4361 restore_match_data ();
4362 running_asynch_code
= outer_running_asynch_code
;
4364 Vdeactivate_mark
= odeactivate
;
4366 /* Restore waiting_for_user_input_p as it was
4367 when we were called, in case the filter clobbered it. */
4368 waiting_for_user_input_p
= waiting
;
4371 if (! EQ (Fcurrent_buffer (), obuffer
)
4372 || ! EQ (current_buffer
->keymap
, okeymap
))
4374 /* But do it only if the caller is actually going to read events.
4375 Otherwise there's no need to make him wake up, and it could
4376 cause trouble (for example it would make Fsit_for return). */
4377 if (waiting_for_user_input_p
== -1)
4378 record_asynch_buffer_change ();
4380 unbind_to (count
, Qnil
);
4383 /* Report all recent events of a change in process status
4384 (either run the sentinel or output a message).
4385 This is done while Emacs is waiting for keyboard input. */
4390 register Lisp_Object proc
, buffer
;
4391 Lisp_Object tail
, msg
;
4392 struct gcpro gcpro1
, gcpro2
;
4396 /* We need to gcpro tail; if read_process_output calls a filter
4397 which deletes a process and removes the cons to which tail points
4398 from Vprocess_alist, and then causes a GC, tail is an unprotected
4402 /* Set this now, so that if new processes are created by sentinels
4403 that we run, we get called again to handle their status changes. */
4404 update_tick
= process_tick
;
4406 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
4409 register struct Lisp_Process
*p
;
4411 proc
= Fcdr (Fcar (tail
));
4412 p
= XPROCESS (proc
);
4414 if (XINT (p
->tick
) != XINT (p
->update_tick
))
4416 XSETINT (p
->update_tick
, XINT (p
->tick
));
4418 /* If process is still active, read any output that remains. */
4419 while (! EQ (p
->filter
, Qt
)
4420 && XINT (p
->infd
) >= 0
4421 && read_process_output (proc
, XINT (p
->infd
)) > 0);
4425 /* Get the text to use for the message. */
4426 if (!NILP (p
->raw_status_low
))
4428 msg
= status_message (p
->status
);
4430 /* If process is terminated, deactivate it or delete it. */
4432 if (CONSP (p
->status
))
4433 symbol
= XCAR (p
->status
);
4435 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
4436 || EQ (symbol
, Qclosed
))
4438 if (delete_exited_processes
)
4439 remove_process (proc
);
4441 deactivate_process (proc
);
4444 /* The actions above may have further incremented p->tick.
4445 So set p->update_tick again
4446 so that an error in the sentinel will not cause
4447 this code to be run again. */
4448 XSETINT (p
->update_tick
, XINT (p
->tick
));
4449 /* Now output the message suitably. */
4450 if (!NILP (p
->sentinel
))
4451 exec_sentinel (proc
, msg
);
4452 /* Don't bother with a message in the buffer
4453 when a process becomes runnable. */
4454 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
4456 Lisp_Object ro
, tem
;
4457 struct buffer
*old
= current_buffer
;
4458 int opoint
, opoint_byte
;
4459 int before
, before_byte
;
4461 ro
= XBUFFER (buffer
)->read_only
;
4463 /* Avoid error if buffer is deleted
4464 (probably that's why the process is dead, too) */
4465 if (NILP (XBUFFER (buffer
)->name
))
4467 Fset_buffer (buffer
);
4470 opoint_byte
= PT_BYTE
;
4471 /* Insert new output into buffer
4472 at the current end-of-output marker,
4473 thus preserving logical ordering of input and output. */
4474 if (XMARKER (p
->mark
)->buffer
)
4475 Fgoto_char (p
->mark
);
4477 SET_PT_BOTH (ZV
, ZV_BYTE
);
4480 before_byte
= PT_BYTE
;
4482 tem
= current_buffer
->read_only
;
4483 current_buffer
->read_only
= Qnil
;
4484 insert_string ("\nProcess ");
4485 Finsert (1, &p
->name
);
4486 insert_string (" ");
4488 current_buffer
->read_only
= tem
;
4489 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
4491 if (opoint
>= before
)
4492 SET_PT_BOTH (opoint
+ (PT
- before
),
4493 opoint_byte
+ (PT_BYTE
- before_byte
));
4495 SET_PT_BOTH (opoint
, opoint_byte
);
4497 set_buffer_internal (old
);
4502 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
4503 redisplay_preserve_echo_area (13);
4509 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
4510 Sset_process_coding_system
, 1, 3, 0,
4511 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
4512 DECODING will be used to decode subprocess output and ENCODING to
4513 encode subprocess input. */)
4514 (proc
, decoding
, encoding
)
4515 register Lisp_Object proc
, decoding
, encoding
;
4517 register struct Lisp_Process
*p
;
4519 CHECK_PROCESS (proc
);
4520 p
= XPROCESS (proc
);
4521 if (XINT (p
->infd
) < 0)
4522 error ("Input file descriptor of %s closed", XSTRING (p
->name
)->data
);
4523 if (XINT (p
->outfd
) < 0)
4524 error ("Output file descriptor of %s closed", XSTRING (p
->name
)->data
);
4526 p
->decode_coding_system
= Fcheck_coding_system (decoding
);
4527 p
->encode_coding_system
= Fcheck_coding_system (encoding
);
4528 setup_coding_system (decoding
,
4529 proc_decode_coding_system
[XINT (p
->infd
)]);
4530 setup_coding_system (encoding
,
4531 proc_encode_coding_system
[XINT (p
->outfd
)]);
4536 DEFUN ("process-coding-system",
4537 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
4538 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
4540 register Lisp_Object proc
;
4542 CHECK_PROCESS (proc
);
4543 return Fcons (XPROCESS (proc
)->decode_coding_system
,
4544 XPROCESS (proc
)->encode_coding_system
);
4547 /* The first time this is called, assume keyboard input comes from DESC
4548 instead of from where we used to expect it.
4549 Subsequent calls mean assume input keyboard can come from DESC
4550 in addition to other places. */
4552 static int add_keyboard_wait_descriptor_called_flag
;
4555 add_keyboard_wait_descriptor (desc
)
4558 if (! add_keyboard_wait_descriptor_called_flag
)
4559 FD_CLR (0, &input_wait_mask
);
4560 add_keyboard_wait_descriptor_called_flag
= 1;
4561 FD_SET (desc
, &input_wait_mask
);
4562 FD_SET (desc
, &non_process_wait_mask
);
4563 if (desc
> max_keyboard_desc
)
4564 max_keyboard_desc
= desc
;
4567 /* From now on, do not expect DESC to give keyboard input. */
4570 delete_keyboard_wait_descriptor (desc
)
4574 int lim
= max_keyboard_desc
;
4576 FD_CLR (desc
, &input_wait_mask
);
4577 FD_CLR (desc
, &non_process_wait_mask
);
4579 if (desc
== max_keyboard_desc
)
4580 for (fd
= 0; fd
< lim
; fd
++)
4581 if (FD_ISSET (fd
, &input_wait_mask
)
4582 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
4583 max_keyboard_desc
= fd
;
4586 /* Return nonzero if *MASK has a bit set
4587 that corresponds to one of the keyboard input descriptors. */
4590 keyboard_bit_set (mask
)
4595 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
4596 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
4597 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
4610 if (! noninteractive
|| initialized
)
4612 signal (SIGCHLD
, sigchld_handler
);
4615 FD_ZERO (&input_wait_mask
);
4616 FD_ZERO (&non_keyboard_wait_mask
);
4617 FD_ZERO (&non_process_wait_mask
);
4618 max_process_desc
= 0;
4620 FD_SET (0, &input_wait_mask
);
4622 Vprocess_alist
= Qnil
;
4623 for (i
= 0; i
< MAXDESC
; i
++)
4625 chan_process
[i
] = Qnil
;
4626 proc_buffered_char
[i
] = -1;
4628 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
4629 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
4635 Qprocessp
= intern ("processp");
4636 staticpro (&Qprocessp
);
4637 Qrun
= intern ("run");
4639 Qstop
= intern ("stop");
4641 Qsignal
= intern ("signal");
4642 staticpro (&Qsignal
);
4644 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
4647 Qexit = intern ("exit");
4648 staticpro (&Qexit); */
4650 Qopen
= intern ("open");
4652 Qclosed
= intern ("closed");
4653 staticpro (&Qclosed
);
4655 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
4656 staticpro (&Qlast_nonmenu_event
);
4658 staticpro (&Vprocess_alist
);
4660 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
4661 doc
: /* *Non-nil means delete processes immediately when they exit.
4662 nil means don't delete them until `list-processes' is run. */);
4664 delete_exited_processes
= 1;
4666 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
4667 doc
: /* Control type of device used to communicate with subprocesses.
4668 Values are nil to use a pipe, or t or `pty' to use a pty.
4669 The value has no effect if the system has no ptys or if all ptys are busy:
4670 then a pipe is used in any case.
4671 The value takes effect when `start-process' is called. */);
4672 Vprocess_connection_type
= Qt
;
4674 defsubr (&Sprocessp
);
4675 defsubr (&Sget_process
);
4676 defsubr (&Sget_buffer_process
);
4677 defsubr (&Sdelete_process
);
4678 defsubr (&Sprocess_status
);
4679 defsubr (&Sprocess_exit_status
);
4680 defsubr (&Sprocess_id
);
4681 defsubr (&Sprocess_name
);
4682 defsubr (&Sprocess_tty_name
);
4683 defsubr (&Sprocess_command
);
4684 defsubr (&Sset_process_buffer
);
4685 defsubr (&Sprocess_buffer
);
4686 defsubr (&Sprocess_mark
);
4687 defsubr (&Sset_process_filter
);
4688 defsubr (&Sprocess_filter
);
4689 defsubr (&Sset_process_sentinel
);
4690 defsubr (&Sprocess_sentinel
);
4691 defsubr (&Sset_process_window_size
);
4692 defsubr (&Sset_process_inherit_coding_system_flag
);
4693 defsubr (&Sprocess_inherit_coding_system_flag
);
4694 defsubr (&Sprocess_kill_without_query
);
4695 defsubr (&Sprocess_contact
);
4696 defsubr (&Slist_processes
);
4697 defsubr (&Sprocess_list
);
4698 defsubr (&Sstart_process
);
4700 defsubr (&Sopen_network_stream
);
4701 #endif /* HAVE_SOCKETS */
4702 defsubr (&Saccept_process_output
);
4703 defsubr (&Sprocess_send_region
);
4704 defsubr (&Sprocess_send_string
);
4705 defsubr (&Sinterrupt_process
);
4706 defsubr (&Skill_process
);
4707 defsubr (&Squit_process
);
4708 defsubr (&Sstop_process
);
4709 defsubr (&Scontinue_process
);
4710 defsubr (&Sprocess_running_child_p
);
4711 defsubr (&Sprocess_send_eof
);
4712 defsubr (&Ssignal_process
);
4713 defsubr (&Swaiting_for_user_input_p
);
4714 /* defsubr (&Sprocess_connection); */
4715 defsubr (&Sset_process_coding_system
);
4716 defsubr (&Sprocess_coding_system
);
4720 #else /* not subprocesses */
4722 #include <sys/types.h>
4726 #include "systime.h"
4727 #include "character.h"
4729 #include "termopts.h"
4730 #include "sysselect.h"
4732 extern int frame_garbaged
;
4734 extern EMACS_TIME
timer_check ();
4735 extern int timers_run
;
4737 /* As described above, except assuming that there are no subprocesses:
4739 Wait for timeout to elapse and/or keyboard input to be available.
4742 timeout in seconds, or
4743 zero for no limit, or
4744 -1 means gobble data immediately available but don't wait for any.
4746 read_kbd is a Lisp_Object:
4747 0 to ignore keyboard input, or
4748 1 to return when input is available, or
4749 -1 means caller will actually read the input, so don't throw to
4751 a cons cell, meaning wait until its car is non-nil
4752 (and gobble terminal input into the buffer if any arrives), or
4753 We know that read_kbd will never be a Lisp_Process, since
4754 `subprocesses' isn't defined.
4756 do_display != 0 means redisplay should be done to show subprocess
4757 output that arrives.
4759 Return true iff we received input from any process. */
4762 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
4763 int time_limit
, microsecs
;
4764 Lisp_Object read_kbd
;
4768 EMACS_TIME end_time
, timeout
;
4769 SELECT_TYPE waitchannels
;
4771 /* Either nil or a cons cell, the car of which is of interest and
4772 may be changed outside of this routine. */
4773 Lisp_Object wait_for_cell
= Qnil
;
4775 /* If waiting for non-nil in a cell, record where. */
4776 if (CONSP (read_kbd
))
4778 wait_for_cell
= read_kbd
;
4779 XSETFASTINT (read_kbd
, 0);
4782 /* What does time_limit really mean? */
4783 if (time_limit
|| microsecs
)
4785 EMACS_GET_TIME (end_time
);
4786 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4787 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4790 /* Turn off periodic alarms (in case they are in use)
4791 because the select emulator uses alarms. */
4792 turn_on_atimers (0);
4796 int timeout_reduced_for_timers
= 0;
4798 /* If calling from keyboard input, do not quit
4799 since we want to return C-g as an input character.
4800 Otherwise, do pending quit if requested. */
4801 if (XINT (read_kbd
) >= 0)
4804 /* Exit now if the cell we're waiting for became non-nil. */
4805 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4808 /* Compute time from now till when time limit is up */
4809 /* Exit if already run out */
4810 if (time_limit
== -1)
4812 /* -1 specified for timeout means
4813 gobble output available now
4814 but don't wait at all. */
4816 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4818 else if (time_limit
|| microsecs
)
4820 EMACS_GET_TIME (timeout
);
4821 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4822 if (EMACS_TIME_NEG_P (timeout
))
4827 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4830 /* If our caller will not immediately handle keyboard events,
4831 run timer events directly.
4832 (Callers that will immediately read keyboard events
4833 call timer_delay on their own.) */
4834 if (NILP (wait_for_cell
))
4836 EMACS_TIME timer_delay
;
4840 int old_timers_run
= timers_run
;
4841 timer_delay
= timer_check (1);
4842 if (timers_run
!= old_timers_run
&& do_display
)
4843 /* We must retry, since a timer may have requeued itself
4844 and that could alter the time delay. */
4845 redisplay_preserve_echo_area (14);
4849 while (!detect_input_pending ());
4851 /* If there is unread keyboard input, also return. */
4852 if (XINT (read_kbd
) != 0
4853 && requeued_events_pending_p ())
4856 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4858 EMACS_TIME difference
;
4859 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4860 if (EMACS_TIME_NEG_P (difference
))
4862 timeout
= timer_delay
;
4863 timeout_reduced_for_timers
= 1;
4868 /* Cause C-g and alarm signals to take immediate action,
4869 and cause input available signals to zero out timeout. */
4870 if (XINT (read_kbd
) < 0)
4871 set_waiting_for_input (&timeout
);
4873 /* Wait till there is something to do. */
4875 if (! XINT (read_kbd
) && NILP (wait_for_cell
))
4876 FD_ZERO (&waitchannels
);
4878 FD_SET (0, &waitchannels
);
4880 /* If a frame has been newly mapped and needs updating,
4881 reprocess its display stuff. */
4882 if (frame_garbaged
&& do_display
)
4884 clear_waiting_for_input ();
4885 redisplay_preserve_echo_area (15);
4886 if (XINT (read_kbd
) < 0)
4887 set_waiting_for_input (&timeout
);
4890 if (XINT (read_kbd
) && detect_input_pending ())
4893 FD_ZERO (&waitchannels
);
4896 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
4901 /* Make C-g and alarm signals set flags again */
4902 clear_waiting_for_input ();
4904 /* If we woke up due to SIGWINCH, actually change size now. */
4905 do_pending_window_change (0);
4907 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4908 /* We waited the full specified time, so return now. */
4913 /* If the system call was interrupted, then go around the
4915 if (xerrno
== EINTR
)
4916 FD_ZERO (&waitchannels
);
4918 error ("select error: %s", emacs_strerror (xerrno
));
4921 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
4922 /* System sometimes fails to deliver SIGIO. */
4923 kill (getpid (), SIGIO
);
4926 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
4927 kill (getpid (), SIGIO
);
4930 /* Check for keyboard input */
4932 if ((XINT (read_kbd
) != 0)
4933 && detect_input_pending_run_timers (do_display
))
4935 swallow_events (do_display
);
4936 if (detect_input_pending_run_timers (do_display
))
4940 /* If there is unread keyboard input, also return. */
4941 if (XINT (read_kbd
) != 0
4942 && requeued_events_pending_p ())
4945 /* If wait_for_cell. check for keyboard input
4946 but don't run any timers.
4947 ??? (It seems wrong to me to check for keyboard
4948 input at all when wait_for_cell, but the code
4949 has been this way since July 1994.
4950 Try changing this after version 19.31.) */
4951 if (! NILP (wait_for_cell
)
4952 && detect_input_pending ())
4954 swallow_events (do_display
);
4955 if (detect_input_pending ())
4959 /* Exit now if the cell we're waiting for became non-nil. */
4960 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4970 /* Don't confuse make-docfile by having two doc strings for this function.
4971 make-docfile does not pay attention to #if, for good reason! */
4972 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
4975 register Lisp_Object name
;
4980 /* Don't confuse make-docfile by having two doc strings for this function.
4981 make-docfile does not pay attention to #if, for good reason! */
4982 DEFUN ("process-inherit-coding-system-flag",
4983 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
4987 register Lisp_Object process
;
4989 /* Ignore the argument and return the value of
4990 inherit-process-coding-system. */
4991 return inherit_process_coding_system
? Qt
: Qnil
;
4994 /* Kill all processes associated with `buffer'.
4995 If `buffer' is nil, kill all processes.
4996 Since we have no subprocesses, this does nothing. */
4999 kill_buffer_processes (buffer
)
5012 defsubr (&Sget_buffer_process
);
5013 defsubr (&Sprocess_inherit_coding_system_flag
);
5017 #endif /* not subprocesses */