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" */
104 #include "termhooks.h"
105 #include "termopts.h"
106 #include "commands.h"
107 #include "keyboard.h"
109 #include "blockinput.h"
110 #include "dispextern.h"
111 #include "composite.h"
114 #define max(a, b) ((a) > (b) ? (a) : (b))
116 Lisp_Object Qprocessp
;
117 Lisp_Object Qrun
, Qstop
, Qsignal
, Qopen
, Qclosed
;
118 Lisp_Object Qlast_nonmenu_event
;
119 /* Qexit is declared and initialized in eval.c. */
121 /* a process object is a network connection when its childp field is neither
122 Qt nor Qnil but is instead a cons cell (HOSTNAME PORTNUM). */
125 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
127 #define NETCONN_P(p) 0
128 #endif /* HAVE_SOCKETS */
130 /* Define first descriptor number available for subprocesses. */
132 #define FIRST_PROC_DESC 1
134 #define FIRST_PROC_DESC 3
137 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
140 #if !defined (SIGCHLD) && defined (SIGCLD)
141 #define SIGCHLD SIGCLD
144 #include "syssignal.h"
148 extern void set_waiting_for_input
P_ ((EMACS_TIME
*));
154 extern char *sys_errlist
[];
161 /* t means use pty, nil means use a pipe,
162 maybe other values to come. */
163 static Lisp_Object Vprocess_connection_type
;
167 #include <sys/socket.h>
171 /* These next two vars are non-static since sysdep.c uses them in the
172 emulation of `select'. */
173 /* Number of events of change of status of a process. */
175 /* Number of events for which the user or sentinel has been notified. */
178 #include "sysselect.h"
180 extern int keyboard_bit_set
P_ ((SELECT_TYPE
*));
182 /* If we support a window system, turn on the code to poll periodically
183 to detect C-g. It isn't actually used when doing interrupt input. */
184 #ifdef HAVE_WINDOW_SYSTEM
185 #define POLL_FOR_INPUT
188 /* Mask of bits indicating the descriptors that we wait for input on. */
190 static SELECT_TYPE input_wait_mask
;
192 /* Mask that excludes keyboard input descriptor (s). */
194 static SELECT_TYPE non_keyboard_wait_mask
;
196 /* Mask that excludes process input descriptor (s). */
198 static SELECT_TYPE non_process_wait_mask
;
200 /* The largest descriptor currently in use for a process object. */
201 static int max_process_desc
;
203 /* The largest descriptor currently in use for keyboard input. */
204 static int max_keyboard_desc
;
206 /* Nonzero means delete a process right away if it exits. */
207 static int delete_exited_processes
;
209 /* Indexed by descriptor, gives the process (if any) for that descriptor */
210 Lisp_Object chan_process
[MAXDESC
];
212 /* Alist of elements (NAME . PROCESS) */
213 Lisp_Object Vprocess_alist
;
215 /* Buffered-ahead input char from process, indexed by channel.
216 -1 means empty (no char is buffered).
217 Used on sys V where the only way to tell if there is any
218 output from the process is to read at least one char.
219 Always -1 on systems that support FIONREAD. */
221 /* Don't make static; need to access externally. */
222 int proc_buffered_char
[MAXDESC
];
224 /* Table of `struct coding-system' for each process. */
225 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
226 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
228 static Lisp_Object
get_process ();
230 extern EMACS_TIME
timer_check ();
231 extern int timers_run
;
233 /* Maximum number of bytes to send to a pty without an eof. */
234 static int pty_max_bytes
;
236 extern Lisp_Object Vfile_name_coding_system
, Vdefault_file_name_coding_system
;
239 /* The file name of the pty opened by allocate_pty. */
241 static char pty_name
[24];
244 /* Compute the Lisp form of the process status, p->status, from
245 the numeric status that was returned by `wait'. */
247 Lisp_Object
status_convert ();
251 struct Lisp_Process
*p
;
253 union { int i
; WAITTYPE wt
; } u
;
254 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
255 p
->status
= status_convert (u
.wt
);
256 p
->raw_status_low
= Qnil
;
257 p
->raw_status_high
= Qnil
;
260 /* Convert a process status word in Unix format to
261 the list that we use internally. */
268 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
269 else if (WIFEXITED (w
))
270 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
271 WCOREDUMP (w
) ? Qt
: Qnil
));
272 else if (WIFSIGNALED (w
))
273 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
274 WCOREDUMP (w
) ? Qt
: Qnil
));
279 /* Given a status-list, extract the three pieces of information
280 and store them individually through the three pointers. */
283 decode_status (l
, symbol
, code
, coredump
)
301 *code
= XFASTINT (XCAR (tem
));
303 *coredump
= !NILP (tem
);
307 /* Return a string describing a process status list. */
310 status_message (status
)
315 Lisp_Object string
, string2
;
317 decode_status (status
, &symbol
, &code
, &coredump
);
319 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
322 synchronize_system_messages_locale ();
323 signame
= strsignal (code
);
326 string
= build_string (signame
);
327 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
328 XSTRING (string
)->data
[0] = DOWNCASE (XSTRING (string
)->data
[0]);
329 return concat2 (string
, string2
);
331 else if (EQ (symbol
, Qexit
))
334 return build_string ("finished\n");
335 string
= Fnumber_to_string (make_number (code
));
336 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
337 return concat2 (build_string ("exited abnormally with code "),
338 concat2 (string
, string2
));
341 return Fcopy_sequence (Fsymbol_name (symbol
));
346 /* Open an available pty, returning a file descriptor.
347 Return -1 on failure.
348 The file name of the terminal corresponding to the pty
349 is left in the variable pty_name. */
358 /* Some systems name their pseudoterminals so that there are gaps in
359 the usual sequence - for example, on HP9000/S700 systems, there
360 are no pseudoterminals with names ending in 'f'. So we wait for
361 three failures in a row before deciding that we've reached the
363 int failed_count
= 0;
368 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
369 for (i
= 0; i
< 16; i
++)
372 #ifdef PTY_NAME_SPRINTF
375 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
376 #endif /* no PTY_NAME_SPRINTF */
380 #else /* no PTY_OPEN */
382 /* Unusual IRIS code */
383 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
386 if (fstat (fd
, &stb
) < 0)
389 if (stat (pty_name
, &stb
) < 0)
392 if (failed_count
>= 3)
398 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
400 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
402 #endif /* not IRIS */
403 #endif /* no PTY_OPEN */
407 /* check to make certain that both sides are available
408 this avoids a nasty yet stupid bug in rlogins */
409 #ifdef PTY_TTY_NAME_SPRINTF
412 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
413 #endif /* no PTY_TTY_NAME_SPRINTF */
415 if (access (pty_name
, 6) != 0)
418 #if !defined(IRIS) && !defined(__sgi)
424 #endif /* not UNIPLUS */
431 #endif /* HAVE_PTYS */
437 register Lisp_Object val
, tem
, name1
;
438 register struct Lisp_Process
*p
;
442 p
= allocate_process ();
444 XSETINT (p
->infd
, -1);
445 XSETINT (p
->outfd
, -1);
446 XSETFASTINT (p
->pid
, 0);
447 XSETFASTINT (p
->tick
, 0);
448 XSETFASTINT (p
->update_tick
, 0);
449 p
->raw_status_low
= Qnil
;
450 p
->raw_status_high
= Qnil
;
452 p
->mark
= Fmake_marker ();
454 /* If name is already in use, modify it until it is unused. */
459 tem
= Fget_process (name1
);
460 if (NILP (tem
)) break;
461 sprintf (suffix
, "<%d>", i
);
462 name1
= concat2 (name
, build_string (suffix
));
466 XSETPROCESS (val
, p
);
467 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
472 remove_process (proc
)
473 register Lisp_Object proc
;
475 register Lisp_Object pair
;
477 pair
= Frassq (proc
, Vprocess_alist
);
478 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
480 deactivate_process (proc
);
483 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
484 "Return t if OBJECT is a process.")
488 return PROCESSP (object
) ? Qt
: Qnil
;
491 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
492 "Return the process named NAME, or nil if there is none.")
494 register Lisp_Object name
;
498 CHECK_STRING (name
, 0);
499 return Fcdr (Fassoc (name
, Vprocess_alist
));
502 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
503 "Return the (or a) process associated with BUFFER.\n\
504 BUFFER may be a buffer or the name of one.")
506 register Lisp_Object buffer
;
508 register Lisp_Object buf
, tail
, proc
;
510 if (NILP (buffer
)) return Qnil
;
511 buf
= Fget_buffer (buffer
);
512 if (NILP (buf
)) return Qnil
;
514 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
516 proc
= Fcdr (Fcar (tail
));
517 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
523 /* This is how commands for the user decode process arguments. It
524 accepts a process, a process name, a buffer, a buffer name, or nil.
525 Buffers denote the first process in the buffer, and nil denotes the
530 register Lisp_Object name
;
532 register Lisp_Object proc
, obj
;
535 obj
= Fget_process (name
);
537 obj
= Fget_buffer (name
);
539 error ("Process %s does not exist", XSTRING (name
)->data
);
541 else if (NILP (name
))
542 obj
= Fcurrent_buffer ();
546 /* Now obj should be either a buffer object or a process object.
550 proc
= Fget_buffer_process (obj
);
552 error ("Buffer %s has no process", XSTRING (XBUFFER (obj
)->name
)->data
);
556 CHECK_PROCESS (obj
, 0);
562 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
563 "Delete PROCESS: kill it and forget about it immediately.\n\
564 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
565 nil, indicating the current buffer's process.")
567 register Lisp_Object process
;
569 process
= get_process (process
);
570 XPROCESS (process
)->raw_status_low
= Qnil
;
571 XPROCESS (process
)->raw_status_high
= Qnil
;
572 if (NETCONN_P (process
))
574 XPROCESS (process
)->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
575 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
577 else if (XINT (XPROCESS (process
)->infd
) >= 0)
579 Fkill_process (process
, Qnil
);
580 /* Do this now, since remove_process will make sigchld_handler do nothing. */
581 XPROCESS (process
)->status
582 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
583 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
586 remove_process (process
);
590 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
591 "Return the status of PROCESS.\n\
592 The returned value is one of the following symbols:\n\
593 run -- for a process that is running.\n\
594 stop -- for a process stopped but continuable.\n\
595 exit -- for a process that has exited.\n\
596 signal -- for a process that has got a fatal signal.\n\
597 open -- for a network stream connection that is open.\n\
598 closed -- for a network stream connection that is closed.\n\
599 nil -- if arg is a process name and no such process exists.\n\
600 PROCESS may be a process, a buffer, the name of a process, or\n\
601 nil, indicating the current buffer's process.")
603 register Lisp_Object process
;
605 register struct Lisp_Process
*p
;
606 register Lisp_Object status
;
608 if (STRINGP (process
))
609 process
= Fget_process (process
);
611 process
= get_process (process
);
616 p
= XPROCESS (process
);
617 if (!NILP (p
->raw_status_low
))
621 status
= XCAR (status
);
622 if (NETCONN_P (process
))
624 if (EQ (status
, Qrun
))
626 else if (EQ (status
, Qexit
))
632 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
634 "Return the exit status of PROCESS or the signal number that killed it.\n\
635 If PROCESS has not yet exited or died, return 0.")
637 register Lisp_Object process
;
639 CHECK_PROCESS (process
, 0);
640 if (!NILP (XPROCESS (process
)->raw_status_low
))
641 update_status (XPROCESS (process
));
642 if (CONSP (XPROCESS (process
)->status
))
643 return XCAR (XCDR (XPROCESS (process
)->status
));
644 return make_number (0);
647 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
648 "Return the process id of PROCESS.\n\
649 This is the pid of the Unix process which PROCESS uses or talks to.\n\
650 For a network connection, this value is nil.")
652 register Lisp_Object process
;
654 CHECK_PROCESS (process
, 0);
655 return XPROCESS (process
)->pid
;
658 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
659 "Return the name of PROCESS, as a string.\n\
660 This is the name of the program invoked in PROCESS,\n\
661 possibly modified to make it unique among process names.")
663 register Lisp_Object process
;
665 CHECK_PROCESS (process
, 0);
666 return XPROCESS (process
)->name
;
669 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
670 "Return the command that was executed to start PROCESS.\n\
671 This is a list of strings, the first string being the program executed\n\
672 and the rest of the strings being the arguments given to it.\n\
673 For a non-child channel, this is nil.")
675 register Lisp_Object process
;
677 CHECK_PROCESS (process
, 0);
678 return XPROCESS (process
)->command
;
681 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
682 "Return the name of the terminal PROCESS uses, or nil if none.\n\
683 This is the terminal that the process itself reads and writes on,\n\
684 not the name of the pty that Emacs uses to talk with that terminal.")
686 register Lisp_Object process
;
688 CHECK_PROCESS (process
, 0);
689 return XPROCESS (process
)->tty_name
;
692 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
694 "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
696 register Lisp_Object process
, buffer
;
698 CHECK_PROCESS (process
, 0);
700 CHECK_BUFFER (buffer
, 1);
701 XPROCESS (process
)->buffer
= buffer
;
705 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
707 "Return the buffer PROCESS is associated with.\n\
708 Output from PROCESS is inserted in this buffer unless PROCESS has a filter.")
710 register Lisp_Object process
;
712 CHECK_PROCESS (process
, 0);
713 return XPROCESS (process
)->buffer
;
716 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
718 "Return the marker for the end of the last output from PROCESS.")
720 register Lisp_Object process
;
722 CHECK_PROCESS (process
, 0);
723 return XPROCESS (process
)->mark
;
726 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
728 "Give PROCESS the filter function FILTER; nil means no filter.\n\
729 t means stop accepting output from the process.\n\
730 When a process has a filter, each time it does output\n\
731 the entire string of output is passed to the filter.\n\
732 The filter gets two arguments: the process and the string of output.\n\
733 If the process has a filter, its buffer is not used for output.")
735 register Lisp_Object process
, filter
;
737 struct Lisp_Process
*p
;
739 CHECK_PROCESS (process
, 0);
740 p
= XPROCESS (process
);
742 /* Don't signal an error if the process' input file descriptor
743 is closed. This could make debugging Lisp more difficult,
744 for example when doing something like
746 (setq process (start-process ...))
748 (set-process-filter process ...) */
750 if (XINT (p
->infd
) >= 0)
754 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
755 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
757 else if (EQ (XPROCESS (process
)->filter
, Qt
))
759 FD_SET (XINT (p
->infd
), &input_wait_mask
);
760 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
768 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
770 "Returns the filter function of PROCESS; nil if none.\n\
771 See `set-process-filter' for more info on filter functions.")
773 register Lisp_Object process
;
775 CHECK_PROCESS (process
, 0);
776 return XPROCESS (process
)->filter
;
779 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
781 "Give PROCESS the sentinel SENTINEL; nil for none.\n\
782 The sentinel is called as a function when the process changes state.\n\
783 It gets two arguments: the process, and a string describing the change.")
785 register Lisp_Object process
, sentinel
;
787 CHECK_PROCESS (process
, 0);
788 XPROCESS (process
)->sentinel
= sentinel
;
792 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
794 "Return the sentinel of PROCESS; nil if none.\n\
795 See `set-process-sentinel' for more info on sentinels.")
797 register Lisp_Object process
;
799 CHECK_PROCESS (process
, 0);
800 return XPROCESS (process
)->sentinel
;
803 DEFUN ("set-process-window-size", Fset_process_window_size
,
804 Sset_process_window_size
, 3, 3, 0,
805 "Tell PROCESS that it has logical window size HEIGHT and WIDTH.")
806 (process
, height
, width
)
807 register Lisp_Object process
, height
, width
;
809 CHECK_PROCESS (process
, 0);
810 CHECK_NATNUM (height
, 0);
811 CHECK_NATNUM (width
, 0);
813 if (XINT (XPROCESS (process
)->infd
) < 0
814 || set_window_size (XINT (XPROCESS (process
)->infd
),
815 XINT (height
), XINT (width
)) <= 0)
821 DEFUN ("set-process-inherit-coding-system-flag",
822 Fset_process_inherit_coding_system_flag
,
823 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
824 "Determine whether buffer of PROCESS will inherit coding-system.\n\
825 If the second argument FLAG is non-nil, then the variable\n\
826 `buffer-file-coding-system' of the buffer associated with PROCESS\n\
827 will be bound to the value of the coding system used to decode\n\
828 the process output.\n\
830 This is useful when the coding system specified for the process buffer\n\
831 leaves either the character code conversion or the end-of-line conversion\n\
832 unspecified, or if the coding system used to decode the process output\n\
833 is more appropriate for saving the process buffer.\n\
835 Binding the variable `inherit-process-coding-system' to non-nil before\n\
836 starting the process is an alternative way of setting the inherit flag\n\
837 for the process which will run.")
839 register Lisp_Object process
, flag
;
841 CHECK_PROCESS (process
, 0);
842 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
846 DEFUN ("process-inherit-coding-system-flag",
847 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
849 "Return the value of inherit-coding-system flag for PROCESS.\n\
850 If this flag is t, `buffer-file-coding-system' of the buffer\n\
851 associated with PROCESS will inherit the coding system used to decode\n\
852 the process output.")
854 register Lisp_Object process
;
856 CHECK_PROCESS (process
, 0);
857 return XPROCESS (process
)->inherit_coding_system_flag
;
860 DEFUN ("process-kill-without-query", Fprocess_kill_without_query
,
861 Sprocess_kill_without_query
, 1, 2, 0,
862 "Say no query needed if PROCESS is running when Emacs is exited.\n\
863 Optional second argument if non-nil says to require a query.\n\
864 Value is t if a query was formerly required.")
866 register Lisp_Object process
, value
;
870 CHECK_PROCESS (process
, 0);
871 tem
= XPROCESS (process
)->kill_without_query
;
872 XPROCESS (process
)->kill_without_query
= Fnull (value
);
877 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
879 "Return the contact info of PROCESS; t for a real child.\n\
880 For a net connection, the value is a cons cell of the form (HOST SERVICE).")
882 register Lisp_Object process
;
884 CHECK_PROCESS (process
, 0);
885 return XPROCESS (process
)->childp
;
888 #if 0 /* Turned off because we don't currently record this info
889 in the process. Perhaps add it. */
890 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
891 "Return the connection type of PROCESS.\n\
892 The value is nil for a pipe, t or `pty' for a pty, or `stream' for\n\
893 a socket connection.")
897 return XPROCESS (process
)->type
;
904 register Lisp_Object tail
, tem
;
905 Lisp_Object proc
, minspace
, tem1
;
906 register struct Lisp_Process
*p
;
909 XSETFASTINT (minspace
, 1);
911 set_buffer_internal (XBUFFER (Vstandard_output
));
912 Fbuffer_disable_undo (Vstandard_output
);
914 current_buffer
->truncate_lines
= Qt
;
917 Proc Status Buffer Tty Command\n\
918 ---- ------ ------ --- -------\n", -1);
920 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
924 proc
= Fcdr (Fcar (tail
));
926 if (NILP (p
->childp
))
929 Finsert (1, &p
->name
);
930 Findent_to (make_number (13), minspace
);
932 if (!NILP (p
->raw_status_low
))
935 if (CONSP (p
->status
))
936 symbol
= XCAR (p
->status
);
939 if (EQ (symbol
, Qsignal
))
942 tem
= Fcar (Fcdr (p
->status
));
944 if (XINT (tem
) < NSIG
)
945 write_string (sys_errlist
[XINT (tem
)], -1);
948 Fprinc (symbol
, Qnil
);
950 else if (NETCONN_P (proc
))
952 if (EQ (symbol
, Qrun
))
953 write_string ("open", -1);
954 else if (EQ (symbol
, Qexit
))
955 write_string ("closed", -1);
957 Fprinc (symbol
, Qnil
);
960 Fprinc (symbol
, Qnil
);
962 if (EQ (symbol
, Qexit
))
965 tem
= Fcar (Fcdr (p
->status
));
968 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
969 write_string (tembuf
, -1);
973 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
974 remove_process (proc
);
976 Findent_to (make_number (22), minspace
);
977 if (NILP (p
->buffer
))
978 insert_string ("(none)");
979 else if (NILP (XBUFFER (p
->buffer
)->name
))
980 insert_string ("(Killed)");
982 Finsert (1, &XBUFFER (p
->buffer
)->name
);
984 Findent_to (make_number (37), minspace
);
986 if (STRINGP (p
->tty_name
))
987 Finsert (1, &p
->tty_name
);
989 insert_string ("(none)");
991 Findent_to (make_number (49), minspace
);
993 if (NETCONN_P (proc
))
995 sprintf (tembuf
, "(network stream connection to %s)\n",
996 XSTRING (XCAR (p
->childp
))->data
);
997 insert_string (tembuf
);
1009 insert_string (" ");
1011 insert_string ("\n");
1017 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 0, "",
1018 "Display a list of all processes.\n\
1019 Any process listed as exited or signaled is actually eliminated\n\
1020 after the listing is made.")
1023 internal_with_output_to_temp_buffer ("*Process List*",
1024 list_processes_1
, Qnil
);
1028 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1029 "Return a list of all processes.")
1032 return Fmapcar (Qcdr
, Vprocess_alist
);
1035 /* Starting asynchronous inferior processes. */
1037 static Lisp_Object
start_process_unwind ();
1039 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1040 "Start a program in a subprocess. Return the process object for it.\n\
1041 NAME is name for process. It is modified if necessary to make it unique.\n\
1042 BUFFER is the buffer or (buffer-name) to associate with the process.\n\
1043 Process output goes at end of that buffer, unless you specify\n\
1044 an output stream or filter function to handle the output.\n\
1045 BUFFER may be also nil, meaning that this process is not associated\n\
1047 Third arg is program file name. It is searched for in PATH.\n\
1048 Remaining arguments are strings to give program as arguments.")
1051 register Lisp_Object
*args
;
1053 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1055 register unsigned char *new_argv
;
1058 register unsigned char **new_argv
;
1061 int count
= specpdl_ptr
- specpdl
;
1065 buffer
= Fget_buffer_create (buffer
);
1067 /* Make sure that the child will be able to chdir to the current
1068 buffer's current directory, or its unhandled equivalent. We
1069 can't just have the child check for an error when it does the
1070 chdir, since it's in a vfork.
1072 We have to GCPRO around this because Fexpand_file_name and
1073 Funhandled_file_name_directory might call a file name handling
1074 function. The argument list is protected by the caller, so all
1075 we really have to worry about is buffer. */
1077 struct gcpro gcpro1
, gcpro2
;
1079 current_dir
= current_buffer
->directory
;
1081 GCPRO2 (buffer
, current_dir
);
1084 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1086 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1087 report_file_error ("Setting current directory",
1088 Fcons (current_buffer
->directory
, Qnil
));
1094 CHECK_STRING (name
, 0);
1098 CHECK_STRING (program
, 2);
1100 proc
= make_process (name
);
1101 /* If an error occurs and we can't start the process, we want to
1102 remove it from the process list. This means that each error
1103 check in create_process doesn't need to call remove_process
1104 itself; it's all taken care of here. */
1105 record_unwind_protect (start_process_unwind
, proc
);
1107 XPROCESS (proc
)->childp
= Qt
;
1108 XPROCESS (proc
)->command_channel_p
= Qnil
;
1109 XPROCESS (proc
)->buffer
= buffer
;
1110 XPROCESS (proc
)->sentinel
= Qnil
;
1111 XPROCESS (proc
)->filter
= Qnil
;
1112 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1114 /* Make the process marker point into the process buffer (if any). */
1116 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1117 BUF_ZV (XBUFFER (buffer
)),
1118 BUF_ZV_BYTE (XBUFFER (buffer
)));
1121 /* Decide coding systems for communicating with the process. Here
1122 we don't setup the structure coding_system nor pay attention to
1123 unibyte mode. They are done in create_process. */
1125 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1126 Lisp_Object coding_systems
= Qt
;
1127 Lisp_Object val
, *args2
;
1128 struct gcpro gcpro1
, gcpro2
;
1130 val
= Vcoding_system_for_read
;
1133 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1134 args2
[0] = Qstart_process
;
1135 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1136 GCPRO2 (proc
, current_dir
);
1137 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1139 if (CONSP (coding_systems
))
1140 val
= XCAR (coding_systems
);
1141 else if (CONSP (Vdefault_process_coding_system
))
1142 val
= XCAR (Vdefault_process_coding_system
);
1144 XPROCESS (proc
)->decode_coding_system
= val
;
1146 val
= Vcoding_system_for_write
;
1149 if (EQ (coding_systems
, Qt
))
1151 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1152 args2
[0] = Qstart_process
;
1153 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1154 GCPRO2 (proc
, current_dir
);
1155 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1158 if (CONSP (coding_systems
))
1159 val
= XCDR (coding_systems
);
1160 else if (CONSP (Vdefault_process_coding_system
))
1161 val
= XCDR (Vdefault_process_coding_system
);
1163 XPROCESS (proc
)->encode_coding_system
= val
;
1167 /* Make a one member argv with all args concatenated
1168 together separated by a blank. */
1169 len
= STRING_BYTES (XSTRING (program
)) + 2;
1170 for (i
= 3; i
< nargs
; i
++)
1173 CHECK_STRING (tem
, i
);
1174 len
+= STRING_BYTES (XSTRING (tem
)) + 1; /* count the blank */
1176 new_argv
= (unsigned char *) alloca (len
);
1177 strcpy (new_argv
, XSTRING (program
)->data
);
1178 for (i
= 3; i
< nargs
; i
++)
1181 CHECK_STRING (tem
, i
);
1182 strcat (new_argv
, " ");
1183 strcat (new_argv
, XSTRING (tem
)->data
);
1185 /* Need to add code here to check for program existence on VMS */
1188 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1190 /* If program file name is not absolute, search our path for it */
1191 if (!IS_DIRECTORY_SEP (XSTRING (program
)->data
[0])
1192 && !(XSTRING (program
)->size
> 1
1193 && IS_DEVICE_SEP (XSTRING (program
)->data
[1])))
1195 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1198 GCPRO4 (name
, program
, buffer
, current_dir
);
1199 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, 1);
1202 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1203 tem
= Fexpand_file_name (tem
, Qnil
);
1204 tem
= ENCODE_FILE (tem
);
1205 new_argv
[0] = XSTRING (tem
)->data
;
1209 if (!NILP (Ffile_directory_p (program
)))
1210 error ("Specified program for new process is a directory");
1212 tem
= ENCODE_FILE (program
);
1213 new_argv
[0] = XSTRING (tem
)->data
;
1216 /* Here we encode arguments by the coding system used for sending
1217 data to the process. We don't support using different coding
1218 systems for encoding arguments and for encoding data sent to the
1221 for (i
= 3; i
< nargs
; i
++)
1224 CHECK_STRING (tem
, i
);
1225 if (STRING_MULTIBYTE (tem
))
1226 tem
= (code_convert_string_norecord
1227 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1228 new_argv
[i
- 2] = XSTRING (tem
)->data
;
1230 new_argv
[i
- 2] = 0;
1231 #endif /* not VMS */
1233 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1234 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1235 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1236 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1238 XPROCESS (proc
)->inherit_coding_system_flag
1239 = (NILP (buffer
) || !inherit_process_coding_system
1242 create_process (proc
, (char **) new_argv
, current_dir
);
1244 return unbind_to (count
, proc
);
1247 /* This function is the unwind_protect form for Fstart_process. If
1248 PROC doesn't have its pid set, then we know someone has signaled
1249 an error and the process wasn't started successfully, so we should
1250 remove it from the process list. */
1252 start_process_unwind (proc
)
1255 if (!PROCESSP (proc
))
1258 /* Was PROC started successfully? */
1259 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1260 remove_process (proc
);
1266 create_process_1 (timer
)
1267 struct atimer
*timer
;
1269 /* Nothing to do. */
1273 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1276 /* Mimic blocking of signals on system V, which doesn't really have it. */
1278 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1279 int sigchld_deferred
;
1282 create_process_sigchld ()
1284 signal (SIGCHLD
, create_process_sigchld
);
1286 sigchld_deferred
= 1;
1292 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1294 create_process (process
, new_argv
, current_dir
)
1295 Lisp_Object process
;
1297 Lisp_Object current_dir
;
1299 int pid
, inchannel
, outchannel
;
1301 #ifdef POSIX_SIGNALS
1304 struct sigaction sigint_action
;
1305 struct sigaction sigquit_action
;
1307 struct sigaction sighup_action
;
1309 #else /* !POSIX_SIGNALS */
1312 SIGTYPE (*sigchld
)();
1315 #endif /* !POSIX_SIGNALS */
1316 /* Use volatile to protect variables from being clobbered by longjmp. */
1317 volatile int forkin
, forkout
;
1318 volatile int pty_flag
= 0;
1320 extern char **environ
;
1322 Lisp_Object buffer
= XPROCESS (process
)->buffer
;
1324 inchannel
= outchannel
= -1;
1327 if (!NILP (Vprocess_connection_type
))
1328 outchannel
= inchannel
= allocate_pty ();
1333 /* On USG systems it does not work to open the pty's tty here
1334 and then close and reopen it in the child. */
1336 /* Don't let this terminal become our controlling terminal
1337 (in case we don't have one). */
1338 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1340 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1343 report_file_error ("Opening pty", Qnil
);
1345 forkin
= forkout
= -1;
1346 #endif /* not USG */
1350 #endif /* HAVE_PTYS */
1353 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1354 report_file_error ("Opening socketpair", Qnil
);
1355 outchannel
= inchannel
= sv
[0];
1356 forkout
= forkin
= sv
[1];
1358 #else /* not SKTPAIR */
1363 report_file_error ("Creating pipe", Qnil
);
1369 emacs_close (inchannel
);
1370 emacs_close (forkout
);
1371 report_file_error ("Creating pipe", Qnil
);
1376 #endif /* not SKTPAIR */
1379 /* Replaced by close_process_descs */
1380 set_exclusive_use (inchannel
);
1381 set_exclusive_use (outchannel
);
1384 /* Stride people say it's a mystery why this is needed
1385 as well as the O_NDELAY, but that it fails without this. */
1386 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1389 ioctl (inchannel
, FIONBIO
, &one
);
1394 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1395 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1398 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1399 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1403 /* Record this as an active process, with its channels.
1404 As a result, child_setup will close Emacs's side of the pipes. */
1405 chan_process
[inchannel
] = process
;
1406 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1407 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1408 /* Record the tty descriptor used in the subprocess. */
1410 XPROCESS (process
)->subtty
= Qnil
;
1412 XSETFASTINT (XPROCESS (process
)->subtty
, forkin
);
1413 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1414 XPROCESS (process
)->status
= Qrun
;
1415 if (!proc_decode_coding_system
[inchannel
])
1416 proc_decode_coding_system
[inchannel
]
1417 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
1418 setup_coding_system (XPROCESS (process
)->decode_coding_system
,
1419 proc_decode_coding_system
[inchannel
]);
1420 if (!proc_encode_coding_system
[outchannel
])
1421 proc_encode_coding_system
[outchannel
]
1422 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
1423 setup_coding_system (XPROCESS (process
)->encode_coding_system
,
1424 proc_encode_coding_system
[outchannel
]);
1426 /* Delay interrupts until we have a chance to store
1427 the new fork's pid in its process structure */
1428 #ifdef POSIX_SIGNALS
1429 sigemptyset (&blocked
);
1431 sigaddset (&blocked
, SIGCHLD
);
1434 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1435 this sets the parent's signal handlers as well as the child's.
1436 So delay all interrupts whose handlers the child might munge,
1437 and record the current handlers so they can be restored later. */
1438 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1439 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1441 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1443 #endif /* HAVE_VFORK */
1444 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1445 #else /* !POSIX_SIGNALS */
1449 #else /* not BSD4_1 */
1450 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1451 sigsetmask (sigmask (SIGCHLD
));
1452 #else /* ordinary USG */
1454 sigchld_deferred
= 0;
1455 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1457 #endif /* ordinary USG */
1458 #endif /* not BSD4_1 */
1459 #endif /* SIGCHLD */
1460 #endif /* !POSIX_SIGNALS */
1462 FD_SET (inchannel
, &input_wait_mask
);
1463 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1464 if (inchannel
> max_process_desc
)
1465 max_process_desc
= inchannel
;
1467 /* Until we store the proper pid, enable sigchld_handler
1468 to recognize an unknown pid as standing for this process.
1469 It is very important not to let this `marker' value stay
1470 in the table after this function has returned; if it does
1471 it might cause call-process to hang and subsequent asynchronous
1472 processes to get their return values scrambled. */
1473 XSETINT (XPROCESS (process
)->pid
, -1);
1478 /* child_setup must clobber environ on systems with true vfork.
1479 Protect it from permanent change. */
1480 char **save_environ
= environ
;
1482 current_dir
= ENCODE_FILE (current_dir
);
1487 #endif /* not WINDOWSNT */
1489 int xforkin
= forkin
;
1490 int xforkout
= forkout
;
1492 #if 0 /* This was probably a mistake--it duplicates code later on,
1493 but fails to handle all the cases. */
1494 /* Make sure SIGCHLD is not blocked in the child. */
1495 sigsetmask (SIGEMPTYMASK
);
1498 /* Make the pty be the controlling terminal of the process. */
1500 /* First, disconnect its current controlling terminal. */
1502 /* We tried doing setsid only if pty_flag, but it caused
1503 process_set_signal to fail on SGI when using a pipe. */
1505 /* Make the pty's terminal the controlling terminal. */
1509 /* We ignore the return value
1510 because faith@cs.unc.edu says that is necessary on Linux. */
1511 ioctl (xforkin
, TIOCSCTTY
, 0);
1514 #else /* not HAVE_SETSID */
1516 /* It's very important to call setpgrp here and no time
1517 afterwards. Otherwise, we lose our controlling tty which
1518 is set when we open the pty. */
1521 #endif /* not HAVE_SETSID */
1522 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1523 if (pty_flag
&& xforkin
>= 0)
1526 tcgetattr (xforkin
, &t
);
1528 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1529 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1532 #if defined (NTTYDISC) && defined (TIOCSETD)
1533 if (pty_flag
&& xforkin
>= 0)
1535 /* Use new line discipline. */
1536 int ldisc
= NTTYDISC
;
1537 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1542 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1543 can do TIOCSPGRP only to the process's controlling tty. */
1546 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1547 I can't test it since I don't have 4.3. */
1548 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
1549 ioctl (j
, TIOCNOTTY
, 0);
1552 /* In order to get a controlling terminal on some versions
1553 of BSD, it is necessary to put the process in pgrp 0
1554 before it opens the terminal. */
1562 #endif /* TIOCNOTTY */
1564 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
1565 /*** There is a suggestion that this ought to be a
1566 conditional on TIOCSPGRP,
1567 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1568 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1569 that system does seem to need this code, even though
1570 both HAVE_SETSID and TIOCSCTTY are defined. */
1571 /* Now close the pty (if we had it open) and reopen it.
1572 This makes the pty the controlling terminal of the subprocess. */
1575 #ifdef SET_CHILD_PTY_PGRP
1576 int pgrp
= getpid ();
1579 /* I wonder if emacs_close (emacs_open (pty_name, ...))
1582 emacs_close (xforkin
);
1583 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
1587 emacs_write (1, "Couldn't open the pty terminal ", 31);
1588 emacs_write (1, pty_name
, strlen (pty_name
));
1589 emacs_write (1, "\n", 1);
1593 #ifdef SET_CHILD_PTY_PGRP
1594 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
1595 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
1598 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
1600 #ifdef SETUP_SLAVE_PTY
1605 #endif /* SETUP_SLAVE_PTY */
1607 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1608 Now reenable it in the child, so it will die when we want it to. */
1610 signal (SIGHUP
, SIG_DFL
);
1612 #endif /* HAVE_PTYS */
1614 signal (SIGINT
, SIG_DFL
);
1615 signal (SIGQUIT
, SIG_DFL
);
1617 /* Stop blocking signals in the child. */
1618 #ifdef POSIX_SIGNALS
1619 sigprocmask (SIG_SETMASK
, &procmask
, 0);
1620 #else /* !POSIX_SIGNALS */
1624 #else /* not BSD4_1 */
1625 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1626 sigsetmask (SIGEMPTYMASK
);
1627 #else /* ordinary USG */
1629 signal (SIGCHLD
, sigchld
);
1631 #endif /* ordinary USG */
1632 #endif /* not BSD4_1 */
1633 #endif /* SIGCHLD */
1634 #endif /* !POSIX_SIGNALS */
1637 child_setup_tty (xforkout
);
1639 pid
= child_setup (xforkin
, xforkout
, xforkout
,
1640 new_argv
, 1, current_dir
);
1641 #else /* not WINDOWSNT */
1642 child_setup (xforkin
, xforkout
, xforkout
,
1643 new_argv
, 1, current_dir
);
1644 #endif /* not WINDOWSNT */
1646 environ
= save_environ
;
1651 /* This runs in the Emacs process. */
1655 emacs_close (forkin
);
1656 if (forkin
!= forkout
&& forkout
>= 0)
1657 emacs_close (forkout
);
1661 /* vfork succeeded. */
1662 XSETFASTINT (XPROCESS (process
)->pid
, pid
);
1665 register_child (pid
, inchannel
);
1666 #endif /* WINDOWSNT */
1668 /* If the subfork execv fails, and it exits,
1669 this close hangs. I don't know why.
1670 So have an interrupt jar it loose. */
1672 struct atimer
*timer
;
1676 EMACS_SET_SECS_USECS (offset
, 1, 0);
1677 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
1679 XPROCESS (process
)->subtty
= Qnil
;
1681 emacs_close (forkin
);
1683 cancel_atimer (timer
);
1687 if (forkin
!= forkout
&& forkout
>= 0)
1688 emacs_close (forkout
);
1692 XPROCESS (process
)->tty_name
= build_string (pty_name
);
1695 XPROCESS (process
)->tty_name
= Qnil
;
1698 /* Restore the signal state whether vfork succeeded or not.
1699 (We will signal an error, below, if it failed.) */
1700 #ifdef POSIX_SIGNALS
1702 /* Restore the parent's signal handlers. */
1703 sigaction (SIGINT
, &sigint_action
, 0);
1704 sigaction (SIGQUIT
, &sigquit_action
, 0);
1706 sigaction (SIGHUP
, &sighup_action
, 0);
1708 #endif /* HAVE_VFORK */
1709 /* Stop blocking signals in the parent. */
1710 sigprocmask (SIG_SETMASK
, &procmask
, 0);
1711 #else /* !POSIX_SIGNALS */
1715 #else /* not BSD4_1 */
1716 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1717 sigsetmask (SIGEMPTYMASK
);
1718 #else /* ordinary USG */
1720 signal (SIGCHLD
, sigchld
);
1721 /* Now really handle any of these signals
1722 that came in during this function. */
1723 if (sigchld_deferred
)
1724 kill (getpid (), SIGCHLD
);
1726 #endif /* ordinary USG */
1727 #endif /* not BSD4_1 */
1728 #endif /* SIGCHLD */
1729 #endif /* !POSIX_SIGNALS */
1731 /* Now generate the error if vfork failed. */
1733 report_file_error ("Doing vfork", Qnil
);
1735 #endif /* not VMS */
1739 /* open a TCP network connection to a given HOST/SERVICE. Treated
1740 exactly like a normal process when reading and writing. Only
1741 differences are in status display and process deletion. A network
1742 connection has no PID; you cannot signal it. All you can do is
1743 deactivate and close it via delete-process */
1745 DEFUN ("open-network-stream", Fopen_network_stream
, Sopen_network_stream
,
1747 "Open a TCP connection for a service to a host.\n\
1748 Returns a subprocess-object to represent the connection.\n\
1749 Input and output work as for subprocesses; `delete-process' closes it.\n\
1750 Args are NAME BUFFER HOST SERVICE.\n\
1751 NAME is name for process. It is modified if necessary to make it unique.\n\
1752 BUFFER is the buffer (or buffer-name) to associate with the process.\n\
1753 Process output goes at end of that buffer, unless you specify\n\
1754 an output stream or filter function to handle the output.\n\
1755 BUFFER may be also nil, meaning that this process is not associated\n\
1757 Third arg is name of the host to connect to, or its IP address.\n\
1758 Fourth arg SERVICE is name of the service desired, or an integer\n\
1759 specifying a port number to connect to.")
1760 (name
, buffer
, host
, service
)
1761 Lisp_Object name
, buffer
, host
, service
;
1764 #ifdef HAVE_GETADDRINFO
1765 struct addrinfo hints
, *res
, *lres
;
1768 char *portstring
, portbuf
[128];
1769 #else /* HAVE_GETADDRINFO */
1770 struct sockaddr_in address
;
1771 struct servent
*svc_info
;
1772 struct hostent
*host_info_ptr
, host_info
;
1773 char *(addr_list
[2]);
1774 IN_ADDR numeric_addr
;
1776 #endif /* HAVE_GETADDRINFO */
1777 int s
= -1, outch
, inch
;
1778 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1780 int count
= specpdl_ptr
- specpdl
;
1784 /* Ensure socket support is loaded if available. */
1785 init_winsock (TRUE
);
1788 GCPRO4 (name
, buffer
, host
, service
);
1789 CHECK_STRING (name
, 0);
1790 CHECK_STRING (host
, 0);
1792 #ifdef HAVE_GETADDRINFO
1793 /* SERVICE can either be a string or int.
1794 Convert to a C string for later use by getaddrinfo. */
1795 if (INTEGERP (service
))
1797 sprintf (portbuf
, "%ld", (long) XINT (service
));
1798 portstring
= portbuf
;
1802 CHECK_STRING (service
, 0);
1803 portstring
= XSTRING (service
)->data
;
1805 #else /* HAVE_GETADDRINFO */
1806 if (INTEGERP (service
))
1807 port
= htons ((unsigned short) XINT (service
));
1810 CHECK_STRING (service
, 0);
1811 svc_info
= getservbyname (XSTRING (service
)->data
, "tcp");
1813 error ("Unknown service \"%s\"", XSTRING (service
)->data
);
1814 port
= svc_info
->s_port
;
1816 #endif /* HAVE_GETADDRINFO */
1819 /* Slow down polling to every ten seconds.
1820 Some kernels have a bug which causes retrying connect to fail
1821 after a connect. Polling can interfere with gethostbyname too. */
1822 #ifdef POLL_FOR_INPUT
1823 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
1824 bind_polling_period (10);
1828 #ifdef HAVE_GETADDRINFO
1831 memset (&hints
, 0, sizeof (hints
));
1833 hints
.ai_family
= AF_UNSPEC
;
1834 hints
.ai_socktype
= SOCK_STREAM
;
1835 hints
.ai_protocol
= 0;
1836 ret
= getaddrinfo (XSTRING (host
)->data
, portstring
, &hints
, &res
);
1838 #ifdef HAVE_GAI_STRERROR
1839 error ("%s/%s %s", XSTRING (host
)->data
, portstring
, gai_strerror(ret
));
1841 error ("%s/%s getaddrinfo error %d", XSTRING (host
)->data
, portstring
,
1846 /* Do this in case we never enter the for-loop below. */
1847 count1
= specpdl_ptr
- specpdl
;
1850 for (lres
= res
; lres
; lres
= lres
->ai_next
)
1852 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
1859 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1860 when connect is interrupted. So let's not let it get interrupted.
1861 Note we do not turn off polling, because polling is only used
1862 when not interrupt_input, and thus not normally used on the systems
1863 which have this bug. On systems which use polling, there's no way
1864 to quit if polling is turned off. */
1865 if (interrupt_input
)
1868 /* Make us close S if quit. */
1869 count1
= specpdl_ptr
- specpdl
;
1870 record_unwind_protect (close_file_unwind
, make_number (s
));
1877 /* This turns off all alarm-based interrupts; the
1878 bind_polling_period call above doesn't always turn all the
1879 short-interval ones off, especially if interrupt_input is
1882 It'd be nice to be able to control the connect timeout
1883 though. Would non-blocking connect calls be portable? */
1884 turn_on_atimers (0);
1885 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
1887 turn_on_atimers (1);
1889 if (ret
== 0 || xerrno
== EISCONN
)
1890 /* The unwind-protect will be discarded afterwards.
1891 Likewise for immediate_quit. */
1896 if (xerrno
== EINTR
)
1898 if (xerrno
== EADDRINUSE
&& retry
< 20)
1900 /* A delay here is needed on some FreeBSD systems,
1901 and it is harmless, since this retrying takes time anyway
1902 and should be infrequent. */
1903 Fsleep_for (make_number (1), Qnil
);
1908 /* Discard the unwind protect closing S. */
1909 specpdl_ptr
= specpdl
+ count1
;
1910 count1
= specpdl_ptr
- specpdl
;
1919 if (interrupt_input
)
1923 report_file_error ("connection failed",
1924 Fcons (host
, Fcons (name
, Qnil
)));
1927 #else /* not HAVE_GETADDRINFO */
1938 host_info_ptr
= gethostbyname (XSTRING (host
)->data
);
1942 if (! (host_info_ptr
== 0 && h_errno
== TRY_AGAIN
))
1946 Fsleep_for (make_number (1), Qnil
);
1949 if (host_info_ptr
== 0)
1950 /* Attempt to interpret host as numeric inet address */
1952 numeric_addr
= inet_addr ((char *) XSTRING (host
)->data
);
1953 if (NUMERIC_ADDR_ERROR
)
1954 error ("Unknown host \"%s\"", XSTRING (host
)->data
);
1956 host_info_ptr
= &host_info
;
1957 host_info
.h_name
= 0;
1958 host_info
.h_aliases
= 0;
1959 host_info
.h_addrtype
= AF_INET
;
1961 /* Older machines have only one address slot called h_addr.
1962 Newer machines have h_addr_list, but #define h_addr to
1963 be its first element. */
1964 host_info
.h_addr_list
= &(addr_list
[0]);
1966 host_info
.h_addr
= (char*)(&numeric_addr
);
1968 /* numeric_addr isn't null-terminated; it has fixed length. */
1969 host_info
.h_length
= sizeof (numeric_addr
);
1972 bzero (&address
, sizeof address
);
1973 bcopy (host_info_ptr
->h_addr
, (char *) &address
.sin_addr
,
1974 host_info_ptr
->h_length
);
1975 address
.sin_family
= host_info_ptr
->h_addrtype
;
1976 address
.sin_port
= port
;
1978 s
= socket (host_info_ptr
->h_addrtype
, SOCK_STREAM
, 0);
1980 report_file_error ("error creating socket", Fcons (name
, Qnil
));
1982 count1
= specpdl_ptr
- specpdl
;
1983 record_unwind_protect (close_file_unwind
, make_number (s
));
1985 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1986 when connect is interrupted. So let's not let it get interrupted.
1987 Note we do not turn off polling, because polling is only used
1988 when not interrupt_input, and thus not normally used on the systems
1989 which have this bug. On systems which use polling, there's no way
1990 to quit if polling is turned off. */
1991 if (interrupt_input
)
1999 if (connect (s
, (struct sockaddr
*) &address
, sizeof address
) == -1
2000 && errno
!= EISCONN
)
2008 if (errno
== EADDRINUSE
&& retry
< 20)
2010 /* A delay here is needed on some FreeBSD systems,
2011 and it is harmless, since this retrying takes time anyway
2012 and should be infrequent. */
2013 Fsleep_for (make_number (1), Qnil
);
2018 /* Discard the unwind protect. */
2019 specpdl_ptr
= specpdl
+ count1
;
2023 if (interrupt_input
)
2027 report_file_error ("connection failed",
2028 Fcons (host
, Fcons (name
, Qnil
)));
2031 #endif /* not HAVE_GETADDRINFO */
2035 /* Discard the unwind protect, if any. */
2036 specpdl_ptr
= specpdl
+ count1
;
2038 #ifdef POLL_FOR_INPUT
2039 unbind_to (count
, Qnil
);
2042 if (interrupt_input
)
2046 s
= connect_server (0);
2048 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2049 send_command (s
, C_PORT
, 0, "%s:%d", XSTRING (host
)->data
, ntohs (port
));
2050 send_command (s
, C_DUMB
, 1, 0);
2057 buffer
= Fget_buffer_create (buffer
);
2058 proc
= make_process (name
);
2060 chan_process
[inch
] = proc
;
2063 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
2066 fcntl (inch
, F_SETFL
, O_NDELAY
);
2070 XPROCESS (proc
)->childp
= Fcons (host
, Fcons (service
, Qnil
));
2071 XPROCESS (proc
)->command_channel_p
= Qnil
;
2072 XPROCESS (proc
)->buffer
= buffer
;
2073 XPROCESS (proc
)->sentinel
= Qnil
;
2074 XPROCESS (proc
)->filter
= Qnil
;
2075 XPROCESS (proc
)->command
= Qnil
;
2076 XPROCESS (proc
)->pid
= Qnil
;
2077 XSETINT (XPROCESS (proc
)->infd
, inch
);
2078 XSETINT (XPROCESS (proc
)->outfd
, outch
);
2079 XPROCESS (proc
)->status
= Qrun
;
2080 FD_SET (inch
, &input_wait_mask
);
2081 FD_SET (inch
, &non_keyboard_wait_mask
);
2082 if (inch
> max_process_desc
)
2083 max_process_desc
= inch
;
2086 /* Setup coding systems for communicating with the network stream. */
2087 struct gcpro gcpro1
;
2088 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
2089 Lisp_Object coding_systems
= Qt
;
2090 Lisp_Object args
[5], val
;
2092 if (!NILP (Vcoding_system_for_read
))
2093 val
= Vcoding_system_for_read
;
2094 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
2095 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
2096 /* We dare not decode end-of-line format by setting VAL to
2097 Qraw_text, because the existing Emacs Lisp libraries
2098 assume that they receive bare code including a sequene of
2103 args
[0] = Qopen_network_stream
, args
[1] = name
,
2104 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
2106 coding_systems
= Ffind_operation_coding_system (5, args
);
2108 if (CONSP (coding_systems
))
2109 val
= XCAR (coding_systems
);
2110 else if (CONSP (Vdefault_process_coding_system
))
2111 val
= XCAR (Vdefault_process_coding_system
);
2115 XPROCESS (proc
)->decode_coding_system
= val
;
2117 if (!NILP (Vcoding_system_for_write
))
2118 val
= Vcoding_system_for_write
;
2119 else if (NILP (current_buffer
->enable_multibyte_characters
))
2123 if (EQ (coding_systems
, Qt
))
2125 args
[0] = Qopen_network_stream
, args
[1] = name
,
2126 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
2128 coding_systems
= Ffind_operation_coding_system (5, args
);
2131 if (CONSP (coding_systems
))
2132 val
= XCDR (coding_systems
);
2133 else if (CONSP (Vdefault_process_coding_system
))
2134 val
= XCDR (Vdefault_process_coding_system
);
2138 XPROCESS (proc
)->encode_coding_system
= val
;
2141 if (!proc_decode_coding_system
[inch
])
2142 proc_decode_coding_system
[inch
]
2143 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
2144 setup_coding_system (XPROCESS (proc
)->decode_coding_system
,
2145 proc_decode_coding_system
[inch
]);
2146 if (!proc_encode_coding_system
[outch
])
2147 proc_encode_coding_system
[outch
]
2148 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
2149 setup_coding_system (XPROCESS (proc
)->encode_coding_system
,
2150 proc_encode_coding_system
[outch
]);
2152 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
2153 XPROCESS (proc
)->decoding_carryover
= make_number (0);
2154 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
2155 XPROCESS (proc
)->encoding_carryover
= make_number (0);
2157 XPROCESS (proc
)->inherit_coding_system_flag
2158 = (NILP (buffer
) || !inherit_process_coding_system
2164 #endif /* HAVE_SOCKETS */
2167 deactivate_process (proc
)
2170 register int inchannel
, outchannel
;
2171 register struct Lisp_Process
*p
= XPROCESS (proc
);
2173 inchannel
= XINT (p
->infd
);
2174 outchannel
= XINT (p
->outfd
);
2178 /* Beware SIGCHLD hereabouts. */
2179 flush_pending_output (inchannel
);
2182 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
2183 sys$
dassgn (outchannel
);
2184 vs
= get_vms_process_pointer (p
->pid
);
2186 give_back_vms_process_stuff (vs
);
2189 emacs_close (inchannel
);
2190 if (outchannel
>= 0 && outchannel
!= inchannel
)
2191 emacs_close (outchannel
);
2194 XSETINT (p
->infd
, -1);
2195 XSETINT (p
->outfd
, -1);
2196 chan_process
[inchannel
] = Qnil
;
2197 FD_CLR (inchannel
, &input_wait_mask
);
2198 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
2199 if (inchannel
== max_process_desc
)
2202 /* We just closed the highest-numbered process input descriptor,
2203 so recompute the highest-numbered one now. */
2204 max_process_desc
= 0;
2205 for (i
= 0; i
< MAXDESC
; i
++)
2206 if (!NILP (chan_process
[i
]))
2207 max_process_desc
= i
;
2212 /* Close all descriptors currently in use for communication
2213 with subprocess. This is used in a newly-forked subprocess
2214 to get rid of irrelevant descriptors. */
2217 close_process_descs ()
2221 for (i
= 0; i
< MAXDESC
; i
++)
2223 Lisp_Object process
;
2224 process
= chan_process
[i
];
2225 if (!NILP (process
))
2227 int in
= XINT (XPROCESS (process
)->infd
);
2228 int out
= XINT (XPROCESS (process
)->outfd
);
2231 if (out
>= 0 && in
!= out
)
2238 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
2240 "Allow any pending output from subprocesses to be read by Emacs.\n\
2241 It is read into the process' buffers or given to their filter functions.\n\
2242 Non-nil arg PROCESS means do not return until some output has been received\n\
2244 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\
2245 seconds and microseconds to wait; return after that much time whether\n\
2246 or not there is input.\n\
2247 Return non-nil iff we received any output before the timeout expired.")
2248 (process
, timeout
, timeout_msecs
)
2249 register Lisp_Object process
, timeout
, timeout_msecs
;
2254 if (! NILP (process
))
2255 CHECK_PROCESS (process
, 0);
2257 if (! NILP (timeout_msecs
))
2259 CHECK_NUMBER (timeout_msecs
, 2);
2260 useconds
= XINT (timeout_msecs
);
2261 if (!INTEGERP (timeout
))
2262 XSETINT (timeout
, 0);
2265 int carry
= useconds
/ 1000000;
2267 XSETINT (timeout
, XINT (timeout
) + carry
);
2268 useconds
-= carry
* 1000000;
2270 /* I think this clause is necessary because C doesn't
2271 guarantee a particular rounding direction for negative
2275 XSETINT (timeout
, XINT (timeout
) - 1);
2276 useconds
+= 1000000;
2283 if (! NILP (timeout
))
2285 CHECK_NUMBER (timeout
, 1);
2286 seconds
= XINT (timeout
);
2287 if (seconds
< 0 || (seconds
== 0 && useconds
== 0))
2299 XSETFASTINT (process
, 0);
2302 (wait_reading_process_input (seconds
, useconds
, process
, 0)
2306 /* This variable is different from waiting_for_input in keyboard.c.
2307 It is used to communicate to a lisp process-filter/sentinel (via the
2308 function Fwaiting_for_user_input_p below) whether emacs was waiting
2309 for user-input when that process-filter was called.
2310 waiting_for_input cannot be used as that is by definition 0 when
2311 lisp code is being evalled.
2312 This is also used in record_asynch_buffer_change.
2313 For that purpose, this must be 0
2314 when not inside wait_reading_process_input. */
2315 static int waiting_for_user_input_p
;
2317 /* This is here so breakpoints can be put on it. */
2319 wait_reading_process_input_1 ()
2323 /* Read and dispose of subprocess output while waiting for timeout to
2324 elapse and/or keyboard input to be available.
2327 timeout in seconds, or
2328 zero for no limit, or
2329 -1 means gobble data immediately available but don't wait for any.
2332 an additional duration to wait, measured in microseconds.
2333 If this is nonzero and time_limit is 0, then the timeout
2334 consists of MICROSECS only.
2336 READ_KBD is a lisp value:
2337 0 to ignore keyboard input, or
2338 1 to return when input is available, or
2339 -1 meaning caller will actually read the input, so don't throw to
2340 the quit handler, or
2341 a cons cell, meaning wait until its car is non-nil
2342 (and gobble terminal input into the buffer if any arrives), or
2343 a process object, meaning wait until something arrives from that
2344 process. The return value is true iff we read some input from
2347 DO_DISPLAY != 0 means redisplay should be done to show subprocess
2348 output that arrives.
2350 If READ_KBD is a pointer to a struct Lisp_Process, then the
2351 function returns true iff we received input from that process
2352 before the timeout elapsed.
2353 Otherwise, return true iff we received input from any process. */
2356 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
2357 int time_limit
, microsecs
;
2358 Lisp_Object read_kbd
;
2361 register int channel
, nfds
;
2362 static SELECT_TYPE Available
;
2365 EMACS_TIME timeout
, end_time
;
2367 int wait_channel
= -1;
2368 struct Lisp_Process
*wait_proc
= 0;
2369 int got_some_input
= 0;
2370 Lisp_Object
*wait_for_cell
= 0;
2372 FD_ZERO (&Available
);
2374 /* If read_kbd is a process to watch, set wait_proc and wait_channel
2376 if (PROCESSP (read_kbd
))
2378 wait_proc
= XPROCESS (read_kbd
);
2379 wait_channel
= XINT (wait_proc
->infd
);
2380 XSETFASTINT (read_kbd
, 0);
2383 /* If waiting for non-nil in a cell, record where. */
2384 if (CONSP (read_kbd
))
2386 wait_for_cell
= &XCAR (read_kbd
);
2387 XSETFASTINT (read_kbd
, 0);
2390 waiting_for_user_input_p
= XINT (read_kbd
);
2392 /* Since we may need to wait several times,
2393 compute the absolute time to return at. */
2394 if (time_limit
|| microsecs
)
2396 EMACS_GET_TIME (end_time
);
2397 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
2398 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
2401 /* AlainF 5-Jul-1996
2402 HP-UX 10.10 seem to have problems with signals coming in
2403 Causes "poll: interrupted system call" messages when Emacs is run
2405 Turn off periodic alarms (in case they are in use) */
2406 turn_on_atimers (0);
2411 int timeout_reduced_for_timers
= 0;
2413 /* If calling from keyboard input, do not quit
2414 since we want to return C-g as an input character.
2415 Otherwise, do pending quit if requested. */
2416 if (XINT (read_kbd
) >= 0)
2419 /* Exit now if the cell we're waiting for became non-nil. */
2420 if (wait_for_cell
&& ! NILP (*wait_for_cell
))
2423 /* Compute time from now till when time limit is up */
2424 /* Exit if already run out */
2425 if (time_limit
== -1)
2427 /* -1 specified for timeout means
2428 gobble output available now
2429 but don't wait at all. */
2431 EMACS_SET_SECS_USECS (timeout
, 0, 0);
2433 else if (time_limit
|| microsecs
)
2435 EMACS_GET_TIME (timeout
);
2436 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
2437 if (EMACS_TIME_NEG_P (timeout
))
2442 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
2445 /* Normally we run timers here.
2446 But not if wait_for_cell; in those cases,
2447 the wait is supposed to be short,
2448 and those callers cannot handle running arbitrary Lisp code here. */
2449 if (! wait_for_cell
)
2451 EMACS_TIME timer_delay
;
2455 int old_timers_run
= timers_run
;
2456 struct buffer
*old_buffer
= current_buffer
;
2458 timer_delay
= timer_check (1);
2460 /* If a timer has run, this might have changed buffers
2461 an alike. Make read_key_sequence aware of that. */
2462 if (timers_run
!= old_timers_run
2463 && old_buffer
!= current_buffer
2464 && waiting_for_user_input_p
== -1)
2465 record_asynch_buffer_change ();
2467 if (timers_run
!= old_timers_run
&& do_display
)
2468 /* We must retry, since a timer may have requeued itself
2469 and that could alter the time_delay. */
2470 redisplay_preserve_echo_area (9);
2474 while (!detect_input_pending ());
2476 /* If there is unread keyboard input, also return. */
2477 if (XINT (read_kbd
) != 0
2478 && requeued_events_pending_p ())
2481 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
2483 EMACS_TIME difference
;
2484 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
2485 if (EMACS_TIME_NEG_P (difference
))
2487 timeout
= timer_delay
;
2488 timeout_reduced_for_timers
= 1;
2491 /* If time_limit is -1, we are not going to wait at all. */
2492 else if (time_limit
!= -1)
2494 /* This is so a breakpoint can be put here. */
2495 wait_reading_process_input_1 ();
2499 /* Cause C-g and alarm signals to take immediate action,
2500 and cause input available signals to zero out timeout.
2502 It is important that we do this before checking for process
2503 activity. If we get a SIGCHLD after the explicit checks for
2504 process activity, timeout is the only way we will know. */
2505 if (XINT (read_kbd
) < 0)
2506 set_waiting_for_input (&timeout
);
2508 /* If status of something has changed, and no input is
2509 available, notify the user of the change right away. After
2510 this explicit check, we'll let the SIGCHLD handler zap
2511 timeout to get our attention. */
2512 if (update_tick
!= process_tick
&& do_display
)
2514 Atemp
= input_wait_mask
;
2515 EMACS_SET_SECS_USECS (timeout
, 0, 0);
2516 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
2517 &Atemp
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
2521 /* It's okay for us to do this and then continue with
2522 the loop, since timeout has already been zeroed out. */
2523 clear_waiting_for_input ();
2528 /* Don't wait for output from a non-running process. */
2529 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
2530 update_status (wait_proc
);
2532 && ! EQ (wait_proc
->status
, Qrun
))
2534 int nread
, total_nread
= 0;
2536 clear_waiting_for_input ();
2537 XSETPROCESS (proc
, wait_proc
);
2539 /* Read data from the process, until we exhaust it. */
2540 while (XINT (wait_proc
->infd
) >= 0)
2542 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
2548 total_nread
+= nread
;
2550 else if (nread
== -1 && EIO
== errno
)
2554 else if (nread
== -1 && EAGAIN
== errno
)
2558 else if (nread
== -1 && EWOULDBLOCK
== errno
)
2562 if (total_nread
> 0 && do_display
)
2563 redisplay_preserve_echo_area (10);
2568 /* Wait till there is something to do */
2571 Available
= non_process_wait_mask
;
2572 else if (! XINT (read_kbd
))
2573 Available
= non_keyboard_wait_mask
;
2575 Available
= input_wait_mask
;
2577 /* If frame size has changed or the window is newly mapped,
2578 redisplay now, before we start to wait. There is a race
2579 condition here; if a SIGIO arrives between now and the select
2580 and indicates that a frame is trashed, the select may block
2581 displaying a trashed screen. */
2582 if (frame_garbaged
&& do_display
)
2584 clear_waiting_for_input ();
2585 redisplay_preserve_echo_area (11);
2586 if (XINT (read_kbd
) < 0)
2587 set_waiting_for_input (&timeout
);
2590 if (XINT (read_kbd
) && detect_input_pending ())
2593 FD_ZERO (&Available
);
2596 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
2597 &Available
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
2602 /* Make C-g and alarm signals set flags again */
2603 clear_waiting_for_input ();
2605 /* If we woke up due to SIGWINCH, actually change size now. */
2606 do_pending_window_change (0);
2608 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
2609 /* We wanted the full specified time, so return now. */
2613 if (xerrno
== EINTR
)
2614 FD_ZERO (&Available
);
2616 /* Ultrix select seems to return ENOMEM when it is
2617 interrupted. Treat it just like EINTR. Bleah. Note
2618 that we want to test for the "ultrix" CPP symbol, not
2619 "__ultrix__"; the latter is only defined under GCC, but
2620 not by DEC's bundled CC. -JimB */
2621 else if (xerrno
== ENOMEM
)
2622 FD_ZERO (&Available
);
2625 /* This happens for no known reason on ALLIANT.
2626 I am guessing that this is the right response. -- RMS. */
2627 else if (xerrno
== EFAULT
)
2628 FD_ZERO (&Available
);
2630 else if (xerrno
== EBADF
)
2633 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
2634 the child's closure of the pts gives the parent a SIGHUP, and
2635 the ptc file descriptor is automatically closed,
2636 yielding EBADF here or at select() call above.
2637 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
2638 in m/ibmrt-aix.h), and here we just ignore the select error.
2639 Cleanup occurs c/o status_notify after SIGCLD. */
2640 FD_ZERO (&Available
); /* Cannot depend on values returned */
2646 error ("select error: %s", emacs_strerror (xerrno
));
2648 #if defined(sun) && !defined(USG5_4)
2649 else if (nfds
> 0 && keyboard_bit_set (&Available
)
2651 /* System sometimes fails to deliver SIGIO.
2653 David J. Mackenzie says that Emacs doesn't compile under
2654 Solaris if this code is enabled, thus the USG5_4 in the CPP
2655 conditional. "I haven't noticed any ill effects so far.
2656 If you find a Solaris expert somewhere, they might know
2658 kill (getpid (), SIGIO
);
2661 #if 0 /* When polling is used, interrupt_input is 0,
2662 so get_input_pending should read the input.
2663 So this should not be needed. */
2664 /* If we are using polling for input,
2665 and we see input available, make it get read now.
2666 Otherwise it might not actually get read for a second.
2667 And on hpux, since we turn off polling in wait_reading_process_input,
2668 it might never get read at all if we don't spend much time
2669 outside of wait_reading_process_input. */
2670 if (XINT (read_kbd
) && interrupt_input
2671 && keyboard_bit_set (&Available
)
2672 && input_polling_used ())
2673 kill (getpid (), SIGALRM
);
2676 /* Check for keyboard input */
2677 /* If there is any, return immediately
2678 to give it higher priority than subprocesses */
2680 if (XINT (read_kbd
) != 0)
2682 int old_timers_run
= timers_run
;
2683 struct buffer
*old_buffer
= current_buffer
;
2686 if (detect_input_pending_run_timers (do_display
))
2688 swallow_events (do_display
);
2689 if (detect_input_pending_run_timers (do_display
))
2693 /* If a timer has run, this might have changed buffers
2694 an alike. Make read_key_sequence aware of that. */
2695 if (timers_run
!= old_timers_run
2696 && waiting_for_user_input_p
== -1
2697 && old_buffer
!= current_buffer
)
2698 record_asynch_buffer_change ();
2704 /* If there is unread keyboard input, also return. */
2705 if (XINT (read_kbd
) != 0
2706 && requeued_events_pending_p ())
2709 /* If we are not checking for keyboard input now,
2710 do process events (but don't run any timers).
2711 This is so that X events will be processed.
2712 Otherwise they may have to wait until polling takes place.
2713 That would causes delays in pasting selections, for example.
2715 (We used to do this only if wait_for_cell.) */
2716 if (XINT (read_kbd
) == 0 && detect_input_pending ())
2718 swallow_events (do_display
);
2719 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
2720 if (detect_input_pending ())
2725 /* Exit now if the cell we're waiting for became non-nil. */
2726 if (wait_for_cell
&& ! NILP (*wait_for_cell
))
2730 /* If we think we have keyboard input waiting, but didn't get SIGIO,
2731 go read it. This can happen with X on BSD after logging out.
2732 In that case, there really is no input and no SIGIO,
2733 but select says there is input. */
2735 if (XINT (read_kbd
) && interrupt_input
2736 && keyboard_bit_set (&Available
))
2737 kill (getpid (), SIGIO
);
2741 got_some_input
|= nfds
> 0;
2743 /* If checking input just got us a size-change event from X,
2744 obey it now if we should. */
2745 if (XINT (read_kbd
) || wait_for_cell
)
2746 do_pending_window_change (0);
2748 /* Check for data from a process. */
2749 /* Really FIRST_PROC_DESC should be 0 on Unix,
2750 but this is safer in the short run. */
2751 for (channel
= 0; channel
<= max_process_desc
; channel
++)
2753 if (FD_ISSET (channel
, &Available
)
2754 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
2758 /* If waiting for this channel, arrange to return as
2759 soon as no more input to be processed. No more
2761 if (wait_channel
== channel
)
2767 proc
= chan_process
[channel
];
2771 /* Read data from the process, starting with our
2772 buffered-ahead character if we have one. */
2774 nread
= read_process_output (proc
, channel
);
2777 /* Since read_process_output can run a filter,
2778 which can call accept-process-output,
2779 don't try to read from any other processes
2780 before doing the select again. */
2781 FD_ZERO (&Available
);
2784 redisplay_preserve_echo_area (12);
2787 else if (nread
== -1 && errno
== EWOULDBLOCK
)
2790 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
2791 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
2793 else if (nread
== -1 && errno
== EAGAIN
)
2797 else if (nread
== -1 && errno
== EAGAIN
)
2799 /* Note that we cannot distinguish between no input
2800 available now and a closed pipe.
2801 With luck, a closed pipe will be accompanied by
2802 subprocess termination and SIGCHLD. */
2803 else if (nread
== 0 && !NETCONN_P (proc
))
2805 #endif /* O_NDELAY */
2806 #endif /* O_NONBLOCK */
2808 /* On some OSs with ptys, when the process on one end of
2809 a pty exits, the other end gets an error reading with
2810 errno = EIO instead of getting an EOF (0 bytes read).
2811 Therefore, if we get an error reading and errno =
2812 EIO, just continue, because the child process has
2813 exited and should clean itself up soon (e.g. when we
2816 However, it has been known to happen that the SIGCHLD
2817 got lost. So raise the signl again just in case.
2819 else if (nread
== -1 && errno
== EIO
)
2820 kill (getpid (), SIGCHLD
);
2821 #endif /* HAVE_PTYS */
2822 /* If we can detect process termination, don't consider the process
2823 gone just because its pipe is closed. */
2825 else if (nread
== 0 && !NETCONN_P (proc
))
2830 /* Preserve status of processes already terminated. */
2831 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
2832 deactivate_process (proc
);
2833 if (!NILP (XPROCESS (proc
)->raw_status_low
))
2834 update_status (XPROCESS (proc
));
2835 if (EQ (XPROCESS (proc
)->status
, Qrun
))
2836 XPROCESS (proc
)->status
2837 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
2840 } /* end for each file descriptor */
2841 } /* end while exit conditions not met */
2843 waiting_for_user_input_p
= 0;
2845 /* If calling from keyboard input, do not quit
2846 since we want to return C-g as an input character.
2847 Otherwise, do pending quit if requested. */
2848 if (XINT (read_kbd
) >= 0)
2850 /* Prevent input_pending from remaining set if we quit. */
2851 clear_input_pending ();
2855 /* AlainF 5-Jul-1996
2856 HP-UX 10.10 seems to have problems with signals coming in
2857 Causes "poll: interrupted system call" messages when Emacs is run
2859 Turn periodic alarms back on */
2863 return got_some_input
;
2866 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
2869 read_process_output_call (fun_and_args
)
2870 Lisp_Object fun_and_args
;
2872 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
2876 read_process_output_error_handler (error
)
2879 cmd_error_internal (error
, "error in process filter: ");
2881 update_echo_area ();
2882 Fsleep_for (make_number (2), Qnil
);
2886 /* Read pending output from the process channel,
2887 starting with our buffered-ahead character if we have one.
2888 Yield number of decoded characters read.
2890 This function reads at most 1024 characters.
2891 If you want to read all available subprocess output,
2892 you must call it repeatedly until it returns zero.
2894 The characters read are decoded according to PROC's coding-system
2898 read_process_output (proc
, channel
)
2900 register int channel
;
2902 register int nchars
, nbytes
;
2904 register Lisp_Object outstream
;
2905 register struct buffer
*old
= current_buffer
;
2906 register struct Lisp_Process
*p
= XPROCESS (proc
);
2907 register int opoint
;
2908 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
2909 int carryover
= XINT (p
->decoding_carryover
);
2912 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
2914 vs
= get_vms_process_pointer (p
->pid
);
2918 return (0); /* Really weird if it does this */
2919 if (!(vs
->iosb
[0] & 1))
2920 return -1; /* I/O error */
2923 error ("Could not get VMS process pointer");
2924 chars
= vs
->inputBuffer
;
2925 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
2928 start_vms_process_read (vs
); /* Crank up the next read on the process */
2929 return 1; /* Nothing worth printing, say we got 1 */
2933 /* The data carried over in the previous decoding (which are at
2934 the tail of decoding buffer) should be prepended to the new
2935 data read to decode all together. */
2936 chars
= (char *) alloca (nbytes
+ carryover
);
2937 bcopy (XSTRING (p
->decoding_buf
)->data
, buf
, carryover
);
2938 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
2941 chars
= (char *) alloca (carryover
+ 1024);
2943 /* See the comment above. */
2944 bcopy (XSTRING (p
->decoding_buf
)->data
, chars
, carryover
);
2946 if (proc_buffered_char
[channel
] < 0)
2947 nbytes
= emacs_read (channel
, chars
+ carryover
, 1024 - carryover
);
2950 chars
[carryover
] = proc_buffered_char
[channel
];
2951 proc_buffered_char
[channel
] = -1;
2952 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, 1023 - carryover
);
2956 nbytes
= nbytes
+ 1;
2958 #endif /* not VMS */
2960 XSETINT (p
->decoding_carryover
, 0);
2962 /* At this point, NBYTES holds number of bytes just received
2963 (including the one in proc_buffered_char[channel]). */
2966 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
2968 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
2971 /* Now set NBYTES how many bytes we must decode. */
2972 nbytes
+= carryover
;
2974 /* Read and dispose of the process output. */
2975 outstream
= p
->filter
;
2976 if (!NILP (outstream
))
2978 /* We inhibit quit here instead of just catching it so that
2979 hitting ^G when a filter happens to be running won't screw
2981 int count
= specpdl_ptr
- specpdl
;
2982 Lisp_Object odeactivate
;
2983 Lisp_Object obuffer
, okeymap
;
2985 int outer_running_asynch_code
= running_asynch_code
;
2986 int waiting
= waiting_for_user_input_p
;
2988 /* No need to gcpro these, because all we do with them later
2989 is test them for EQness, and none of them should be a string. */
2990 odeactivate
= Vdeactivate_mark
;
2991 XSETBUFFER (obuffer
, current_buffer
);
2992 okeymap
= current_buffer
->keymap
;
2994 specbind (Qinhibit_quit
, Qt
);
2995 specbind (Qlast_nonmenu_event
, Qt
);
2997 /* In case we get recursively called,
2998 and we already saved the match data nonrecursively,
2999 save the same match data in safely recursive fashion. */
3000 if (outer_running_asynch_code
)
3003 /* Don't clobber the CURRENT match data, either! */
3004 tem
= Fmatch_data (Qnil
, Qnil
);
3005 restore_match_data ();
3006 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
3007 Fset_match_data (tem
);
3010 /* For speed, if a search happens within this code,
3011 save the match data in a special nonrecursive fashion. */
3012 running_asynch_code
= 1;
3014 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
3016 if (NILP (buffer_defaults
.enable_multibyte_characters
))
3017 /* We had better return unibyte string. */
3018 text
= string_make_unibyte (text
);
3020 Vlast_coding_system_used
= coding
->symbol
;
3021 /* A new coding system might be found. */
3022 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
3024 p
->decode_coding_system
= coding
->symbol
;
3026 /* Don't call setup_coding_system for
3027 proc_decode_coding_system[channel] here. It is done in
3028 detect_coding called via decode_coding above. */
3030 /* If a coding system for encoding is not yet decided, we set
3031 it as the same as coding-system for decoding.
3033 But, before doing that we must check if
3034 proc_encode_coding_system[p->outfd] surely points to a
3035 valid memory because p->outfd will be changed once EOF is
3036 sent to the process. */
3037 if (NILP (p
->encode_coding_system
)
3038 && proc_encode_coding_system
[XINT (p
->outfd
)])
3040 p
->encode_coding_system
= coding
->symbol
;
3041 setup_coding_system (coding
->symbol
,
3042 proc_encode_coding_system
[XINT (p
->outfd
)]);
3046 carryover
= nbytes
- coding
->consumed
;
3047 bcopy (chars
+ coding
->consumed
, XSTRING (p
->decoding_buf
)->data
,
3049 XSETINT (p
->decoding_carryover
, carryover
);
3050 nbytes
= STRING_BYTES (XSTRING (text
));
3051 nchars
= XSTRING (text
)->size
;
3053 internal_condition_case_1 (read_process_output_call
,
3055 Fcons (proc
, Fcons (text
, Qnil
))),
3056 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
3057 read_process_output_error_handler
);
3059 /* If we saved the match data nonrecursively, restore it now. */
3060 restore_match_data ();
3061 running_asynch_code
= outer_running_asynch_code
;
3063 /* Handling the process output should not deactivate the mark. */
3064 Vdeactivate_mark
= odeactivate
;
3066 /* Restore waiting_for_user_input_p as it was
3067 when we were called, in case the filter clobbered it. */
3068 waiting_for_user_input_p
= waiting
;
3070 #if 0 /* Call record_asynch_buffer_change unconditionally,
3071 because we might have changed minor modes or other things
3072 that affect key bindings. */
3073 if (! EQ (Fcurrent_buffer (), obuffer
)
3074 || ! EQ (current_buffer
->keymap
, okeymap
))
3076 /* But do it only if the caller is actually going to read events.
3077 Otherwise there's no need to make him wake up, and it could
3078 cause trouble (for example it would make Fsit_for return). */
3079 if (waiting_for_user_input_p
== -1)
3080 record_asynch_buffer_change ();
3083 start_vms_process_read (vs
);
3085 unbind_to (count
, Qnil
);
3089 /* If no filter, write into buffer if it isn't dead. */
3090 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
3092 Lisp_Object old_read_only
;
3093 int old_begv
, old_zv
;
3094 int old_begv_byte
, old_zv_byte
;
3095 Lisp_Object odeactivate
;
3096 int before
, before_byte
;
3101 odeactivate
= Vdeactivate_mark
;
3103 Fset_buffer (p
->buffer
);
3105 opoint_byte
= PT_BYTE
;
3106 old_read_only
= current_buffer
->read_only
;
3109 old_begv_byte
= BEGV_BYTE
;
3110 old_zv_byte
= ZV_BYTE
;
3112 current_buffer
->read_only
= Qnil
;
3114 /* Insert new output into buffer
3115 at the current end-of-output marker,
3116 thus preserving logical ordering of input and output. */
3117 if (XMARKER (p
->mark
)->buffer
)
3118 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
3119 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
3122 SET_PT_BOTH (ZV
, ZV_BYTE
);
3124 before_byte
= PT_BYTE
;
3126 /* If the output marker is outside of the visible region, save
3127 the restriction and widen. */
3128 if (! (BEGV
<= PT
&& PT
<= ZV
))
3131 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
3133 Vlast_coding_system_used
= coding
->symbol
;
3134 /* A new coding system might be found. See the comment in the
3135 similar code in the previous `if' block. */
3136 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
3138 p
->decode_coding_system
= coding
->symbol
;
3139 if (NILP (p
->encode_coding_system
)
3140 && proc_encode_coding_system
[XINT (p
->outfd
)])
3142 p
->encode_coding_system
= coding
->symbol
;
3143 setup_coding_system (coding
->symbol
,
3144 proc_encode_coding_system
[XINT (p
->outfd
)]);
3147 carryover
= nbytes
- coding
->consumed
;
3148 bcopy (chars
+ coding
->consumed
, XSTRING (p
->decoding_buf
)->data
,
3150 XSETINT (p
->decoding_carryover
, carryover
);
3151 /* Adjust the multibyteness of TEXT to that of the buffer. */
3152 if (NILP (current_buffer
->enable_multibyte_characters
)
3153 != ! STRING_MULTIBYTE (text
))
3154 text
= (STRING_MULTIBYTE (text
)
3155 ? Fstring_as_unibyte (text
)
3156 : Fstring_as_multibyte (text
));
3157 nbytes
= STRING_BYTES (XSTRING (text
));
3158 nchars
= XSTRING (text
)->size
;
3159 /* Insert before markers in case we are inserting where
3160 the buffer's mark is, and the user's next command is Meta-y. */
3161 insert_from_string_before_markers (text
, 0, 0, nchars
, nbytes
, 0);
3163 /* Make sure the process marker's position is valid when the
3164 process buffer is changed in the signal_after_change above.
3165 W3 is known to do that. */
3166 if (BUFFERP (p
->buffer
)
3167 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
3168 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
3170 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
3172 update_mode_lines
++;
3174 /* Make sure opoint and the old restrictions
3175 float ahead of any new text just as point would. */
3176 if (opoint
>= before
)
3178 opoint
+= PT
- before
;
3179 opoint_byte
+= PT_BYTE
- before_byte
;
3181 if (old_begv
> before
)
3183 old_begv
+= PT
- before
;
3184 old_begv_byte
+= PT_BYTE
- before_byte
;
3186 if (old_zv
>= before
)
3188 old_zv
+= PT
- before
;
3189 old_zv_byte
+= PT_BYTE
- before_byte
;
3192 /* If the restriction isn't what it should be, set it. */
3193 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
3194 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
3196 /* Handling the process output should not deactivate the mark. */
3197 Vdeactivate_mark
= odeactivate
;
3199 current_buffer
->read_only
= old_read_only
;
3200 SET_PT_BOTH (opoint
, opoint_byte
);
3201 set_buffer_internal (old
);
3204 start_vms_process_read (vs
);
3209 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
3211 "Returns non-nil if emacs is waiting for input from the user.\n\
3212 This is intended for use by asynchronous process output filters and sentinels.")
3215 return (waiting_for_user_input_p
? Qt
: Qnil
);
3218 /* Sending data to subprocess */
3220 jmp_buf send_process_frame
;
3221 Lisp_Object process_sent_to
;
3224 send_process_trap ()
3230 longjmp (send_process_frame
, 1);
3233 /* Send some data to process PROC.
3234 BUF is the beginning of the data; LEN is the number of characters.
3235 OBJECT is the Lisp object that the data comes from. If OBJECT is
3236 nil or t, it means that the data comes from C string.
3238 If OBJECT is not nil, the data is encoded by PROC's coding-system
3239 for encoding before it is sent.
3241 This function can evaluate Lisp code and can garbage collect. */
3244 send_process (proc
, buf
, len
, object
)
3245 volatile Lisp_Object proc
;
3246 unsigned char *volatile buf
;
3248 volatile Lisp_Object object
;
3250 /* Use volatile to protect variables from being clobbered by longjmp. */
3252 struct coding_system
*coding
;
3253 struct gcpro gcpro1
;
3258 struct Lisp_Process
*p
= XPROCESS (proc
);
3259 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
3262 if (! NILP (XPROCESS (proc
)->raw_status_low
))
3263 update_status (XPROCESS (proc
));
3264 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
3265 error ("Process %s not running",
3266 XSTRING (XPROCESS (proc
)->name
)->data
);
3267 if (XINT (XPROCESS (proc
)->outfd
) < 0)
3268 error ("Output file descriptor of %s is closed",
3269 XSTRING (XPROCESS (proc
)->name
)->data
);
3271 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
3272 Vlast_coding_system_used
= coding
->symbol
;
3274 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
3275 || (BUFFERP (object
)
3276 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
3279 coding
->src_multibyte
= 1;
3280 if (!EQ (coding
->symbol
, XPROCESS (proc
)->encode_coding_system
))
3281 /* The coding system for encoding was changed to raw-text
3282 because we sent a unibyte text previously. Now we are
3283 sending a multibyte text, thus we must encode it by the
3284 original coding system specified for the current
3286 setup_coding_system (XPROCESS (proc
)->encode_coding_system
,
3291 /* For sending a unibyte text, character code conversion should
3292 not take place but EOL conversion should. So, setup raw-text
3293 or one of the subsidiary if we have not yet done it. */
3294 if (coding
->type
!= coding_type_raw_text
)
3296 if (CODING_REQUIRE_FLUSHING (coding
))
3298 /* But, before changing the coding, we must flush out data. */
3299 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
3300 send_process (proc
, "", 0, Qt
);
3302 coding
->src_multibyte
= 0;
3303 setup_raw_text_coding_system (coding
);
3306 coding
->dst_multibyte
= 0;
3308 if (CODING_REQUIRE_ENCODING (coding
))
3310 int require
= encoding_buffer_size (coding
, len
);
3311 int from_byte
= -1, from
= -1, to
= -1;
3312 unsigned char *temp_buf
= NULL
;
3314 if (BUFFERP (object
))
3316 from_byte
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
3317 from
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
);
3318 to
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
+ len
);
3320 else if (STRINGP (object
))
3322 from_byte
= buf
- XSTRING (object
)->data
;
3323 from
= string_byte_to_char (object
, from_byte
);
3324 to
= string_byte_to_char (object
, from_byte
+ len
);
3327 if (coding
->composing
!= COMPOSITION_DISABLED
)
3330 coding_save_composition (coding
, from
, to
, object
);
3332 coding
->composing
= COMPOSITION_DISABLED
;
3335 if (STRING_BYTES (XSTRING (XPROCESS (proc
)->encoding_buf
)) < require
)
3336 XPROCESS (proc
)->encoding_buf
= make_uninit_string (require
);
3339 buf
= (BUFFERP (object
)
3340 ? BUF_BYTE_ADDRESS (XBUFFER (object
), from_byte
)
3341 : XSTRING (object
)->data
+ from_byte
);
3343 object
= XPROCESS (proc
)->encoding_buf
;
3344 encode_coding (coding
, (char *) buf
, XSTRING (object
)->data
,
3345 len
, STRING_BYTES (XSTRING (object
)));
3346 len
= coding
->produced
;
3347 buf
= XSTRING (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 "Send current contents of region as input to PROCESS.\n\
3526 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
3527 nil, indicating the current buffer's process.\n\
3528 Called from program, takes three arguments, PROCESS, START and END.\n\
3529 If the region is more than 500 characters long,\n\
3530 it is sent in several bunches. This may happen even for shorter regions.\n\
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 "Send PROCESS the contents of STRING as input.\n\
3555 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
3556 nil, indicating the current buffer's process.\n\
3557 If STRING is more than 500 characters long,\n\
3558 it is sent in several bunches. This may happen even for shorter strings.\n\
3559 Output from processes can arrive in between bunches.")
3561 Lisp_Object process
, string
;
3564 CHECK_STRING (string
, 1);
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 "Return t if PROCESS has given the terminal to a child.\n\
3574 If the operating system does not make it possible to find out,\n\
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 "Interrupt process PROCESS.\n\
3834 PROCESS may be a process, a buffer, or the name of a process or buffer.\n\
3835 nil or no arg means current buffer's process.\n\
3836 Second arg CURRENT-GROUP non-nil means send signal to\n\
3837 the current process-group of the process's controlling terminal\n\
3838 rather than to the process's own process group.\n\
3839 If the process is a shell, this means interrupt current subjob\n\
3840 rather than the shell.\n\
3842 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,\n\
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 "Kill process PROCESS. May be process or name of one.\n\
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 "Send QUIT signal to process PROCESS. May be process or name of one.\n\
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 "Stop process PROCESS. May be process or name of one.\n\
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 "Continue process PROCESS. May be process or name of one.\n\
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 "Send the process with process id PID the signal with code SIGCODE.\n\
3902 PID must be an integer. The process need not be a child of this Emacs.\n\
3903 SIGCODE may be an integer, or a symbol whose name is a signal name.")
3905 Lisp_Object pid
, sigcode
;
3907 CHECK_NUMBER (pid
, 0);
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
, 1);
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 "Make PROCESS see end-of-file in its input.\n\
4025 EOF comes after any text already sent to it.\n\
4026 PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
4027 nil, indicating the current buffer's process.\n\
4028 If PROCESS is a network connection, or is a process communicating\n\
4029 through a pipe (as opposed to a pty), then you cannot send any more\n\
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 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 "Set coding systems of PROCESS to DECODING and ENCODING.\n\
4512 DECODING will be used to decode subprocess output and ENCODING to\n\
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
, 0);
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 "Return a cons of coding systems for decoding and encoding of PROCESS.")
4540 register Lisp_Object proc
;
4542 CHECK_PROCESS (proc
, 0);
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 "*Non-nil means delete processes immediately when they exit.\n\
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 "Control type of device used to communicate with subprocesses.\n\
4668 Values are nil to use a pipe, or t or `pty' to use a pty.\n\
4669 The value has no effect if the system has no ptys or if all ptys are busy:\n\
4670 then a pipe is used in any case.\n\
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 "charset.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 Lisp_Object
*wait_for_cell
= 0;
4773 /* If waiting for non-nil in a cell, record where. */
4774 if (CONSP (read_kbd
))
4776 wait_for_cell
= &XCAR (read_kbd
);
4777 XSETFASTINT (read_kbd
, 0);
4780 /* What does time_limit really mean? */
4781 if (time_limit
|| microsecs
)
4783 EMACS_GET_TIME (end_time
);
4784 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4785 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4788 /* Turn off periodic alarms (in case they are in use)
4789 because the select emulator uses alarms. */
4790 turn_on_atimers (0);
4794 int timeout_reduced_for_timers
= 0;
4796 /* If calling from keyboard input, do not quit
4797 since we want to return C-g as an input character.
4798 Otherwise, do pending quit if requested. */
4799 if (XINT (read_kbd
) >= 0)
4802 /* Exit now if the cell we're waiting for became non-nil. */
4803 if (wait_for_cell
&& ! NILP (*wait_for_cell
))
4806 /* Compute time from now till when time limit is up */
4807 /* Exit if already run out */
4808 if (time_limit
== -1)
4810 /* -1 specified for timeout means
4811 gobble output available now
4812 but don't wait at all. */
4814 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4816 else if (time_limit
|| microsecs
)
4818 EMACS_GET_TIME (timeout
);
4819 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4820 if (EMACS_TIME_NEG_P (timeout
))
4825 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4828 /* If our caller will not immediately handle keyboard events,
4829 run timer events directly.
4830 (Callers that will immediately read keyboard events
4831 call timer_delay on their own.) */
4832 if (! wait_for_cell
)
4834 EMACS_TIME timer_delay
;
4838 int old_timers_run
= timers_run
;
4839 timer_delay
= timer_check (1);
4840 if (timers_run
!= old_timers_run
&& do_display
)
4841 /* We must retry, since a timer may have requeued itself
4842 and that could alter the time delay. */
4843 redisplay_preserve_echo_area (14);
4847 while (!detect_input_pending ());
4849 /* If there is unread keyboard input, also return. */
4850 if (XINT (read_kbd
) != 0
4851 && requeued_events_pending_p ())
4854 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4856 EMACS_TIME difference
;
4857 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4858 if (EMACS_TIME_NEG_P (difference
))
4860 timeout
= timer_delay
;
4861 timeout_reduced_for_timers
= 1;
4866 /* Cause C-g and alarm signals to take immediate action,
4867 and cause input available signals to zero out timeout. */
4868 if (XINT (read_kbd
) < 0)
4869 set_waiting_for_input (&timeout
);
4871 /* Wait till there is something to do. */
4873 if (! XINT (read_kbd
) && wait_for_cell
== 0)
4874 FD_ZERO (&waitchannels
);
4876 FD_SET (0, &waitchannels
);
4878 /* If a frame has been newly mapped and needs updating,
4879 reprocess its display stuff. */
4880 if (frame_garbaged
&& do_display
)
4882 clear_waiting_for_input ();
4883 redisplay_preserve_echo_area (15);
4884 if (XINT (read_kbd
) < 0)
4885 set_waiting_for_input (&timeout
);
4888 if (XINT (read_kbd
) && detect_input_pending ())
4891 FD_ZERO (&waitchannels
);
4894 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
4899 /* Make C-g and alarm signals set flags again */
4900 clear_waiting_for_input ();
4902 /* If we woke up due to SIGWINCH, actually change size now. */
4903 do_pending_window_change (0);
4905 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4906 /* We waited the full specified time, so return now. */
4911 /* If the system call was interrupted, then go around the
4913 if (xerrno
== EINTR
)
4914 FD_ZERO (&waitchannels
);
4916 error ("select error: %s", emacs_strerror (xerrno
));
4919 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
4920 /* System sometimes fails to deliver SIGIO. */
4921 kill (getpid (), SIGIO
);
4924 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
4925 kill (getpid (), SIGIO
);
4928 /* Check for keyboard input */
4930 if ((XINT (read_kbd
) != 0)
4931 && detect_input_pending_run_timers (do_display
))
4933 swallow_events (do_display
);
4934 if (detect_input_pending_run_timers (do_display
))
4938 /* If there is unread keyboard input, also return. */
4939 if (XINT (read_kbd
) != 0
4940 && requeued_events_pending_p ())
4943 /* If wait_for_cell. check for keyboard input
4944 but don't run any timers.
4945 ??? (It seems wrong to me to check for keyboard
4946 input at all when wait_for_cell, but the code
4947 has been this way since July 1994.
4948 Try changing this after version 19.31.) */
4950 && detect_input_pending ())
4952 swallow_events (do_display
);
4953 if (detect_input_pending ())
4957 /* Exit now if the cell we're waiting for became non-nil. */
4958 if (wait_for_cell
&& ! NILP (*wait_for_cell
))
4968 /* Don't confuse make-docfile by having two doc strings for this function.
4969 make-docfile does not pay attention to #if, for good reason! */
4970 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
4973 register Lisp_Object name
;
4978 /* Don't confuse make-docfile by having two doc strings for this function.
4979 make-docfile does not pay attention to #if, for good reason! */
4980 DEFUN ("process-inherit-coding-system-flag",
4981 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
4985 register Lisp_Object process
;
4987 /* Ignore the argument and return the value of
4988 inherit-process-coding-system. */
4989 return inherit_process_coding_system
? Qt
: Qnil
;
4992 /* Kill all processes associated with `buffer'.
4993 If `buffer' is nil, kill all processes.
4994 Since we have no subprocesses, this does nothing. */
4997 kill_buffer_processes (buffer
)
5010 defsubr (&Sget_buffer_process
);
5011 defsubr (&Sprocess_inherit_coding_system_flag
);
5015 #endif /* not subprocesses */