1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999,
3 2001, 2002 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
23 #define _GNU_SOURCE /* to get strsignal declared with glibc 2 */
27 /* This file is split into two parts by the following preprocessor
28 conditional. The 'then' clause contains all of the support for
29 asynchronous subprocesses. The 'else' clause contains stub
30 versions of some of the asynchronous subprocess routines that are
31 often called elsewhere in Emacs, so we don't have to #ifdef the
32 sections that call them. */
40 #include <sys/types.h> /* some typedefs are used in sys/file.h */
47 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
50 #endif /* not WINDOWSNT */
52 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
53 #include <sys/socket.h>
55 #include <netinet/in.h>
56 #include <arpa/inet.h>
57 #ifdef NEED_NET_ERRNO_H
58 #include <net/errno.h>
59 #endif /* NEED_NET_ERRNO_H */
61 /* Are local (unix) sockets supported? */
62 #if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM)
63 #if !defined (AF_LOCAL) && defined (AF_UNIX)
64 #define AF_LOCAL AF_UNIX
67 #define HAVE_LOCAL_SOCKETS
71 #endif /* HAVE_SOCKETS */
73 /* TERM is a poor-man's SLIP, used on GNU/Linux. */
78 /* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */
79 #ifdef HAVE_BROKEN_INET_ADDR
80 #define IN_ADDR struct in_addr
81 #define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
83 #define IN_ADDR unsigned long
84 #define NUMERIC_ADDR_ERROR (numeric_addr == -1)
87 #if defined(BSD_SYSTEM) || defined(STRIDE)
88 #include <sys/ioctl.h>
89 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
91 #endif /* HAVE_PTYS and no O_NDELAY */
92 #endif /* BSD_SYSTEM || STRIDE */
94 #ifdef BROKEN_O_NONBLOCK
96 #endif /* BROKEN_O_NONBLOCK */
103 #include <sys/sysmacros.h> /* for "minor" */
104 #endif /* not IRIS */
115 #include "termhooks.h"
116 #include "termopts.h"
117 #include "commands.h"
118 #include "keyboard.h"
120 #include "blockinput.h"
121 #include "dispextern.h"
122 #include "composite.h"
125 Lisp_Object Qprocessp
;
126 Lisp_Object Qrun
, Qstop
, Qsignal
;
127 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
128 Lisp_Object Qlocal
, Qdatagram
;
129 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
130 Lisp_Object QClocal
, QCremote
, QCcoding
;
131 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
132 Lisp_Object QCsentinel
, QClog
, QCoptions
;
133 Lisp_Object Qlast_nonmenu_event
;
134 /* QCfamily is declared and initialized in xfaces.c,
135 QCfilter in keyboard.c. */
136 extern Lisp_Object QCfamily
, QCfilter
;
138 /* Qexit is declared and initialized in eval.c. */
140 /* a process object is a network connection when its childp field is neither
141 Qt nor Qnil but is instead a cons cell (HOSTNAME PORTNUM). */
144 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
145 #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
147 #define NETCONN_P(p) 0
148 #define NETCONN1_P(p) 0
149 #endif /* HAVE_SOCKETS */
151 /* Define first descriptor number available for subprocesses. */
153 #define FIRST_PROC_DESC 1
155 #define FIRST_PROC_DESC 3
158 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
161 #if !defined (SIGCHLD) && defined (SIGCLD)
162 #define SIGCHLD SIGCLD
165 #include "syssignal.h"
169 extern void set_waiting_for_input
P_ ((EMACS_TIME
*));
175 extern char *sys_errlist
[];
182 /* t means use pty, nil means use a pipe,
183 maybe other values to come. */
184 static Lisp_Object Vprocess_connection_type
;
188 #include <sys/socket.h>
192 /* These next two vars are non-static since sysdep.c uses them in the
193 emulation of `select'. */
194 /* Number of events of change of status of a process. */
196 /* Number of events for which the user or sentinel has been notified. */
199 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
201 #ifdef BROKEN_NON_BLOCKING_CONNECT
202 #undef NON_BLOCKING_CONNECT
204 #ifndef NON_BLOCKING_CONNECT
207 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
208 #if defined (O_NONBLOCK) || defined (O_NDELAY)
209 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
210 #define NON_BLOCKING_CONNECT
211 #endif /* EWOULDBLOCK || EINPROGRESS */
212 #endif /* O_NONBLOCK || O_NDELAY */
213 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
214 #endif /* HAVE_SELECT */
215 #endif /* HAVE_SOCKETS */
216 #endif /* NON_BLOCKING_CONNECT */
217 #endif /* BROKEN_NON_BLOCKING_CONNECT */
219 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
220 this system. We need to read full packets, so we need a
221 "non-destructive" select. So we require either native select,
222 or emulation of select using FIONREAD. */
224 #ifdef BROKEN_DATAGRAM_SOCKETS
225 #undef DATAGRAM_SOCKETS
227 #ifndef DATAGRAM_SOCKETS
229 #if defined (HAVE_SELECT) || defined (FIONREAD)
230 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
231 #define DATAGRAM_SOCKETS
232 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
233 #endif /* HAVE_SELECT || FIONREAD */
234 #endif /* HAVE_SOCKETS */
235 #endif /* DATAGRAM_SOCKETS */
236 #endif /* BROKEN_DATAGRAM_SOCKETS */
239 #undef NON_BLOCKING_CONNECT
240 #undef DATAGRAM_SOCKETS
244 #include "sysselect.h"
246 extern int keyboard_bit_set
P_ ((SELECT_TYPE
*));
248 /* If we support a window system, turn on the code to poll periodically
249 to detect C-g. It isn't actually used when doing interrupt input. */
250 #ifdef HAVE_WINDOW_SYSTEM
251 #define POLL_FOR_INPUT
254 /* Mask of bits indicating the descriptors that we wait for input on. */
256 static SELECT_TYPE input_wait_mask
;
258 /* Mask that excludes keyboard input descriptor (s). */
260 static SELECT_TYPE non_keyboard_wait_mask
;
262 /* Mask that excludes process input descriptor (s). */
264 static SELECT_TYPE non_process_wait_mask
;
266 /* Mask of bits indicating the descriptors that we wait for connect to
267 complete on. Once they complete, they are removed from this mask
268 and added to the input_wait_mask and non_keyboard_wait_mask. */
270 static SELECT_TYPE connect_wait_mask
;
272 /* Number of bits set in connect_wait_mask. */
273 static int num_pending_connects
;
275 /* The largest descriptor currently in use for a process object. */
276 static int max_process_desc
;
278 /* The largest descriptor currently in use for keyboard input. */
279 static int max_keyboard_desc
;
281 /* Nonzero means delete a process right away if it exits. */
282 static int delete_exited_processes
;
284 /* Indexed by descriptor, gives the process (if any) for that descriptor */
285 Lisp_Object chan_process
[MAXDESC
];
287 /* Alist of elements (NAME . PROCESS) */
288 Lisp_Object Vprocess_alist
;
290 /* Buffered-ahead input char from process, indexed by channel.
291 -1 means empty (no char is buffered).
292 Used on sys V where the only way to tell if there is any
293 output from the process is to read at least one char.
294 Always -1 on systems that support FIONREAD. */
296 /* Don't make static; need to access externally. */
297 int proc_buffered_char
[MAXDESC
];
299 /* Table of `struct coding-system' for each process. */
300 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
301 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
303 #ifdef DATAGRAM_SOCKETS
304 /* Table of `partner address' for datagram sockets. */
305 struct sockaddr_and_len
{
308 } datagram_address
[MAXDESC
];
309 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
310 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
312 #define DATAGRAM_CHAN_P(chan) (0)
313 #define DATAGRAM_CONN_P(proc) (0)
316 static Lisp_Object
get_process ();
317 static void exec_sentinel ();
319 extern EMACS_TIME
timer_check ();
320 extern int timers_run
;
322 /* Maximum number of bytes to send to a pty without an eof. */
323 static int pty_max_bytes
;
325 extern Lisp_Object Vfile_name_coding_system
, Vdefault_file_name_coding_system
;
328 /* The file name of the pty opened by allocate_pty. */
330 static char pty_name
[24];
333 /* Compute the Lisp form of the process status, p->status, from
334 the numeric status that was returned by `wait'. */
336 Lisp_Object
status_convert ();
340 struct Lisp_Process
*p
;
342 union { int i
; WAITTYPE wt
; } u
;
343 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
344 p
->status
= status_convert (u
.wt
);
345 p
->raw_status_low
= Qnil
;
346 p
->raw_status_high
= Qnil
;
349 /* Convert a process status word in Unix format to
350 the list that we use internally. */
357 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
358 else if (WIFEXITED (w
))
359 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
360 WCOREDUMP (w
) ? Qt
: Qnil
));
361 else if (WIFSIGNALED (w
))
362 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
363 WCOREDUMP (w
) ? Qt
: Qnil
));
368 /* Given a status-list, extract the three pieces of information
369 and store them individually through the three pointers. */
372 decode_status (l
, symbol
, code
, coredump
)
390 *code
= XFASTINT (XCAR (tem
));
392 *coredump
= !NILP (tem
);
396 /* Return a string describing a process status list. */
399 status_message (status
)
404 Lisp_Object string
, string2
;
406 decode_status (status
, &symbol
, &code
, &coredump
);
408 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
411 synchronize_system_messages_locale ();
412 signame
= strsignal (code
);
415 string
= build_string (signame
);
416 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
417 XSTRING (string
)->data
[0] = DOWNCASE (XSTRING (string
)->data
[0]);
418 return concat2 (string
, string2
);
420 else if (EQ (symbol
, Qexit
))
423 return build_string ("finished\n");
424 string
= Fnumber_to_string (make_number (code
));
425 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
426 return concat3 (build_string ("exited abnormally with code "),
429 else if (EQ (symbol
, Qfailed
))
431 string
= Fnumber_to_string (make_number (code
));
432 string2
= build_string ("\n");
433 return concat3 (build_string ("failed with code "),
437 return Fcopy_sequence (Fsymbol_name (symbol
));
442 /* Open an available pty, returning a file descriptor.
443 Return -1 on failure.
444 The file name of the terminal corresponding to the pty
445 is left in the variable pty_name. */
454 /* Some systems name their pseudoterminals so that there are gaps in
455 the usual sequence - for example, on HP9000/S700 systems, there
456 are no pseudoterminals with names ending in 'f'. So we wait for
457 three failures in a row before deciding that we've reached the
459 int failed_count
= 0;
464 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
465 for (i
= 0; i
< 16; i
++)
468 #ifdef PTY_NAME_SPRINTF
471 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
472 #endif /* no PTY_NAME_SPRINTF */
476 #else /* no PTY_OPEN */
478 /* Unusual IRIS code */
479 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
482 if (fstat (fd
, &stb
) < 0)
485 if (stat (pty_name
, &stb
) < 0)
488 if (failed_count
>= 3)
494 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
496 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
498 #endif /* not IRIS */
499 #endif /* no PTY_OPEN */
503 /* check to make certain that both sides are available
504 this avoids a nasty yet stupid bug in rlogins */
505 #ifdef PTY_TTY_NAME_SPRINTF
508 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
509 #endif /* no PTY_TTY_NAME_SPRINTF */
511 if (access (pty_name
, 6) != 0)
514 #if !defined(IRIS) && !defined(__sgi)
520 #endif /* not UNIPLUS */
527 #endif /* HAVE_PTYS */
533 register Lisp_Object val
, tem
, name1
;
534 register struct Lisp_Process
*p
;
538 p
= allocate_process ();
540 XSETINT (p
->infd
, -1);
541 XSETINT (p
->outfd
, -1);
542 XSETFASTINT (p
->pid
, 0);
543 XSETFASTINT (p
->tick
, 0);
544 XSETFASTINT (p
->update_tick
, 0);
545 p
->raw_status_low
= Qnil
;
546 p
->raw_status_high
= Qnil
;
548 p
->mark
= Fmake_marker ();
550 /* If name is already in use, modify it until it is unused. */
555 tem
= Fget_process (name1
);
556 if (NILP (tem
)) break;
557 sprintf (suffix
, "<%d>", i
);
558 name1
= concat2 (name
, build_string (suffix
));
562 XSETPROCESS (val
, p
);
563 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
568 remove_process (proc
)
569 register Lisp_Object proc
;
571 register Lisp_Object pair
;
573 pair
= Frassq (proc
, Vprocess_alist
);
574 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
576 deactivate_process (proc
);
579 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
580 doc
: /* Return t if OBJECT is a process. */)
584 return PROCESSP (object
) ? Qt
: Qnil
;
587 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
588 doc
: /* Return the process named NAME, or nil if there is none. */)
590 register Lisp_Object name
;
595 return Fcdr (Fassoc (name
, Vprocess_alist
));
598 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
599 doc
: /* Return the (or a) process associated with BUFFER.
600 BUFFER may be a buffer or the name of one. */)
602 register Lisp_Object buffer
;
604 register Lisp_Object buf
, tail
, proc
;
606 if (NILP (buffer
)) return Qnil
;
607 buf
= Fget_buffer (buffer
);
608 if (NILP (buf
)) return Qnil
;
610 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
612 proc
= Fcdr (Fcar (tail
));
613 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
619 /* This is how commands for the user decode process arguments. It
620 accepts a process, a process name, a buffer, a buffer name, or nil.
621 Buffers denote the first process in the buffer, and nil denotes the
626 register Lisp_Object name
;
628 register Lisp_Object proc
, obj
;
631 obj
= Fget_process (name
);
633 obj
= Fget_buffer (name
);
635 error ("Process %s does not exist", XSTRING (name
)->data
);
637 else if (NILP (name
))
638 obj
= Fcurrent_buffer ();
642 /* Now obj should be either a buffer object or a process object.
646 proc
= Fget_buffer_process (obj
);
648 error ("Buffer %s has no process", XSTRING (XBUFFER (obj
)->name
)->data
);
658 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
659 doc
: /* Delete PROCESS: kill it and forget about it immediately.
660 PROCESS may be a process, a buffer, the name of a process or buffer, or
661 nil, indicating the current buffer's process. */)
663 register Lisp_Object process
;
665 process
= get_process (process
);
666 XPROCESS (process
)->raw_status_low
= Qnil
;
667 XPROCESS (process
)->raw_status_high
= Qnil
;
668 if (NETCONN_P (process
))
670 XPROCESS (process
)->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
671 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
673 else if (XINT (XPROCESS (process
)->infd
) >= 0)
675 Fkill_process (process
, Qnil
);
676 /* Do this now, since remove_process will make sigchld_handler do nothing. */
677 XPROCESS (process
)->status
678 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
679 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
682 remove_process (process
);
686 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
687 doc
: /* Return the status of PROCESS.
688 The returned value is one of the following symbols:
689 run -- for a process that is running.
690 stop -- for a process stopped but continuable.
691 exit -- for a process that has exited.
692 signal -- for a process that has got a fatal signal.
693 open -- for a network stream connection that is open.
694 listen -- for a network stream server that is listening.
695 closed -- for a network stream connection that is closed.
696 connect -- when waiting for a non-blocking connection to complete.
697 failed -- when a non-blocking connection has failed.
698 nil -- if arg is a process name and no such process exists.
699 PROCESS may be a process, a buffer, the name of a process, or
700 nil, indicating the current buffer's process. */)
702 register Lisp_Object process
;
704 register struct Lisp_Process
*p
;
705 register Lisp_Object status
;
707 if (STRINGP (process
))
708 process
= Fget_process (process
);
710 process
= get_process (process
);
715 p
= XPROCESS (process
);
716 if (!NILP (p
->raw_status_low
))
720 status
= XCAR (status
);
723 if (EQ (status
, Qexit
))
725 else if (EQ (p
->command
, Qt
))
727 else if (EQ (status
, Qrun
))
733 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
735 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
736 If PROCESS has not yet exited or died, return 0. */)
738 register Lisp_Object process
;
740 CHECK_PROCESS (process
);
741 if (!NILP (XPROCESS (process
)->raw_status_low
))
742 update_status (XPROCESS (process
));
743 if (CONSP (XPROCESS (process
)->status
))
744 return XCAR (XCDR (XPROCESS (process
)->status
));
745 return make_number (0);
748 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
749 doc
: /* Return the process id of PROCESS.
750 This is the pid of the Unix process which PROCESS uses or talks to.
751 For a network connection, this value is nil. */)
753 register Lisp_Object process
;
755 CHECK_PROCESS (process
);
756 return XPROCESS (process
)->pid
;
759 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
760 doc
: /* Return the name of PROCESS, as a string.
761 This is the name of the program invoked in PROCESS,
762 possibly modified to make it unique among process names. */)
764 register Lisp_Object process
;
766 CHECK_PROCESS (process
);
767 return XPROCESS (process
)->name
;
770 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
771 doc
: /* Return the command that was executed to start PROCESS.
772 This is a list of strings, the first string being the program executed
773 and the rest of the strings being the arguments given to it.
774 For a non-child channel, this is nil. */)
776 register Lisp_Object process
;
778 CHECK_PROCESS (process
);
779 return XPROCESS (process
)->command
;
782 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
783 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
784 This is the terminal that the process itself reads and writes on,
785 not the name of the pty that Emacs uses to talk with that terminal. */)
787 register Lisp_Object process
;
789 CHECK_PROCESS (process
);
790 return XPROCESS (process
)->tty_name
;
793 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
795 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
797 register Lisp_Object process
, buffer
;
799 struct Lisp_Process
*p
;
801 CHECK_PROCESS (process
);
803 CHECK_BUFFER (buffer
);
804 p
= XPROCESS (process
);
807 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
811 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
813 doc
: /* Return the buffer PROCESS is associated with.
814 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
816 register Lisp_Object process
;
818 CHECK_PROCESS (process
);
819 return XPROCESS (process
)->buffer
;
822 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
824 doc
: /* Return the marker for the end of the last output from PROCESS. */)
826 register Lisp_Object process
;
828 CHECK_PROCESS (process
);
829 return XPROCESS (process
)->mark
;
832 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
834 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
835 t means stop accepting output from the process.
836 When a process has a filter, each time it does output
837 the entire string of output is passed to the filter.
838 The filter gets two arguments: the process and the string of output.
839 If the process has a filter, its buffer is not used for output. */)
841 register Lisp_Object process
, filter
;
843 struct Lisp_Process
*p
;
845 CHECK_PROCESS (process
);
846 p
= XPROCESS (process
);
848 /* Don't signal an error if the process' input file descriptor
849 is closed. This could make debugging Lisp more difficult,
850 for example when doing something like
852 (setq process (start-process ...))
854 (set-process-filter process ...) */
856 if (XINT (p
->infd
) >= 0)
858 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
860 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
861 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
863 else if (EQ (p
->filter
, Qt
)
864 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
866 FD_SET (XINT (p
->infd
), &input_wait_mask
);
867 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
873 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
877 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
879 doc
: /* Returns the filter function of PROCESS; nil if none.
880 See `set-process-filter' for more info on filter functions. */)
882 register Lisp_Object process
;
884 CHECK_PROCESS (process
);
885 return XPROCESS (process
)->filter
;
888 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
890 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
891 The sentinel is called as a function when the process changes state.
892 It gets two arguments: the process, and a string describing the change. */)
894 register Lisp_Object process
, sentinel
;
896 CHECK_PROCESS (process
);
897 XPROCESS (process
)->sentinel
= sentinel
;
901 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
903 doc
: /* Return the sentinel of PROCESS; nil if none.
904 See `set-process-sentinel' for more info on sentinels. */)
906 register Lisp_Object process
;
908 CHECK_PROCESS (process
);
909 return XPROCESS (process
)->sentinel
;
912 DEFUN ("set-process-window-size", Fset_process_window_size
,
913 Sset_process_window_size
, 3, 3, 0,
914 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
915 (process
, height
, width
)
916 register Lisp_Object process
, height
, width
;
918 CHECK_PROCESS (process
);
919 CHECK_NATNUM (height
);
920 CHECK_NATNUM (width
);
922 if (XINT (XPROCESS (process
)->infd
) < 0
923 || set_window_size (XINT (XPROCESS (process
)->infd
),
924 XINT (height
), XINT (width
)) <= 0)
930 DEFUN ("set-process-inherit-coding-system-flag",
931 Fset_process_inherit_coding_system_flag
,
932 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
933 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
934 If the second argument FLAG is non-nil, then the variable
935 `buffer-file-coding-system' of the buffer associated with PROCESS
936 will be bound to the value of the coding system used to decode
939 This is useful when the coding system specified for the process buffer
940 leaves either the character code conversion or the end-of-line conversion
941 unspecified, or if the coding system used to decode the process output
942 is more appropriate for saving the process buffer.
944 Binding the variable `inherit-process-coding-system' to non-nil before
945 starting the process is an alternative way of setting the inherit flag
946 for the process which will run. */)
948 register Lisp_Object process
, flag
;
950 CHECK_PROCESS (process
);
951 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
955 DEFUN ("process-inherit-coding-system-flag",
956 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
958 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
959 If this flag is t, `buffer-file-coding-system' of the buffer
960 associated with PROCESS will inherit the coding system used to decode
961 the process output. */)
963 register Lisp_Object process
;
965 CHECK_PROCESS (process
);
966 return XPROCESS (process
)->inherit_coding_system_flag
;
969 DEFUN ("set-process-query-on-exit-flag",
970 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
972 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
973 If the second argument FLAG is non-nil, emacs will query the user before
974 exiting if PROCESS is running. */)
976 register Lisp_Object process
, flag
;
978 CHECK_PROCESS (process
);
979 XPROCESS (process
)->kill_without_query
= Fnull (flag
);
983 DEFUN ("process-query-on-exit-flag",
984 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
986 doc
: /* Return the current value of query on exit flag for PROCESS. */)
988 register Lisp_Object process
;
990 CHECK_PROCESS (process
);
991 return Fnull (XPROCESS (process
)->kill_without_query
);
994 #ifdef DATAGRAM_SOCKETS
995 Lisp_Object
Fprocess_datagram_address ();
998 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1000 doc
: /* Return the contact info of PROCESS; t for a real child.
1001 For a net connection, the value depends on the optional KEY arg.
1002 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1003 if KEY is t, the complete contact information for the connection is
1004 returned, else the specific value for the keyword KEY is returned.
1005 See `make-network-process' for a list of keywords. */)
1007 register Lisp_Object process
, key
;
1009 Lisp_Object contact
;
1011 CHECK_PROCESS (process
);
1012 contact
= XPROCESS (process
)->childp
;
1014 #ifdef DATAGRAM_SOCKETS
1015 if (DATAGRAM_CONN_P (process
)
1016 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1017 contact
= Fplist_put (contact
, QCremote
,
1018 Fprocess_datagram_address (process
));
1021 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1024 return Fcons (Fplist_get (contact
, QChost
),
1025 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1026 return Fplist_get (contact
, key
);
1029 #if 0 /* Turned off because we don't currently record this info
1030 in the process. Perhaps add it. */
1031 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1032 doc
: /* Return the connection type of PROCESS.
1033 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1034 a socket connection. */)
1036 Lisp_Object process
;
1038 return XPROCESS (process
)->type
;
1043 list_processes_1 (query_only
)
1044 Lisp_Object query_only
;
1046 register Lisp_Object tail
, tem
;
1047 Lisp_Object proc
, minspace
, tem1
;
1048 register struct Lisp_Process
*p
;
1050 int w_proc
, w_buffer
, w_tty
;
1051 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1053 w_proc
= 4; /* Proc */
1054 w_buffer
= 6; /* Buffer */
1055 w_tty
= 0; /* Omit if no ttys */
1057 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1061 proc
= Fcdr (Fcar (tail
));
1062 p
= XPROCESS (proc
);
1063 if (NILP (p
->childp
))
1065 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1067 if (STRINGP (p
->name
)
1068 && ( i
= XSTRING (p
->name
)->size
, (i
> w_proc
)))
1070 if (!NILP (p
->buffer
))
1072 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1073 w_buffer
= 8; /* (Killed) */
1074 else if ((i
= XSTRING (XBUFFER (p
->buffer
)->name
)->size
, (i
> w_buffer
)))
1077 if (STRINGP (p
->tty_name
)
1078 && (i
= XSTRING (p
->tty_name
)->size
, (i
> w_tty
)))
1082 XSETFASTINT (i_status
, w_proc
+ 1);
1083 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1086 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1087 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1090 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1093 XSETFASTINT (minspace
, 1);
1095 set_buffer_internal (XBUFFER (Vstandard_output
));
1096 Fbuffer_disable_undo (Vstandard_output
);
1098 current_buffer
->truncate_lines
= Qt
;
1100 write_string ("Proc", -1);
1101 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1102 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1105 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1107 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1108 write_string ("\n", -1);
1110 write_string ("----", -1);
1111 Findent_to (i_status
, minspace
); write_string ("------", -1);
1112 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1115 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1117 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1118 write_string ("\n", -1);
1120 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1124 proc
= Fcdr (Fcar (tail
));
1125 p
= XPROCESS (proc
);
1126 if (NILP (p
->childp
))
1128 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1131 Finsert (1, &p
->name
);
1132 Findent_to (i_status
, minspace
);
1134 if (!NILP (p
->raw_status_low
))
1137 if (CONSP (p
->status
))
1138 symbol
= XCAR (p
->status
);
1141 if (EQ (symbol
, Qsignal
))
1144 tem
= Fcar (Fcdr (p
->status
));
1146 if (XINT (tem
) < NSIG
)
1147 write_string (sys_errlist
[XINT (tem
)], -1);
1150 Fprinc (symbol
, Qnil
);
1152 else if (NETCONN1_P (p
))
1154 if (EQ (symbol
, Qexit
))
1155 write_string ("closed", -1);
1156 else if (EQ (p
->command
, Qt
))
1157 write_string ("stopped", -1);
1158 else if (EQ (symbol
, Qrun
))
1159 write_string ("open", -1);
1161 Fprinc (symbol
, Qnil
);
1164 Fprinc (symbol
, Qnil
);
1166 if (EQ (symbol
, Qexit
))
1169 tem
= Fcar (Fcdr (p
->status
));
1172 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1173 write_string (tembuf
, -1);
1177 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
1178 remove_process (proc
);
1180 Findent_to (i_buffer
, minspace
);
1181 if (NILP (p
->buffer
))
1182 insert_string ("(none)");
1183 else if (NILP (XBUFFER (p
->buffer
)->name
))
1184 insert_string ("(Killed)");
1186 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1190 Findent_to (i_tty
, minspace
);
1191 if (STRINGP (p
->tty_name
))
1192 Finsert (1, &p
->tty_name
);
1195 Findent_to (i_command
, minspace
);
1197 if (EQ (p
->status
, Qlisten
))
1199 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1200 if (INTEGERP (port
))
1201 port
= Fnumber_to_string (port
);
1202 sprintf (tembuf
, "(network %s server on %s)\n",
1203 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1204 XSTRING (port
)->data
);
1205 insert_string (tembuf
);
1207 else if (NETCONN1_P (p
))
1209 /* For a local socket, there is no host name,
1210 so display service instead. */
1211 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1212 if (!STRINGP (host
))
1214 host
= Fplist_get (p
->childp
, QCservice
);
1215 if (INTEGERP (host
))
1216 host
= Fnumber_to_string (host
);
1218 sprintf (tembuf
, "(network %s connection to %s)\n",
1219 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1220 XSTRING (host
)->data
);
1221 insert_string (tembuf
);
1233 insert_string (" ");
1235 insert_string ("\n");
1241 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1242 doc
: /* Display a list of all processes.
1243 If optional argument QUERY-ONLY is non-nil, only processes with
1244 the query-on-exit flag set will be listed.
1245 Any process listed as exited or signaled is actually eliminated
1246 after the listing is made. */)
1248 Lisp_Object query_only
;
1250 internal_with_output_to_temp_buffer ("*Process List*",
1251 list_processes_1
, query_only
);
1255 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1256 doc
: /* Return a list of all processes. */)
1259 return Fmapcar (Qcdr
, Vprocess_alist
);
1262 /* Starting asynchronous inferior processes. */
1264 static Lisp_Object
start_process_unwind ();
1266 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1267 doc
: /* Start a program in a subprocess. Return the process object for it.
1268 NAME is name for process. It is modified if necessary to make it unique.
1269 BUFFER is the buffer or (buffer-name) to associate with the process.
1270 Process output goes at end of that buffer, unless you specify
1271 an output stream or filter function to handle the output.
1272 BUFFER may be also nil, meaning that this process is not associated
1274 Third arg is program file name. It is searched for in PATH.
1275 Remaining arguments are strings to give program as arguments.
1277 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1280 register Lisp_Object
*args
;
1282 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1284 register unsigned char *new_argv
;
1287 register unsigned char **new_argv
;
1290 int count
= specpdl_ptr
- specpdl
;
1294 buffer
= Fget_buffer_create (buffer
);
1296 /* Make sure that the child will be able to chdir to the current
1297 buffer's current directory, or its unhandled equivalent. We
1298 can't just have the child check for an error when it does the
1299 chdir, since it's in a vfork.
1301 We have to GCPRO around this because Fexpand_file_name and
1302 Funhandled_file_name_directory might call a file name handling
1303 function. The argument list is protected by the caller, so all
1304 we really have to worry about is buffer. */
1306 struct gcpro gcpro1
, gcpro2
;
1308 current_dir
= current_buffer
->directory
;
1310 GCPRO2 (buffer
, current_dir
);
1313 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1315 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1316 report_file_error ("Setting current directory",
1317 Fcons (current_buffer
->directory
, Qnil
));
1323 CHECK_STRING (name
);
1327 CHECK_STRING (program
);
1329 proc
= make_process (name
);
1330 /* If an error occurs and we can't start the process, we want to
1331 remove it from the process list. This means that each error
1332 check in create_process doesn't need to call remove_process
1333 itself; it's all taken care of here. */
1334 record_unwind_protect (start_process_unwind
, proc
);
1336 XPROCESS (proc
)->childp
= Qt
;
1337 XPROCESS (proc
)->command_channel_p
= Qnil
;
1338 XPROCESS (proc
)->buffer
= buffer
;
1339 XPROCESS (proc
)->sentinel
= Qnil
;
1340 XPROCESS (proc
)->filter
= Qnil
;
1341 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1343 /* Make the process marker point into the process buffer (if any). */
1345 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1346 BUF_ZV (XBUFFER (buffer
)),
1347 BUF_ZV_BYTE (XBUFFER (buffer
)));
1350 /* Decide coding systems for communicating with the process. Here
1351 we don't setup the structure coding_system nor pay attention to
1352 unibyte mode. They are done in create_process. */
1354 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1355 Lisp_Object coding_systems
= Qt
;
1356 Lisp_Object val
, *args2
;
1357 struct gcpro gcpro1
, gcpro2
;
1359 val
= Vcoding_system_for_read
;
1362 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1363 args2
[0] = Qstart_process
;
1364 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1365 GCPRO2 (proc
, current_dir
);
1366 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1368 if (CONSP (coding_systems
))
1369 val
= XCAR (coding_systems
);
1370 else if (CONSP (Vdefault_process_coding_system
))
1371 val
= XCAR (Vdefault_process_coding_system
);
1373 XPROCESS (proc
)->decode_coding_system
= val
;
1375 val
= Vcoding_system_for_write
;
1378 if (EQ (coding_systems
, Qt
))
1380 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1381 args2
[0] = Qstart_process
;
1382 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1383 GCPRO2 (proc
, current_dir
);
1384 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1387 if (CONSP (coding_systems
))
1388 val
= XCDR (coding_systems
);
1389 else if (CONSP (Vdefault_process_coding_system
))
1390 val
= XCDR (Vdefault_process_coding_system
);
1392 XPROCESS (proc
)->encode_coding_system
= val
;
1396 /* Make a one member argv with all args concatenated
1397 together separated by a blank. */
1398 len
= STRING_BYTES (XSTRING (program
)) + 2;
1399 for (i
= 3; i
< nargs
; i
++)
1403 len
+= STRING_BYTES (XSTRING (tem
)) + 1; /* count the blank */
1405 new_argv
= (unsigned char *) alloca (len
);
1406 strcpy (new_argv
, XSTRING (program
)->data
);
1407 for (i
= 3; i
< nargs
; i
++)
1411 strcat (new_argv
, " ");
1412 strcat (new_argv
, XSTRING (tem
)->data
);
1414 /* Need to add code here to check for program existence on VMS */
1417 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1419 /* If program file name is not absolute, search our path for it */
1420 if (!IS_DIRECTORY_SEP (XSTRING (program
)->data
[0])
1421 && !(XSTRING (program
)->size
> 1
1422 && IS_DEVICE_SEP (XSTRING (program
)->data
[1])))
1424 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1427 GCPRO4 (name
, program
, buffer
, current_dir
);
1428 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, 1);
1431 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1432 tem
= Fexpand_file_name (tem
, Qnil
);
1433 tem
= ENCODE_FILE (tem
);
1434 new_argv
[0] = XSTRING (tem
)->data
;
1438 if (!NILP (Ffile_directory_p (program
)))
1439 error ("Specified program for new process is a directory");
1441 tem
= ENCODE_FILE (program
);
1442 new_argv
[0] = XSTRING (tem
)->data
;
1445 /* Here we encode arguments by the coding system used for sending
1446 data to the process. We don't support using different coding
1447 systems for encoding arguments and for encoding data sent to the
1450 for (i
= 3; i
< nargs
; i
++)
1454 if (STRING_MULTIBYTE (tem
))
1455 tem
= (code_convert_string_norecord
1456 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1457 new_argv
[i
- 2] = XSTRING (tem
)->data
;
1459 new_argv
[i
- 2] = 0;
1460 #endif /* not VMS */
1462 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1463 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1464 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1465 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1467 XPROCESS (proc
)->inherit_coding_system_flag
1468 = (NILP (buffer
) || !inherit_process_coding_system
1471 create_process (proc
, (char **) new_argv
, current_dir
);
1473 return unbind_to (count
, proc
);
1476 /* This function is the unwind_protect form for Fstart_process. If
1477 PROC doesn't have its pid set, then we know someone has signaled
1478 an error and the process wasn't started successfully, so we should
1479 remove it from the process list. */
1481 start_process_unwind (proc
)
1484 if (!PROCESSP (proc
))
1487 /* Was PROC started successfully? */
1488 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1489 remove_process (proc
);
1495 create_process_1 (timer
)
1496 struct atimer
*timer
;
1498 /* Nothing to do. */
1502 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1505 /* Mimic blocking of signals on system V, which doesn't really have it. */
1507 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1508 int sigchld_deferred
;
1511 create_process_sigchld ()
1513 signal (SIGCHLD
, create_process_sigchld
);
1515 sigchld_deferred
= 1;
1521 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1523 create_process (process
, new_argv
, current_dir
)
1524 Lisp_Object process
;
1526 Lisp_Object current_dir
;
1528 int pid
, inchannel
, outchannel
;
1530 #ifdef POSIX_SIGNALS
1533 struct sigaction sigint_action
;
1534 struct sigaction sigquit_action
;
1536 struct sigaction sighup_action
;
1538 #else /* !POSIX_SIGNALS */
1541 SIGTYPE (*sigchld
)();
1544 #endif /* !POSIX_SIGNALS */
1545 /* Use volatile to protect variables from being clobbered by longjmp. */
1546 volatile int forkin
, forkout
;
1547 volatile int pty_flag
= 0;
1549 extern char **environ
;
1552 inchannel
= outchannel
= -1;
1555 if (!NILP (Vprocess_connection_type
))
1556 outchannel
= inchannel
= allocate_pty ();
1561 /* On USG systems it does not work to open the pty's tty here
1562 and then close and reopen it in the child. */
1564 /* Don't let this terminal become our controlling terminal
1565 (in case we don't have one). */
1566 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1568 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1571 report_file_error ("Opening pty", Qnil
);
1573 forkin
= forkout
= -1;
1574 #endif /* not USG */
1578 #endif /* HAVE_PTYS */
1581 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1582 report_file_error ("Opening socketpair", Qnil
);
1583 outchannel
= inchannel
= sv
[0];
1584 forkout
= forkin
= sv
[1];
1586 #else /* not SKTPAIR */
1591 report_file_error ("Creating pipe", Qnil
);
1597 emacs_close (inchannel
);
1598 emacs_close (forkout
);
1599 report_file_error ("Creating pipe", Qnil
);
1604 #endif /* not SKTPAIR */
1607 /* Replaced by close_process_descs */
1608 set_exclusive_use (inchannel
);
1609 set_exclusive_use (outchannel
);
1612 /* Stride people say it's a mystery why this is needed
1613 as well as the O_NDELAY, but that it fails without this. */
1614 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1617 ioctl (inchannel
, FIONBIO
, &one
);
1622 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1623 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1626 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1627 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1631 /* Record this as an active process, with its channels.
1632 As a result, child_setup will close Emacs's side of the pipes. */
1633 chan_process
[inchannel
] = process
;
1634 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1635 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1636 /* Record the tty descriptor used in the subprocess. */
1638 XPROCESS (process
)->subtty
= Qnil
;
1640 XSETFASTINT (XPROCESS (process
)->subtty
, forkin
);
1641 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1642 XPROCESS (process
)->status
= Qrun
;
1643 if (!proc_decode_coding_system
[inchannel
])
1644 proc_decode_coding_system
[inchannel
]
1645 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
1646 setup_coding_system (XPROCESS (process
)->decode_coding_system
,
1647 proc_decode_coding_system
[inchannel
]);
1648 if (!proc_encode_coding_system
[outchannel
])
1649 proc_encode_coding_system
[outchannel
]
1650 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
1651 setup_coding_system (XPROCESS (process
)->encode_coding_system
,
1652 proc_encode_coding_system
[outchannel
]);
1654 /* Delay interrupts until we have a chance to store
1655 the new fork's pid in its process structure */
1656 #ifdef POSIX_SIGNALS
1657 sigemptyset (&blocked
);
1659 sigaddset (&blocked
, SIGCHLD
);
1661 #ifdef HAVE_WORKING_VFORK
1662 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1663 this sets the parent's signal handlers as well as the child's.
1664 So delay all interrupts whose handlers the child might munge,
1665 and record the current handlers so they can be restored later. */
1666 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1667 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1669 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1671 #endif /* HAVE_WORKING_VFORK */
1672 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1673 #else /* !POSIX_SIGNALS */
1677 #else /* not BSD4_1 */
1678 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1679 sigsetmask (sigmask (SIGCHLD
));
1680 #else /* ordinary USG */
1682 sigchld_deferred
= 0;
1683 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1685 #endif /* ordinary USG */
1686 #endif /* not BSD4_1 */
1687 #endif /* SIGCHLD */
1688 #endif /* !POSIX_SIGNALS */
1690 FD_SET (inchannel
, &input_wait_mask
);
1691 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1692 if (inchannel
> max_process_desc
)
1693 max_process_desc
= inchannel
;
1695 /* Until we store the proper pid, enable sigchld_handler
1696 to recognize an unknown pid as standing for this process.
1697 It is very important not to let this `marker' value stay
1698 in the table after this function has returned; if it does
1699 it might cause call-process to hang and subsequent asynchronous
1700 processes to get their return values scrambled. */
1701 XSETINT (XPROCESS (process
)->pid
, -1);
1706 /* child_setup must clobber environ on systems with true vfork.
1707 Protect it from permanent change. */
1708 char **save_environ
= environ
;
1710 current_dir
= ENCODE_FILE (current_dir
);
1715 #endif /* not WINDOWSNT */
1717 int xforkin
= forkin
;
1718 int xforkout
= forkout
;
1720 #if 0 /* This was probably a mistake--it duplicates code later on,
1721 but fails to handle all the cases. */
1722 /* Make sure SIGCHLD is not blocked in the child. */
1723 sigsetmask (SIGEMPTYMASK
);
1726 /* Make the pty be the controlling terminal of the process. */
1728 /* First, disconnect its current controlling terminal. */
1730 /* We tried doing setsid only if pty_flag, but it caused
1731 process_set_signal to fail on SGI when using a pipe. */
1733 /* Make the pty's terminal the controlling terminal. */
1737 /* We ignore the return value
1738 because faith@cs.unc.edu says that is necessary on Linux. */
1739 ioctl (xforkin
, TIOCSCTTY
, 0);
1742 #else /* not HAVE_SETSID */
1744 /* It's very important to call setpgrp here and no time
1745 afterwards. Otherwise, we lose our controlling tty which
1746 is set when we open the pty. */
1749 #endif /* not HAVE_SETSID */
1750 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1751 if (pty_flag
&& xforkin
>= 0)
1754 tcgetattr (xforkin
, &t
);
1756 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1757 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1760 #if defined (NTTYDISC) && defined (TIOCSETD)
1761 if (pty_flag
&& xforkin
>= 0)
1763 /* Use new line discipline. */
1764 int ldisc
= NTTYDISC
;
1765 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1770 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1771 can do TIOCSPGRP only to the process's controlling tty. */
1774 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1775 I can't test it since I don't have 4.3. */
1776 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
1777 ioctl (j
, TIOCNOTTY
, 0);
1780 /* In order to get a controlling terminal on some versions
1781 of BSD, it is necessary to put the process in pgrp 0
1782 before it opens the terminal. */
1790 #endif /* TIOCNOTTY */
1792 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
1793 /*** There is a suggestion that this ought to be a
1794 conditional on TIOCSPGRP,
1795 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1796 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1797 that system does seem to need this code, even though
1798 both HAVE_SETSID and TIOCSCTTY are defined. */
1799 /* Now close the pty (if we had it open) and reopen it.
1800 This makes the pty the controlling terminal of the subprocess. */
1803 #ifdef SET_CHILD_PTY_PGRP
1804 int pgrp
= getpid ();
1807 /* I wonder if emacs_close (emacs_open (pty_name, ...))
1810 emacs_close (xforkin
);
1811 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
1815 emacs_write (1, "Couldn't open the pty terminal ", 31);
1816 emacs_write (1, pty_name
, strlen (pty_name
));
1817 emacs_write (1, "\n", 1);
1821 #ifdef SET_CHILD_PTY_PGRP
1822 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
1823 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
1826 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
1828 #ifdef SETUP_SLAVE_PTY
1833 #endif /* SETUP_SLAVE_PTY */
1835 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1836 Now reenable it in the child, so it will die when we want it to. */
1838 signal (SIGHUP
, SIG_DFL
);
1840 #endif /* HAVE_PTYS */
1842 signal (SIGINT
, SIG_DFL
);
1843 signal (SIGQUIT
, SIG_DFL
);
1845 /* Stop blocking signals in the child. */
1846 #ifdef POSIX_SIGNALS
1847 sigprocmask (SIG_SETMASK
, &procmask
, 0);
1848 #else /* !POSIX_SIGNALS */
1852 #else /* not BSD4_1 */
1853 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1854 sigsetmask (SIGEMPTYMASK
);
1855 #else /* ordinary USG */
1857 signal (SIGCHLD
, sigchld
);
1859 #endif /* ordinary USG */
1860 #endif /* not BSD4_1 */
1861 #endif /* SIGCHLD */
1862 #endif /* !POSIX_SIGNALS */
1865 child_setup_tty (xforkout
);
1867 pid
= child_setup (xforkin
, xforkout
, xforkout
,
1868 new_argv
, 1, current_dir
);
1869 #else /* not WINDOWSNT */
1870 child_setup (xforkin
, xforkout
, xforkout
,
1871 new_argv
, 1, current_dir
);
1872 #endif /* not WINDOWSNT */
1874 environ
= save_environ
;
1879 /* This runs in the Emacs process. */
1883 emacs_close (forkin
);
1884 if (forkin
!= forkout
&& forkout
>= 0)
1885 emacs_close (forkout
);
1889 /* vfork succeeded. */
1890 XSETFASTINT (XPROCESS (process
)->pid
, pid
);
1893 register_child (pid
, inchannel
);
1894 #endif /* WINDOWSNT */
1896 /* If the subfork execv fails, and it exits,
1897 this close hangs. I don't know why.
1898 So have an interrupt jar it loose. */
1900 struct atimer
*timer
;
1904 EMACS_SET_SECS_USECS (offset
, 1, 0);
1905 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
1907 XPROCESS (process
)->subtty
= Qnil
;
1909 emacs_close (forkin
);
1911 cancel_atimer (timer
);
1915 if (forkin
!= forkout
&& forkout
>= 0)
1916 emacs_close (forkout
);
1920 XPROCESS (process
)->tty_name
= build_string (pty_name
);
1923 XPROCESS (process
)->tty_name
= Qnil
;
1926 /* Restore the signal state whether vfork succeeded or not.
1927 (We will signal an error, below, if it failed.) */
1928 #ifdef POSIX_SIGNALS
1929 #ifdef HAVE_WORKING_VFORK
1930 /* Restore the parent's signal handlers. */
1931 sigaction (SIGINT
, &sigint_action
, 0);
1932 sigaction (SIGQUIT
, &sigquit_action
, 0);
1934 sigaction (SIGHUP
, &sighup_action
, 0);
1936 #endif /* HAVE_WORKING_VFORK */
1937 /* Stop blocking signals in the parent. */
1938 sigprocmask (SIG_SETMASK
, &procmask
, 0);
1939 #else /* !POSIX_SIGNALS */
1943 #else /* not BSD4_1 */
1944 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1945 sigsetmask (SIGEMPTYMASK
);
1946 #else /* ordinary USG */
1948 signal (SIGCHLD
, sigchld
);
1949 /* Now really handle any of these signals
1950 that came in during this function. */
1951 if (sigchld_deferred
)
1952 kill (getpid (), SIGCHLD
);
1954 #endif /* ordinary USG */
1955 #endif /* not BSD4_1 */
1956 #endif /* SIGCHLD */
1957 #endif /* !POSIX_SIGNALS */
1959 /* Now generate the error if vfork failed. */
1961 report_file_error ("Doing vfork", Qnil
);
1963 #endif /* not VMS */
1968 /* Convert an internal struct sockaddr to a lisp object (vector or string).
1969 The address family of sa is not included in the result. */
1972 conv_sockaddr_to_lisp (sa
, len
)
1973 struct sockaddr
*sa
;
1976 Lisp_Object address
;
1979 register struct Lisp_Vector
*p
;
1981 switch (sa
->sa_family
)
1985 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
1986 len
= sizeof (sin
->sin_addr
) + 1;
1987 address
= Fmake_vector (make_number (len
), Qnil
);
1988 p
= XVECTOR (address
);
1989 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
1990 cp
= (unsigned char *)&sin
->sin_addr
;
1993 #ifdef HAVE_LOCAL_SOCKETS
1996 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
1997 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
1998 if (sockun
->sun_path
[i
] == 0)
2000 return make_unibyte_string (sockun
->sun_path
, i
);
2004 len
-= sizeof (sa
->sa_family
);
2005 address
= Fcons (make_number (sa
->sa_family
),
2006 Fmake_vector (make_number (len
), Qnil
));
2007 p
= XVECTOR (XCDR (address
));
2008 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2014 p
->contents
[i
++] = make_number (*cp
++);
2020 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2023 get_lisp_to_sockaddr_size (address
, familyp
)
2024 Lisp_Object address
;
2027 register struct Lisp_Vector
*p
;
2029 if (VECTORP (address
))
2031 p
= XVECTOR (address
);
2035 return sizeof (struct sockaddr_in
);
2038 #ifdef HAVE_LOCAL_SOCKETS
2039 else if (STRINGP (address
))
2041 *familyp
= AF_LOCAL
;
2042 return sizeof (struct sockaddr_un
);
2045 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2047 struct sockaddr
*sa
;
2048 *familyp
= XINT (XCAR (address
));
2049 p
= XVECTOR (XCDR (address
));
2050 return p
->size
+ sizeof (sa
->sa_family
);
2055 /* Convert an address object (vector or string) to an internal sockaddr.
2056 Format of address has already been validated by size_lisp_to_sockaddr. */
2059 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2061 Lisp_Object address
;
2062 struct sockaddr
*sa
;
2065 register struct Lisp_Vector
*p
;
2066 register unsigned char *cp
;
2070 sa
->sa_family
= family
;
2072 if (VECTORP (address
))
2074 p
= XVECTOR (address
);
2075 if (family
== AF_INET
)
2077 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2078 len
= sizeof (sin
->sin_addr
) + 1;
2079 i
= XINT (p
->contents
[--len
]);
2080 sin
->sin_port
= htons (i
);
2081 cp
= (unsigned char *)&sin
->sin_addr
;
2084 else if (STRINGP (address
))
2086 #ifdef HAVE_LOCAL_SOCKETS
2087 if (family
== AF_LOCAL
)
2089 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2090 cp
= XSTRING (address
)->data
;
2091 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2092 sockun
->sun_path
[i
] = *cp
++;
2099 p
= XVECTOR (XCDR (address
));
2100 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2103 for (i
= 0; i
< len
; i
++)
2104 if (INTEGERP (p
->contents
[i
]))
2105 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2108 #ifdef DATAGRAM_SOCKETS
2109 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2111 doc
: /* Get the current datagram address associated with PROCESS. */)
2113 Lisp_Object process
;
2117 CHECK_PROCESS (process
);
2119 if (!DATAGRAM_CONN_P (process
))
2122 channel
= XINT (XPROCESS (process
)->infd
);
2123 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2124 datagram_address
[channel
].len
);
2127 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2129 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2130 Returns nil upon error setting address, ADDRESS otherwise. */)
2132 Lisp_Object process
, address
;
2137 CHECK_PROCESS (process
);
2139 if (!DATAGRAM_CONN_P (process
))
2142 channel
= XINT (XPROCESS (process
)->infd
);
2144 len
= get_lisp_to_sockaddr_size (address
, &family
);
2145 if (datagram_address
[channel
].len
!= len
)
2147 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2153 static struct socket_options
{
2154 /* The name of this option. Should be lowercase version of option
2155 name without SO_ prefix. */
2157 /* Length of name. */
2159 /* Option level SOL_... */
2161 /* Option number SO_... */
2163 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_STR
, SOPT_LINGER
} opttype
;
2164 } socket_options
[] =
2166 #ifdef SO_BINDTODEVICE
2167 { "bindtodevice", 12, SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_STR
},
2170 { "broadcast", 9, SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
},
2173 { "dontroute", 9, SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
},
2176 { "keepalive", 9, SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
},
2179 { "linger", 6, SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
},
2182 { "oobinline", 9, SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
},
2185 { "priority", 8, SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
},
2188 { "reuseaddr", 9, SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
},
2190 { 0, 0, 0, 0, SOPT_UNKNOWN
}
2193 /* Process list of socket options OPTS on socket S.
2194 Only check if options are supported is S < 0.
2195 If NO_ERROR is non-zero, continue silently if an option
2198 Each element specifies one option. An element is either a string
2199 "OPTION=VALUE" or a cons (OPTION . VALUE) where OPTION is a string
2203 set_socket_options (s
, opts
, no_error
)
2209 opts
= Fcons (opts
, Qnil
);
2211 while (CONSP (opts
))
2216 struct socket_options
*sopt
;
2230 name
= (char *) XSTRING (opt
)->data
;
2231 else if (SYMBOLP (opt
))
2232 name
= (char *) XSYMBOL (opt
)->name
->data
;
2234 error ("Mal-formed option list");
2238 if (strncmp (name
, "no", 2) == 0)
2245 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2246 if (strncmp (name
, sopt
->name
, sopt
->nlen
) == 0)
2248 if (name
[sopt
->nlen
] == 0)
2250 if (name
[sopt
->nlen
] == '=')
2252 arg
= name
+ sopt
->nlen
+ 1;
2257 switch (sopt
->opttype
)
2265 optval
= (*arg
== '0' || *arg
== 'n') ? 0 : 1;
2266 else if (INTEGERP (val
))
2267 optval
= XINT (val
) == 0 ? 0 : 1;
2269 optval
= NILP (val
) ? 0 : 1;
2270 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2271 &optval
, sizeof (optval
));
2280 else if (INTEGERP (val
))
2281 optval
= XINT (val
);
2283 error ("Bad option argument for %s", name
);
2286 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2287 &optval
, sizeof (optval
));
2297 else if (STRINGP (val
))
2298 arg
= (char *) XSTRING (val
)->data
;
2299 else if (XSYMBOL (val
))
2300 arg
= (char *) XSYMBOL (val
)->name
->data
;
2302 error ("Invalid argument to %s option", name
);
2304 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2311 struct linger linger
;
2314 linger
.l_linger
= 0;
2321 if (*arg
== 'n' || *arg
== 't' || *arg
== 'y')
2322 linger
.l_onoff
= (*arg
== 'n') ? 0 : 1;
2324 linger
.l_linger
= atoi(arg
);
2326 else if (INTEGERP (val
))
2327 linger
.l_linger
= XINT (val
);
2329 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2330 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2331 &linger
, sizeof (linger
));
2340 error ("Unsupported option: %s", name
);
2342 if (ret
< 0 && ! no_error
)
2343 report_file_error ("Cannot set network option: %s", opt
);
2348 DEFUN ("set-network-process-options",
2349 Fset_network_process_options
, Sset_network_process_options
,
2351 doc
: /* Set one or more options for network process PROCESS.
2352 Each option is either a string "OPT=VALUE" or a cons (OPT . VALUE).
2353 A boolean value is false if it either zero or nil, true otherwise.
2355 The following options are known. Consult the relevant system manual
2356 pages for more information.
2358 bindtodevice=NAME -- bind to interface NAME, or remove binding if nil.
2359 broadcast=BOOL -- Allow send and receive of datagram broadcasts.
2360 dontroute=BOOL -- Only send to directly connected hosts.
2361 keepalive=BOOL -- Send keep-alive messages on network stream.
2362 linger=BOOL or TIMEOUT -- Send queued messages before closing.
2363 oobinline=BOOL -- Place out-of-band data in receive data stream.
2364 priority=INT -- Set protocol defined priority for sent packets.
2365 reuseaddr=BOOL -- Allow reusing a recently used address.
2367 usage: (set-network-process-options PROCESS &rest OPTIONS) */)
2372 Lisp_Object process
;
2376 CHECK_PROCESS (process
);
2377 if (nargs
> 1 && XINT (XPROCESS (process
)->infd
) >= 0)
2379 opts
= Flist (nargs
, args
);
2380 set_socket_options (XINT (XPROCESS (process
)->infd
), opts
, 0);
2385 /* A version of request_sigio suitable for a record_unwind_protect. */
2388 unwind_request_sigio (dummy
)
2391 if (interrupt_input
)
2396 /* Create a network stream/datagram client/server process. Treated
2397 exactly like a normal process when reading and writing. Primary
2398 differences are in status display and process deletion. A network
2399 connection has no PID; you cannot signal it. All you can do is
2400 stop/continue it and deactivate/close it via delete-process */
2402 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2404 doc
: /* Create and return a network server or client process.
2406 In Emacs, network connections are represented by process objects, so
2407 input and output work as for subprocesses and `delete-process' closes
2408 a network connection. However, a network process has no process id,
2409 it cannot be signalled, and the status codes are different from normal
2412 Arguments are specified as keyword/argument pairs. The following
2413 arguments are defined:
2415 :name NAME -- NAME is name for process. It is modified if necessary
2418 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2419 with the process. Process output goes at end of that buffer, unless
2420 you specify an output stream or filter function to handle the output.
2421 BUFFER may be also nil, meaning that this process is not associated
2424 :host HOST -- HOST is name of the host to connect to, or its IP
2425 address. The symbol `local' specifies the local host. If specified
2426 for a server process, it must be a valid name or address for the local
2427 host, and only clients connecting to that address will be accepted.
2429 :service SERVICE -- SERVICE is name of the service desired, or an
2430 integer specifying a port number to connect to. If SERVICE is t,
2431 a random port number is selected for the server.
2433 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2434 stream type connection, `datagram' creates a datagram type connection.
2436 :family FAMILY -- FAMILY is the address (and protocol) family for the
2437 service specified by HOST and SERVICE. The default address family is
2438 Inet (or IPv4) for the host and port number specified by HOST and
2439 SERVICE. Other address families supported are:
2440 local -- for a local (i.e. UNIX) address specified by SERVICE.
2442 :local ADDRESS -- ADDRESS is the local address used for the connection.
2443 This parameter is ignored when opening a client process. When specified
2444 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2446 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2447 connection. This parameter is ignored when opening a stream server
2448 process. For a datagram server process, it specifies the initial
2449 setting of the remote datagram address. When specified for a client
2450 process, the FAMILY, HOST, and SERVICE args are ignored.
2452 The format of ADDRESS depends on the address family:
2453 - An IPv4 address is represented as an vector of integers [A B C D P]
2454 corresponding to numeric IP address A.B.C.D and port number P.
2455 - A local address is represented as a string with the address in the
2456 local address space.
2457 - An "unsupported family" address is represented by a cons (F . AV)
2458 where F is the family number and AV is a vector containing the socket
2459 address data with one element per address data byte. Do not rely on
2460 this format in portable code, as it may depend on implementation
2461 defined constants, data sizes, and data structure alignment.
2463 :coding CODING -- CODING is coding system for this process.
2465 :options OPTIONS -- Set the specified options for the network process.
2466 See `set-network-process-options' for details.
2468 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2469 return without waiting for the connection to complete; instead, the
2470 sentinel function will be called with second arg matching "open" (if
2471 successful) or "failed" when the connect completes. Default is to use
2472 a blocking connect (i.e. wait) for stream type connections.
2474 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2475 running when emacs is exited.
2477 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2478 In the stopped state, a server process does not accept new
2479 connections, and a client process does not handle incoming traffic.
2480 The stopped state is cleared by `continue-process' and set by
2483 :filter FILTER -- Install FILTER as the process filter.
2485 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2487 :log LOG -- Install LOG as the server process log function. This
2488 function is called as when the server accepts a network connection from a
2489 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2490 is the server process, CLIENT is the new process for the connection,
2491 and MESSAGE is a string.
2493 :server BOOL -- if BOOL is non-nil, create a server process for the
2494 specified FAMILY, SERVICE, and connection type (stream or datagram).
2495 Default is a client process.
2497 A server process will listen for and accept connections from
2498 clients. When a client connection is accepted, a new network process
2499 is created for the connection with the following parameters:
2500 - The client's process name is constructed by concatenating the server
2501 process' NAME and a client identification string.
2502 - If the FILTER argument is non-nil, the client process will not get a
2503 separate process buffer; otherwise, the client's process buffer is a newly
2504 created buffer named after the server process' BUFFER name or process
2505 NAME concatenated with the client identification string.
2506 - The connection type and the process filter and sentinel parameters are
2507 inherited from the server process' TYPE, FILTER and SENTINEL.
2508 - The client process' contact info is set according to the client's
2509 addressing information (typically an IP address and a port number).
2511 Notice that the FILTER and SENTINEL args are never used directly by
2512 the server process. Also, the BUFFER argument is not used directly by
2513 the server process, but via `network-server-log-function' hook, a log
2514 of the accepted (and failed) connections may be recorded in the server
2517 usage: (make-network-process &rest ARGS) */)
2523 Lisp_Object contact
;
2524 struct Lisp_Process
*p
;
2525 #ifdef HAVE_GETADDRINFO
2526 struct addrinfo ai
, *res
, *lres
;
2527 struct addrinfo hints
;
2528 char *portstring
, portbuf
[128];
2529 #else /* HAVE_GETADDRINFO */
2530 struct _emacs_addrinfo
2536 struct sockaddr
*ai_addr
;
2537 struct _emacs_addrinfo
*ai_next
;
2539 #endif /* HAVE_GETADDRINFO */
2540 struct sockaddr_in address_in
;
2541 #ifdef HAVE_LOCAL_SOCKETS
2542 struct sockaddr_un address_un
;
2547 int s
= -1, outch
, inch
;
2548 struct gcpro gcpro1
;
2550 int count
= specpdl_ptr
- specpdl
;
2552 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2554 Lisp_Object name
, buffer
, host
, service
, address
;
2555 Lisp_Object filter
, sentinel
;
2556 int is_non_blocking_client
= 0;
2564 /* Save arguments for process-contact and clone-process. */
2565 contact
= Flist (nargs
, args
);
2569 /* Ensure socket support is loaded if available. */
2570 init_winsock (TRUE
);
2573 /* :type TYPE (nil: stream, datagram */
2574 tem
= Fplist_get (contact
, QCtype
);
2576 socktype
= SOCK_STREAM
;
2577 #ifdef DATAGRAM_SOCKETS
2578 else if (EQ (tem
, Qdatagram
))
2579 socktype
= SOCK_DGRAM
;
2582 error ("Unsupported connection type");
2585 tem
= Fplist_get (contact
, QCserver
);
2589 error ("Network servers not supported");
2595 /* Make QCaddress an alias for :local (server) or :remote (client). */
2596 QCaddress
= is_server
? QClocal
: QCremote
;
2599 if (!is_server
&& socktype
== SOCK_STREAM
2600 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2602 #ifndef NON_BLOCKING_CONNECT
2603 error ("Non-blocking connect not supported");
2605 is_non_blocking_client
= 1;
2609 name
= Fplist_get (contact
, QCname
);
2610 buffer
= Fplist_get (contact
, QCbuffer
);
2611 filter
= Fplist_get (contact
, QCfilter
);
2612 sentinel
= Fplist_get (contact
, QCsentinel
);
2614 CHECK_STRING (name
);
2617 /* Let's handle TERM before things get complicated ... */
2618 host
= Fplist_get (contact
, QChost
);
2619 CHECK_STRING (host
);
2621 service
= Fplist_get (contact
, QCservice
);
2622 if (INTEGERP (service
))
2623 port
= htons ((unsigned short) XINT (service
));
2626 struct servent
*svc_info
;
2627 CHECK_STRING (service
);
2628 svc_info
= getservbyname (XSTRING (service
)->data
, "tcp");
2630 error ("Unknown service: %s", XSTRING (service
)->data
);
2631 port
= svc_info
->s_port
;
2634 s
= connect_server (0);
2636 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2637 send_command (s
, C_PORT
, 0, "%s:%d", XSTRING (host
)->data
, ntohs (port
));
2638 send_command (s
, C_DUMB
, 1, 0);
2640 #else /* not TERM */
2642 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2643 ai
.ai_socktype
= socktype
;
2648 /* :local ADDRESS or :remote ADDRESS */
2649 address
= Fplist_get (contact
, QCaddress
);
2650 if (!NILP (address
))
2652 host
= service
= Qnil
;
2654 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2655 error ("Malformed :address");
2656 ai
.ai_family
= family
;
2657 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2658 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2662 /* :family FAMILY -- nil (for Inet), local, or integer. */
2663 tem
= Fplist_get (contact
, QCfamily
);
2665 family
= XINT (tem
);
2670 #ifdef HAVE_LOCAL_SOCKETS
2671 else if (EQ (tem
, Qlocal
))
2676 error ("Unknown address family");
2677 ai
.ai_family
= family
;
2679 /* :service SERVICE -- string, integer (port number), or t (random port). */
2680 service
= Fplist_get (contact
, QCservice
);
2682 #ifdef HAVE_LOCAL_SOCKETS
2683 if (family
== AF_LOCAL
)
2685 /* Host is not used. */
2687 CHECK_STRING (service
);
2688 bzero (&address_un
, sizeof address_un
);
2689 address_un
.sun_family
= AF_LOCAL
;
2690 strncpy (address_un
.sun_path
, XSTRING (service
)->data
, sizeof address_un
.sun_path
);
2691 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
2692 ai
.ai_addrlen
= sizeof address_un
;
2697 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2698 host
= Fplist_get (contact
, QChost
);
2701 if (EQ (host
, Qlocal
))
2702 host
= build_string ("localhost");
2703 CHECK_STRING (host
);
2706 /* Slow down polling to every ten seconds.
2707 Some kernels have a bug which causes retrying connect to fail
2708 after a connect. Polling can interfere with gethostbyname too. */
2709 #ifdef POLL_FOR_INPUT
2710 if (socktype
== SOCK_STREAM
)
2712 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
2713 bind_polling_period (10);
2717 #ifdef HAVE_GETADDRINFO
2718 /* If we have a host, use getaddrinfo to resolve both host and service.
2719 Otherwise, use getservbyname to lookup the service. */
2723 /* SERVICE can either be a string or int.
2724 Convert to a C string for later use by getaddrinfo. */
2725 if (EQ (service
, Qt
))
2727 else if (INTEGERP (service
))
2729 sprintf (portbuf
, "%ld", (long) XINT (service
));
2730 portstring
= portbuf
;
2734 CHECK_STRING (service
);
2735 portstring
= XSTRING (service
)->data
;
2740 memset (&hints
, 0, sizeof (hints
));
2742 hints
.ai_family
= NILP (Fplist_member (contact
, QCfamily
)) ? AF_UNSPEC
: family
;
2743 hints
.ai_socktype
= socktype
;
2744 hints
.ai_protocol
= 0;
2745 ret
= getaddrinfo (XSTRING (host
)->data
, portstring
, &hints
, &res
);
2747 #ifdef HAVE_GAI_STRERROR
2748 error ("%s/%s %s", XSTRING (host
)->data
, portstring
, gai_strerror(ret
));
2750 error ("%s/%s getaddrinfo error %d", XSTRING (host
)->data
, portstring
, ret
);
2756 #endif /* HAVE_GETADDRINFO */
2758 /* We end up here if getaddrinfo is not defined, or in case no hostname
2759 has been specified (e.g. for a local server process). */
2761 if (EQ (service
, Qt
))
2763 else if (INTEGERP (service
))
2764 port
= htons ((unsigned short) XINT (service
));
2767 struct servent
*svc_info
;
2768 CHECK_STRING (service
);
2769 svc_info
= getservbyname (XSTRING (service
)->data
,
2770 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
2772 error ("Unknown service: %s", XSTRING (service
)->data
);
2773 port
= svc_info
->s_port
;
2776 bzero (&address_in
, sizeof address_in
);
2777 address_in
.sin_family
= family
;
2778 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
2779 address_in
.sin_port
= port
;
2781 #ifndef HAVE_GETADDRINFO
2784 struct hostent
*host_info_ptr
;
2786 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
2787 as it may `hang' emacs for a very long time. */
2790 host_info_ptr
= gethostbyname (XSTRING (host
)->data
);
2795 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
2796 host_info_ptr
->h_length
);
2797 family
= host_info_ptr
->h_addrtype
;
2798 address_in
.sin_family
= family
;
2801 /* Attempt to interpret host as numeric inet address */
2803 IN_ADDR numeric_addr
;
2804 numeric_addr
= inet_addr ((char *) XSTRING (host
)->data
);
2805 if (NUMERIC_ADDR_ERROR
)
2806 error ("Unknown host \"%s\"", XSTRING (host
)->data
);
2808 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
2809 sizeof (address_in
.sin_addr
));
2813 #endif /* not HAVE_GETADDRINFO */
2815 ai
.ai_family
= family
;
2816 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
2817 ai
.ai_addrlen
= sizeof address_in
;
2821 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
2822 when connect is interrupted. So let's not let it get interrupted.
2823 Note we do not turn off polling, because polling is only used
2824 when not interrupt_input, and thus not normally used on the systems
2825 which have this bug. On systems which use polling, there's no way
2826 to quit if polling is turned off. */
2828 && !is_server
&& socktype
== SOCK_STREAM
)
2830 /* Comment from KFS: The original open-network-stream code
2831 didn't unwind protect this, but it seems like the proper
2832 thing to do. In any case, I don't see how it could harm to
2833 do this -- and it makes cleanup (using unbind_to) easier. */
2834 record_unwind_protect (unwind_request_sigio
, Qnil
);
2838 /* Do this in case we never enter the for-loop below. */
2839 count1
= specpdl_ptr
- specpdl
;
2842 for (lres
= res
; lres
; lres
= lres
->ai_next
)
2844 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
2851 #ifdef DATAGRAM_SOCKETS
2852 if (!is_server
&& socktype
== SOCK_DGRAM
)
2854 #endif /* DATAGRAM_SOCKETS */
2856 #ifdef NON_BLOCKING_CONNECT
2857 if (is_non_blocking_client
)
2860 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
2862 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
2874 /* Make us close S if quit. */
2875 record_unwind_protect (close_file_unwind
, make_number (s
));
2879 /* Configure as a server socket. */
2880 #ifdef HAVE_LOCAL_SOCKETS
2881 if (family
!= AF_LOCAL
)
2885 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
2886 report_file_error ("Cannot set reuse option on server socket.", Qnil
);
2889 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
2890 report_file_error ("Cannot bind server socket", Qnil
);
2892 #ifdef HAVE_GETSOCKNAME
2893 if (EQ (service
, Qt
))
2895 struct sockaddr_in sa1
;
2896 int len1
= sizeof (sa1
);
2897 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
2899 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
2900 service
= make_number (sa1
.sin_port
);
2901 contact
= Fplist_put (contact
, QCservice
, service
);
2906 if (socktype
== SOCK_STREAM
&& listen (s
, 5))
2907 report_file_error ("Cannot listen on server socket", Qnil
);
2917 /* This turns off all alarm-based interrupts; the
2918 bind_polling_period call above doesn't always turn all the
2919 short-interval ones off, especially if interrupt_input is
2922 It'd be nice to be able to control the connect timeout
2923 though. Would non-blocking connect calls be portable?
2925 This used to be conditioned by HAVE_GETADDRINFO. Why? */
2927 turn_on_atimers (0);
2929 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
2932 turn_on_atimers (1);
2934 if (ret
== 0 || xerrno
== EISCONN
)
2936 /* The unwind-protect will be discarded afterwards.
2937 Likewise for immediate_quit. */
2941 #ifdef NON_BLOCKING_CONNECT
2943 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
2947 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
2955 if (xerrno
== EINTR
)
2957 if (xerrno
== EADDRINUSE
&& retry
< 20)
2959 /* A delay here is needed on some FreeBSD systems,
2960 and it is harmless, since this retrying takes time anyway
2961 and should be infrequent. */
2962 Fsleep_for (make_number (1), Qnil
);
2967 /* Discard the unwind protect closing S. */
2968 specpdl_ptr
= specpdl
+ count1
;
2975 #ifdef DATAGRAM_SOCKETS
2976 if (socktype
== SOCK_DGRAM
)
2978 if (datagram_address
[s
].sa
)
2980 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
2981 datagram_address
[s
].len
= lres
->ai_addrlen
;
2985 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
2986 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
2989 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
2990 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
2991 conv_lisp_to_sockaddr (rfamily
, remote
,
2992 datagram_address
[s
].sa
, rlen
);
2996 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
2999 contact
= Fplist_put (contact
, QCaddress
,
3000 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3003 #ifdef HAVE_GETADDRINFO
3010 /* Discard the unwind protect for closing S, if any. */
3011 specpdl_ptr
= specpdl
+ count1
;
3013 /* Unwind bind_polling_period and request_sigio. */
3014 unbind_to (count
, Qnil
);
3018 /* If non-blocking got this far - and failed - assume non-blocking is
3019 not supported after all. This is probably a wrong assumption, but
3020 the normal blocking calls to open-network-stream handles this error
3022 if (is_non_blocking_client
)
3027 report_file_error ("make server process failed", contact
);
3029 report_file_error ("make client process failed", contact
);
3032 tem
= Fplist_get (contact
, QCoptions
);
3034 set_socket_options (s
, tem
, 1);
3036 #endif /* not TERM */
3042 buffer
= Fget_buffer_create (buffer
);
3043 proc
= make_process (name
);
3045 chan_process
[inch
] = proc
;
3048 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3051 fcntl (inch
, F_SETFL
, O_NDELAY
);
3055 p
= XPROCESS (proc
);
3057 p
->childp
= contact
;
3059 p
->sentinel
= sentinel
;
3061 p
->log
= Fplist_get (contact
, QClog
);
3062 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3063 p
->kill_without_query
= Qt
;
3064 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3067 XSETINT (p
->infd
, inch
);
3068 XSETINT (p
->outfd
, outch
);
3069 if (is_server
&& socktype
== SOCK_STREAM
)
3070 p
->status
= Qlisten
;
3072 #ifdef NON_BLOCKING_CONNECT
3073 if (is_non_blocking_client
)
3075 /* We may get here if connect did succeed immediately. However,
3076 in that case, we still need to signal this like a non-blocking
3078 p
->status
= Qconnect
;
3079 if (!FD_ISSET (inch
, &connect_wait_mask
))
3081 FD_SET (inch
, &connect_wait_mask
);
3082 num_pending_connects
++;
3087 /* A server may have a client filter setting of Qt, but it must
3088 still listen for incoming connects unless it is stopped. */
3089 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3090 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3092 FD_SET (inch
, &input_wait_mask
);
3093 FD_SET (inch
, &non_keyboard_wait_mask
);
3096 if (inch
> max_process_desc
)
3097 max_process_desc
= inch
;
3099 tem
= Fplist_member (contact
, QCcoding
);
3100 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3101 tem
= Qnil
; /* No error message (too late!). */
3104 /* Setup coding systems for communicating with the network stream. */
3105 struct gcpro gcpro1
;
3106 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3107 Lisp_Object coding_systems
= Qt
;
3108 Lisp_Object args
[5], val
;
3111 val
= XCAR (XCDR (tem
));
3112 else if (!NILP (Vcoding_system_for_read
))
3113 val
= Vcoding_system_for_read
;
3114 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3115 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3116 /* We dare not decode end-of-line format by setting VAL to
3117 Qraw_text, because the existing Emacs Lisp libraries
3118 assume that they receive bare code including a sequene of
3123 args
[0] = Qopen_network_stream
, args
[1] = name
,
3124 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3126 coding_systems
= Ffind_operation_coding_system (5, args
);
3128 if (CONSP (coding_systems
))
3129 val
= XCAR (coding_systems
);
3130 else if (CONSP (Vdefault_process_coding_system
))
3131 val
= XCAR (Vdefault_process_coding_system
);
3135 p
->decode_coding_system
= val
;
3138 val
= XCAR (XCDR (tem
));
3139 else if (!NILP (Vcoding_system_for_write
))
3140 val
= Vcoding_system_for_write
;
3141 else if (NILP (current_buffer
->enable_multibyte_characters
))
3145 if (EQ (coding_systems
, Qt
))
3147 args
[0] = Qopen_network_stream
, args
[1] = name
,
3148 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3150 coding_systems
= Ffind_operation_coding_system (5, args
);
3153 if (CONSP (coding_systems
))
3154 val
= XCDR (coding_systems
);
3155 else if (CONSP (Vdefault_process_coding_system
))
3156 val
= XCDR (Vdefault_process_coding_system
);
3160 p
->encode_coding_system
= val
;
3163 if (!proc_decode_coding_system
[inch
])
3164 proc_decode_coding_system
[inch
]
3165 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
3166 setup_coding_system (p
->decode_coding_system
,
3167 proc_decode_coding_system
[inch
]);
3168 if (!proc_encode_coding_system
[outch
])
3169 proc_encode_coding_system
[outch
]
3170 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
3171 setup_coding_system (p
->encode_coding_system
,
3172 proc_encode_coding_system
[outch
]);
3174 p
->decoding_buf
= make_uninit_string (0);
3175 p
->decoding_carryover
= make_number (0);
3176 p
->encoding_buf
= make_uninit_string (0);
3177 p
->encoding_carryover
= make_number (0);
3179 p
->inherit_coding_system_flag
3180 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3186 #endif /* HAVE_SOCKETS */
3189 deactivate_process (proc
)
3192 register int inchannel
, outchannel
;
3193 register struct Lisp_Process
*p
= XPROCESS (proc
);
3195 inchannel
= XINT (p
->infd
);
3196 outchannel
= XINT (p
->outfd
);
3200 /* Beware SIGCHLD hereabouts. */
3201 flush_pending_output (inchannel
);
3204 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3205 sys$
dassgn (outchannel
);
3206 vs
= get_vms_process_pointer (p
->pid
);
3208 give_back_vms_process_stuff (vs
);
3211 emacs_close (inchannel
);
3212 if (outchannel
>= 0 && outchannel
!= inchannel
)
3213 emacs_close (outchannel
);
3216 XSETINT (p
->infd
, -1);
3217 XSETINT (p
->outfd
, -1);
3218 #ifdef DATAGRAM_SOCKETS
3219 if (DATAGRAM_CHAN_P (inchannel
))
3221 xfree (datagram_address
[inchannel
].sa
);
3222 datagram_address
[inchannel
].sa
= 0;
3223 datagram_address
[inchannel
].len
= 0;
3226 chan_process
[inchannel
] = Qnil
;
3227 FD_CLR (inchannel
, &input_wait_mask
);
3228 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3229 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3231 FD_CLR (inchannel
, &connect_wait_mask
);
3232 if (--num_pending_connects
< 0)
3235 if (inchannel
== max_process_desc
)
3238 /* We just closed the highest-numbered process input descriptor,
3239 so recompute the highest-numbered one now. */
3240 max_process_desc
= 0;
3241 for (i
= 0; i
< MAXDESC
; i
++)
3242 if (!NILP (chan_process
[i
]))
3243 max_process_desc
= i
;
3248 /* Close all descriptors currently in use for communication
3249 with subprocess. This is used in a newly-forked subprocess
3250 to get rid of irrelevant descriptors. */
3253 close_process_descs ()
3257 for (i
= 0; i
< MAXDESC
; i
++)
3259 Lisp_Object process
;
3260 process
= chan_process
[i
];
3261 if (!NILP (process
))
3263 int in
= XINT (XPROCESS (process
)->infd
);
3264 int out
= XINT (XPROCESS (process
)->outfd
);
3267 if (out
>= 0 && in
!= out
)
3274 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3276 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3277 It is read into the process' buffers or given to their filter functions.
3278 Non-nil arg PROCESS means do not return until some output has been received
3280 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of
3281 seconds and microseconds to wait; return after that much time whether
3282 or not there is input.
3283 Return non-nil iff we received any output before the timeout expired. */)
3284 (process
, timeout
, timeout_msecs
)
3285 register Lisp_Object process
, timeout
, timeout_msecs
;
3290 if (! NILP (process
))
3291 CHECK_PROCESS (process
);
3293 if (! NILP (timeout_msecs
))
3295 CHECK_NUMBER (timeout_msecs
);
3296 useconds
= XINT (timeout_msecs
);
3297 if (!INTEGERP (timeout
))
3298 XSETINT (timeout
, 0);
3301 int carry
= useconds
/ 1000000;
3303 XSETINT (timeout
, XINT (timeout
) + carry
);
3304 useconds
-= carry
* 1000000;
3306 /* I think this clause is necessary because C doesn't
3307 guarantee a particular rounding direction for negative
3311 XSETINT (timeout
, XINT (timeout
) - 1);
3312 useconds
+= 1000000;
3319 if (! NILP (timeout
))
3321 CHECK_NUMBER (timeout
);
3322 seconds
= XINT (timeout
);
3323 if (seconds
< 0 || (seconds
== 0 && useconds
== 0))
3335 XSETFASTINT (process
, 0);
3338 (wait_reading_process_input (seconds
, useconds
, process
, 0)
3342 /* Accept a connection for server process SERVER on CHANNEL. */
3344 static int connect_counter
= 0;
3347 server_accept_connection (server
, channel
)
3351 Lisp_Object proc
, caller
, name
, buffer
;
3352 Lisp_Object contact
, host
, service
;
3353 struct Lisp_Process
*ps
= XPROCESS (server
);
3354 struct Lisp_Process
*p
;
3358 struct sockaddr_in in
;
3359 #ifdef HAVE_LOCAL_SOCKETS
3360 struct sockaddr_un un
;
3363 int len
= sizeof saddr
;
3365 s
= accept (channel
, &saddr
.sa
, &len
);
3374 if (code
== EWOULDBLOCK
)
3378 if (!NILP (ps
->log
))
3379 call3 (ps
->log
, server
, Qnil
,
3380 concat3 (build_string ("accept failed with code"),
3381 Fnumber_to_string (make_number (code
)),
3382 build_string ("\n")));
3388 /* Setup a new process to handle the connection. */
3390 /* Generate a unique identification of the caller, and build contact
3391 information for this process. */
3394 switch (saddr
.sa
.sa_family
)
3398 Lisp_Object args
[5];
3399 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
3400 args
[0] = build_string ("%d.%d.%d.%d");
3401 args
[1] = make_number (*ip
++);
3402 args
[2] = make_number (*ip
++);
3403 args
[3] = make_number (*ip
++);
3404 args
[4] = make_number (*ip
++);
3405 host
= Fformat (5, args
);
3406 service
= make_number (ntohs (saddr
.in
.sin_port
));
3408 args
[0] = build_string (" <%s:%d>");
3411 caller
= Fformat (3, args
);
3415 #ifdef HAVE_LOCAL_SOCKETS
3419 caller
= Fnumber_to_string (make_number (connect_counter
));
3420 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
3424 /* Create a new buffer name for this process if it doesn't have a
3425 filter. The new buffer name is based on the buffer name or
3426 process name of the server process concatenated with the caller
3429 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
3433 buffer
= ps
->buffer
;
3435 buffer
= Fbuffer_name (buffer
);
3440 buffer
= concat2 (buffer
, caller
);
3441 buffer
= Fget_buffer_create (buffer
);
3445 /* Generate a unique name for the new server process. Combine the
3446 server process name with the caller identification. */
3448 name
= concat2 (ps
->name
, caller
);
3449 proc
= make_process (name
);
3451 chan_process
[s
] = proc
;
3454 fcntl (s
, F_SETFL
, O_NONBLOCK
);
3457 fcntl (s
, F_SETFL
, O_NDELAY
);
3461 p
= XPROCESS (proc
);
3463 /* Build new contact information for this setup. */
3464 contact
= Fcopy_sequence (ps
->childp
);
3465 contact
= Fplist_put (contact
, QCserver
, Qnil
);
3466 contact
= Fplist_put (contact
, QChost
, host
);
3467 if (!NILP (service
))
3468 contact
= Fplist_put (contact
, QCservice
, service
);
3469 contact
= Fplist_put (contact
, QCremote
,
3470 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
3471 #ifdef HAVE_GETSOCKNAME
3473 if (getsockname (channel
, &saddr
.sa
, &len
) == 0)
3474 contact
= Fplist_put (contact
, QClocal
,
3475 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
3478 p
->childp
= contact
;
3480 p
->sentinel
= ps
->sentinel
;
3481 p
->filter
= ps
->filter
;
3484 XSETINT (p
->infd
, s
);
3485 XSETINT (p
->outfd
, s
);
3488 /* Client processes for accepted connections are not stopped initially. */
3489 if (!EQ (p
->filter
, Qt
))
3491 FD_SET (s
, &input_wait_mask
);
3492 FD_SET (s
, &non_keyboard_wait_mask
);
3495 if (s
> max_process_desc
)
3496 max_process_desc
= s
;
3498 /* Setup coding system for new process based on server process.
3499 This seems to be the proper thing to do, as the coding system
3500 of the new process should reflect the settings at the time the
3501 server socket was opened; not the current settings. */
3503 p
->decode_coding_system
= ps
->decode_coding_system
;
3504 p
->encode_coding_system
= ps
->encode_coding_system
;
3506 if (!proc_decode_coding_system
[s
])
3507 proc_decode_coding_system
[s
]
3508 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
3509 setup_coding_system (p
->decode_coding_system
,
3510 proc_decode_coding_system
[s
]);
3511 if (!proc_encode_coding_system
[s
])
3512 proc_encode_coding_system
[s
]
3513 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
3514 setup_coding_system (p
->encode_coding_system
,
3515 proc_encode_coding_system
[s
]);
3517 p
->decoding_buf
= make_uninit_string (0);
3518 p
->decoding_carryover
= make_number (0);
3519 p
->encoding_buf
= make_uninit_string (0);
3520 p
->encoding_carryover
= make_number (0);
3522 p
->inherit_coding_system_flag
3523 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
3525 if (!NILP (ps
->log
))
3526 call3 (ps
->log
, server
, proc
,
3527 concat3 (build_string ("accept from "),
3528 (STRINGP (host
) ? host
: build_string ("-")),
3529 build_string ("\n")));
3531 if (!NILP (p
->sentinel
))
3532 exec_sentinel (proc
,
3533 concat3 (build_string ("open from "),
3534 (STRINGP (host
) ? host
: build_string ("-")),
3535 build_string ("\n")));
3538 /* This variable is different from waiting_for_input in keyboard.c.
3539 It is used to communicate to a lisp process-filter/sentinel (via the
3540 function Fwaiting_for_user_input_p below) whether emacs was waiting
3541 for user-input when that process-filter was called.
3542 waiting_for_input cannot be used as that is by definition 0 when
3543 lisp code is being evalled.
3544 This is also used in record_asynch_buffer_change.
3545 For that purpose, this must be 0
3546 when not inside wait_reading_process_input. */
3547 static int waiting_for_user_input_p
;
3549 /* This is here so breakpoints can be put on it. */
3551 wait_reading_process_input_1 ()
3555 /* Read and dispose of subprocess output while waiting for timeout to
3556 elapse and/or keyboard input to be available.
3559 timeout in seconds, or
3560 zero for no limit, or
3561 -1 means gobble data immediately available but don't wait for any.
3564 an additional duration to wait, measured in microseconds.
3565 If this is nonzero and time_limit is 0, then the timeout
3566 consists of MICROSECS only.
3568 READ_KBD is a lisp value:
3569 0 to ignore keyboard input, or
3570 1 to return when input is available, or
3571 -1 meaning caller will actually read the input, so don't throw to
3572 the quit handler, or
3573 a cons cell, meaning wait until its car is non-nil
3574 (and gobble terminal input into the buffer if any arrives), or
3575 a process object, meaning wait until something arrives from that
3576 process. The return value is true iff we read some input from
3579 DO_DISPLAY != 0 means redisplay should be done to show subprocess
3580 output that arrives.
3582 If READ_KBD is a pointer to a struct Lisp_Process, then the
3583 function returns true iff we received input from that process
3584 before the timeout elapsed.
3585 Otherwise, return true iff we received input from any process. */
3588 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
3589 int time_limit
, microsecs
;
3590 Lisp_Object read_kbd
;
3593 register int channel
, nfds
;
3594 static SELECT_TYPE Available
;
3595 static SELECT_TYPE Connecting
;
3596 int check_connect
, no_avail
;
3599 EMACS_TIME timeout
, end_time
;
3600 int wait_channel
= -1;
3601 struct Lisp_Process
*wait_proc
= 0;
3602 int got_some_input
= 0;
3603 /* Either nil or a cons cell, the car of which is of interest and
3604 may be changed outside of this routine. */
3605 Lisp_Object wait_for_cell
= Qnil
;
3607 FD_ZERO (&Available
);
3608 FD_ZERO (&Connecting
);
3610 /* If read_kbd is a process to watch, set wait_proc and wait_channel
3612 if (PROCESSP (read_kbd
))
3614 wait_proc
= XPROCESS (read_kbd
);
3615 wait_channel
= XINT (wait_proc
->infd
);
3616 XSETFASTINT (read_kbd
, 0);
3619 /* If waiting for non-nil in a cell, record where. */
3620 if (CONSP (read_kbd
))
3622 wait_for_cell
= read_kbd
;
3623 XSETFASTINT (read_kbd
, 0);
3626 waiting_for_user_input_p
= XINT (read_kbd
);
3628 /* Since we may need to wait several times,
3629 compute the absolute time to return at. */
3630 if (time_limit
|| microsecs
)
3632 EMACS_GET_TIME (end_time
);
3633 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
3634 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
3637 /* AlainF 5-Jul-1996
3638 HP-UX 10.10 seem to have problems with signals coming in
3639 Causes "poll: interrupted system call" messages when Emacs is run
3641 Turn off periodic alarms (in case they are in use) */
3642 turn_on_atimers (0);
3647 int timeout_reduced_for_timers
= 0;
3649 /* If calling from keyboard input, do not quit
3650 since we want to return C-g as an input character.
3651 Otherwise, do pending quit if requested. */
3652 if (XINT (read_kbd
) >= 0)
3655 /* Exit now if the cell we're waiting for became non-nil. */
3656 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
3659 /* Compute time from now till when time limit is up */
3660 /* Exit if already run out */
3661 if (time_limit
== -1)
3663 /* -1 specified for timeout means
3664 gobble output available now
3665 but don't wait at all. */
3667 EMACS_SET_SECS_USECS (timeout
, 0, 0);
3669 else if (time_limit
|| microsecs
)
3671 EMACS_GET_TIME (timeout
);
3672 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
3673 if (EMACS_TIME_NEG_P (timeout
))
3678 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
3681 /* Normally we run timers here.
3682 But not if wait_for_cell; in those cases,
3683 the wait is supposed to be short,
3684 and those callers cannot handle running arbitrary Lisp code here. */
3685 if (NILP (wait_for_cell
))
3687 EMACS_TIME timer_delay
;
3691 int old_timers_run
= timers_run
;
3692 struct buffer
*old_buffer
= current_buffer
;
3694 timer_delay
= timer_check (1);
3696 /* If a timer has run, this might have changed buffers
3697 an alike. Make read_key_sequence aware of that. */
3698 if (timers_run
!= old_timers_run
3699 && old_buffer
!= current_buffer
3700 && waiting_for_user_input_p
== -1)
3701 record_asynch_buffer_change ();
3703 if (timers_run
!= old_timers_run
&& do_display
)
3704 /* We must retry, since a timer may have requeued itself
3705 and that could alter the time_delay. */
3706 redisplay_preserve_echo_area (9);
3710 while (!detect_input_pending ());
3712 /* If there is unread keyboard input, also return. */
3713 if (XINT (read_kbd
) != 0
3714 && requeued_events_pending_p ())
3717 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
3719 EMACS_TIME difference
;
3720 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
3721 if (EMACS_TIME_NEG_P (difference
))
3723 timeout
= timer_delay
;
3724 timeout_reduced_for_timers
= 1;
3727 /* If time_limit is -1, we are not going to wait at all. */
3728 else if (time_limit
!= -1)
3730 /* This is so a breakpoint can be put here. */
3731 wait_reading_process_input_1 ();
3735 /* Cause C-g and alarm signals to take immediate action,
3736 and cause input available signals to zero out timeout.
3738 It is important that we do this before checking for process
3739 activity. If we get a SIGCHLD after the explicit checks for
3740 process activity, timeout is the only way we will know. */
3741 if (XINT (read_kbd
) < 0)
3742 set_waiting_for_input (&timeout
);
3744 /* If status of something has changed, and no input is
3745 available, notify the user of the change right away. After
3746 this explicit check, we'll let the SIGCHLD handler zap
3747 timeout to get our attention. */
3748 if (update_tick
!= process_tick
&& do_display
)
3750 SELECT_TYPE Atemp
, Ctemp
;
3752 Atemp
= input_wait_mask
;
3753 Ctemp
= connect_wait_mask
;
3754 EMACS_SET_SECS_USECS (timeout
, 0, 0);
3755 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
3757 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
3758 (SELECT_TYPE
*)0, &timeout
)
3761 /* It's okay for us to do this and then continue with
3762 the loop, since timeout has already been zeroed out. */
3763 clear_waiting_for_input ();
3768 /* Don't wait for output from a non-running process. Just
3769 read whatever data has already been received. */
3770 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
3771 update_status (wait_proc
);
3773 && ! EQ (wait_proc
->status
, Qrun
)
3774 && ! EQ (wait_proc
->status
, Qconnect
))
3776 int nread
, total_nread
= 0;
3778 clear_waiting_for_input ();
3779 XSETPROCESS (proc
, wait_proc
);
3781 /* Read data from the process, until we exhaust it. */
3782 while (XINT (wait_proc
->infd
) >= 0)
3784 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
3790 total_nread
+= nread
;
3792 else if (nread
== -1 && EIO
== errno
)
3796 else if (nread
== -1 && EAGAIN
== errno
)
3800 else if (nread
== -1 && EWOULDBLOCK
== errno
)
3804 if (total_nread
> 0 && do_display
)
3805 redisplay_preserve_echo_area (10);
3810 /* Wait till there is something to do */
3812 if (!NILP (wait_for_cell
))
3814 Available
= non_process_wait_mask
;
3819 if (! XINT (read_kbd
))
3820 Available
= non_keyboard_wait_mask
;
3822 Available
= input_wait_mask
;
3823 check_connect
= (num_pending_connects
> 0);
3826 /* If frame size has changed or the window is newly mapped,
3827 redisplay now, before we start to wait. There is a race
3828 condition here; if a SIGIO arrives between now and the select
3829 and indicates that a frame is trashed, the select may block
3830 displaying a trashed screen. */
3831 if (frame_garbaged
&& do_display
)
3833 clear_waiting_for_input ();
3834 redisplay_preserve_echo_area (11);
3835 if (XINT (read_kbd
) < 0)
3836 set_waiting_for_input (&timeout
);
3840 if (XINT (read_kbd
) && detect_input_pending ())
3848 Connecting
= connect_wait_mask
;
3849 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
3851 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
3852 (SELECT_TYPE
*)0, &timeout
);
3857 /* Make C-g and alarm signals set flags again */
3858 clear_waiting_for_input ();
3860 /* If we woke up due to SIGWINCH, actually change size now. */
3861 do_pending_window_change (0);
3863 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
3864 /* We wanted the full specified time, so return now. */
3868 if (xerrno
== EINTR
)
3871 /* Ultrix select seems to return ENOMEM when it is
3872 interrupted. Treat it just like EINTR. Bleah. Note
3873 that we want to test for the "ultrix" CPP symbol, not
3874 "__ultrix__"; the latter is only defined under GCC, but
3875 not by DEC's bundled CC. -JimB */
3876 else if (xerrno
== ENOMEM
)
3880 /* This happens for no known reason on ALLIANT.
3881 I am guessing that this is the right response. -- RMS. */
3882 else if (xerrno
== EFAULT
)
3885 else if (xerrno
== EBADF
)
3888 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
3889 the child's closure of the pts gives the parent a SIGHUP, and
3890 the ptc file descriptor is automatically closed,
3891 yielding EBADF here or at select() call above.
3892 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
3893 in m/ibmrt-aix.h), and here we just ignore the select error.
3894 Cleanup occurs c/o status_notify after SIGCLD. */
3895 no_avail
= 1; /* Cannot depend on values returned */
3901 error ("select error: %s", emacs_strerror (xerrno
));
3906 FD_ZERO (&Available
);
3910 #if defined(sun) && !defined(USG5_4)
3911 if (nfds
> 0 && keyboard_bit_set (&Available
)
3913 /* System sometimes fails to deliver SIGIO.
3915 David J. Mackenzie says that Emacs doesn't compile under
3916 Solaris if this code is enabled, thus the USG5_4 in the CPP
3917 conditional. "I haven't noticed any ill effects so far.
3918 If you find a Solaris expert somewhere, they might know
3920 kill (getpid (), SIGIO
);
3923 #if 0 /* When polling is used, interrupt_input is 0,
3924 so get_input_pending should read the input.
3925 So this should not be needed. */
3926 /* If we are using polling for input,
3927 and we see input available, make it get read now.
3928 Otherwise it might not actually get read for a second.
3929 And on hpux, since we turn off polling in wait_reading_process_input,
3930 it might never get read at all if we don't spend much time
3931 outside of wait_reading_process_input. */
3932 if (XINT (read_kbd
) && interrupt_input
3933 && keyboard_bit_set (&Available
)
3934 && input_polling_used ())
3935 kill (getpid (), SIGALRM
);
3938 /* Check for keyboard input */
3939 /* If there is any, return immediately
3940 to give it higher priority than subprocesses */
3942 if (XINT (read_kbd
) != 0)
3944 int old_timers_run
= timers_run
;
3945 struct buffer
*old_buffer
= current_buffer
;
3948 if (detect_input_pending_run_timers (do_display
))
3950 swallow_events (do_display
);
3951 if (detect_input_pending_run_timers (do_display
))
3955 /* If a timer has run, this might have changed buffers
3956 an alike. Make read_key_sequence aware of that. */
3957 if (timers_run
!= old_timers_run
3958 && waiting_for_user_input_p
== -1
3959 && old_buffer
!= current_buffer
)
3960 record_asynch_buffer_change ();
3966 /* If there is unread keyboard input, also return. */
3967 if (XINT (read_kbd
) != 0
3968 && requeued_events_pending_p ())
3971 /* If we are not checking for keyboard input now,
3972 do process events (but don't run any timers).
3973 This is so that X events will be processed.
3974 Otherwise they may have to wait until polling takes place.
3975 That would causes delays in pasting selections, for example.
3977 (We used to do this only if wait_for_cell.) */
3978 if (XINT (read_kbd
) == 0 && detect_input_pending ())
3980 swallow_events (do_display
);
3981 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
3982 if (detect_input_pending ())
3987 /* Exit now if the cell we're waiting for became non-nil. */
3988 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
3992 /* If we think we have keyboard input waiting, but didn't get SIGIO,
3993 go read it. This can happen with X on BSD after logging out.
3994 In that case, there really is no input and no SIGIO,
3995 but select says there is input. */
3997 if (XINT (read_kbd
) && interrupt_input
3998 && keyboard_bit_set (&Available
))
3999 kill (getpid (), SIGIO
);
4003 got_some_input
|= nfds
> 0;
4005 /* If checking input just got us a size-change event from X,
4006 obey it now if we should. */
4007 if (XINT (read_kbd
) || ! NILP (wait_for_cell
))
4008 do_pending_window_change (0);
4010 /* Check for data from a process. */
4011 if (no_avail
|| nfds
== 0)
4014 /* Really FIRST_PROC_DESC should be 0 on Unix,
4015 but this is safer in the short run. */
4016 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4018 if (FD_ISSET (channel
, &Available
)
4019 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4023 /* If waiting for this channel, arrange to return as
4024 soon as no more input to be processed. No more
4026 if (wait_channel
== channel
)
4032 proc
= chan_process
[channel
];
4036 /* If this is a server stream socket, accept connection. */
4037 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4039 server_accept_connection (proc
, channel
);
4043 /* Read data from the process, starting with our
4044 buffered-ahead character if we have one. */
4046 nread
= read_process_output (proc
, channel
);
4049 /* Since read_process_output can run a filter,
4050 which can call accept-process-output,
4051 don't try to read from any other processes
4052 before doing the select again. */
4053 FD_ZERO (&Available
);
4056 redisplay_preserve_echo_area (12);
4059 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4062 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4063 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4065 else if (nread
== -1 && errno
== EAGAIN
)
4069 else if (nread
== -1 && errno
== EAGAIN
)
4071 /* Note that we cannot distinguish between no input
4072 available now and a closed pipe.
4073 With luck, a closed pipe will be accompanied by
4074 subprocess termination and SIGCHLD. */
4075 else if (nread
== 0 && !NETCONN_P (proc
))
4077 #endif /* O_NDELAY */
4078 #endif /* O_NONBLOCK */
4080 /* On some OSs with ptys, when the process on one end of
4081 a pty exits, the other end gets an error reading with
4082 errno = EIO instead of getting an EOF (0 bytes read).
4083 Therefore, if we get an error reading and errno =
4084 EIO, just continue, because the child process has
4085 exited and should clean itself up soon (e.g. when we
4088 However, it has been known to happen that the SIGCHLD
4089 got lost. So raise the signl again just in case.
4091 else if (nread
== -1 && errno
== EIO
)
4092 kill (getpid (), SIGCHLD
);
4093 #endif /* HAVE_PTYS */
4094 /* If we can detect process termination, don't consider the process
4095 gone just because its pipe is closed. */
4097 else if (nread
== 0 && !NETCONN_P (proc
))
4102 /* Preserve status of processes already terminated. */
4103 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4104 deactivate_process (proc
);
4105 if (!NILP (XPROCESS (proc
)->raw_status_low
))
4106 update_status (XPROCESS (proc
));
4107 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4108 XPROCESS (proc
)->status
4109 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4112 #ifdef NON_BLOCKING_CONNECT
4113 if (check_connect
&& FD_ISSET (channel
, &Connecting
))
4115 struct Lisp_Process
*p
;
4117 FD_CLR (channel
, &connect_wait_mask
);
4118 if (--num_pending_connects
< 0)
4121 proc
= chan_process
[channel
];
4125 p
= XPROCESS (proc
);
4128 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4129 So only use it on systems where it is known to work. */
4131 int xlen
= sizeof(xerrno
);
4132 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4137 struct sockaddr pname
;
4138 int pnamelen
= sizeof(pname
);
4140 /* If connection failed, getpeername will fail. */
4142 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4144 /* Obtain connect failure code through error slippage. */
4147 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4154 XSETINT (p
->tick
, ++process_tick
);
4155 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4156 deactivate_process (proc
);
4161 /* Execute the sentinel here. If we had relied on
4162 status_notify to do it later, it will read input
4163 from the process before calling the sentinel. */
4164 exec_sentinel (proc
, build_string ("open\n"));
4165 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4167 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4168 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4172 #endif /* NON_BLOCKING_CONNECT */
4173 } /* end for each file descriptor */
4174 } /* end while exit conditions not met */
4176 waiting_for_user_input_p
= 0;
4178 /* If calling from keyboard input, do not quit
4179 since we want to return C-g as an input character.
4180 Otherwise, do pending quit if requested. */
4181 if (XINT (read_kbd
) >= 0)
4183 /* Prevent input_pending from remaining set if we quit. */
4184 clear_input_pending ();
4188 /* AlainF 5-Jul-1996
4189 HP-UX 10.10 seems to have problems with signals coming in
4190 Causes "poll: interrupted system call" messages when Emacs is run
4192 Turn periodic alarms back on */
4196 return got_some_input
;
4199 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4202 read_process_output_call (fun_and_args
)
4203 Lisp_Object fun_and_args
;
4205 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4209 read_process_output_error_handler (error
)
4212 cmd_error_internal (error
, "error in process filter: ");
4214 update_echo_area ();
4215 Fsleep_for (make_number (2), Qnil
);
4219 /* Read pending output from the process channel,
4220 starting with our buffered-ahead character if we have one.
4221 Yield number of decoded characters read.
4223 This function reads at most 1024 characters.
4224 If you want to read all available subprocess output,
4225 you must call it repeatedly until it returns zero.
4227 The characters read are decoded according to PROC's coding-system
4231 read_process_output (proc
, channel
)
4233 register int channel
;
4235 register int nchars
, nbytes
;
4237 register Lisp_Object outstream
;
4238 register struct buffer
*old
= current_buffer
;
4239 register struct Lisp_Process
*p
= XPROCESS (proc
);
4240 register int opoint
;
4241 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4242 int carryover
= XINT (p
->decoding_carryover
);
4246 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4248 vs
= get_vms_process_pointer (p
->pid
);
4252 return (0); /* Really weird if it does this */
4253 if (!(vs
->iosb
[0] & 1))
4254 return -1; /* I/O error */
4257 error ("Could not get VMS process pointer");
4258 chars
= vs
->inputBuffer
;
4259 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4262 start_vms_process_read (vs
); /* Crank up the next read on the process */
4263 return 1; /* Nothing worth printing, say we got 1 */
4267 /* The data carried over in the previous decoding (which are at
4268 the tail of decoding buffer) should be prepended to the new
4269 data read to decode all together. */
4270 chars
= (char *) alloca (nbytes
+ carryover
);
4271 bcopy (XSTRING (p
->decoding_buf
)->data
, buf
, carryover
);
4272 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4276 #ifdef DATAGRAM_SOCKETS
4277 /* A datagram is one packet; allow at least 1500+ bytes of data
4278 corresponding to the typical Ethernet frame size. */
4279 if (DATAGRAM_CHAN_P (channel
))
4281 /* carryover = 0; */ /* Does carryover make sense for datagrams? */
4286 chars
= (char *) alloca (carryover
+ readmax
);
4288 /* See the comment above. */
4289 bcopy (XSTRING (p
->decoding_buf
)->data
, chars
, carryover
);
4291 #ifdef DATAGRAM_SOCKETS
4292 /* We have a working select, so proc_buffered_char is always -1. */
4293 if (DATAGRAM_CHAN_P (channel
))
4295 int len
= datagram_address
[channel
].len
;
4296 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
- carryover
,
4297 0, datagram_address
[channel
].sa
, &len
);
4301 if (proc_buffered_char
[channel
] < 0)
4302 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
- carryover
);
4305 chars
[carryover
] = proc_buffered_char
[channel
];
4306 proc_buffered_char
[channel
] = -1;
4307 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1 - carryover
);
4311 nbytes
= nbytes
+ 1;
4313 #endif /* not VMS */
4315 XSETINT (p
->decoding_carryover
, 0);
4317 /* At this point, NBYTES holds number of bytes just received
4318 (including the one in proc_buffered_char[channel]). */
4321 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
4323 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4326 /* Now set NBYTES how many bytes we must decode. */
4327 nbytes
+= carryover
;
4329 /* Read and dispose of the process output. */
4330 outstream
= p
->filter
;
4331 if (!NILP (outstream
))
4333 /* We inhibit quit here instead of just catching it so that
4334 hitting ^G when a filter happens to be running won't screw
4336 int count
= specpdl_ptr
- specpdl
;
4337 Lisp_Object odeactivate
;
4338 Lisp_Object obuffer
, okeymap
;
4340 int outer_running_asynch_code
= running_asynch_code
;
4341 int waiting
= waiting_for_user_input_p
;
4343 /* No need to gcpro these, because all we do with them later
4344 is test them for EQness, and none of them should be a string. */
4345 odeactivate
= Vdeactivate_mark
;
4346 XSETBUFFER (obuffer
, current_buffer
);
4347 okeymap
= current_buffer
->keymap
;
4349 specbind (Qinhibit_quit
, Qt
);
4350 specbind (Qlast_nonmenu_event
, Qt
);
4352 /* In case we get recursively called,
4353 and we already saved the match data nonrecursively,
4354 save the same match data in safely recursive fashion. */
4355 if (outer_running_asynch_code
)
4358 /* Don't clobber the CURRENT match data, either! */
4359 tem
= Fmatch_data (Qnil
, Qnil
);
4360 restore_match_data ();
4361 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
4362 Fset_match_data (tem
);
4365 /* For speed, if a search happens within this code,
4366 save the match data in a special nonrecursive fashion. */
4367 running_asynch_code
= 1;
4369 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
4371 if (NILP (buffer_defaults
.enable_multibyte_characters
))
4372 /* We had better return unibyte string. */
4373 text
= string_make_unibyte (text
);
4375 Vlast_coding_system_used
= coding
->symbol
;
4376 /* A new coding system might be found. */
4377 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
4379 p
->decode_coding_system
= coding
->symbol
;
4381 /* Don't call setup_coding_system for
4382 proc_decode_coding_system[channel] here. It is done in
4383 detect_coding called via decode_coding above. */
4385 /* If a coding system for encoding is not yet decided, we set
4386 it as the same as coding-system for decoding.
4388 But, before doing that we must check if
4389 proc_encode_coding_system[p->outfd] surely points to a
4390 valid memory because p->outfd will be changed once EOF is
4391 sent to the process. */
4392 if (NILP (p
->encode_coding_system
)
4393 && proc_encode_coding_system
[XINT (p
->outfd
)])
4395 p
->encode_coding_system
= coding
->symbol
;
4396 setup_coding_system (coding
->symbol
,
4397 proc_encode_coding_system
[XINT (p
->outfd
)]);
4401 carryover
= nbytes
- coding
->consumed
;
4402 bcopy (chars
+ coding
->consumed
, XSTRING (p
->decoding_buf
)->data
,
4404 XSETINT (p
->decoding_carryover
, carryover
);
4405 nbytes
= STRING_BYTES (XSTRING (text
));
4406 nchars
= XSTRING (text
)->size
;
4408 internal_condition_case_1 (read_process_output_call
,
4410 Fcons (proc
, Fcons (text
, Qnil
))),
4411 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
4412 read_process_output_error_handler
);
4414 /* If we saved the match data nonrecursively, restore it now. */
4415 restore_match_data ();
4416 running_asynch_code
= outer_running_asynch_code
;
4418 /* Handling the process output should not deactivate the mark. */
4419 Vdeactivate_mark
= odeactivate
;
4421 /* Restore waiting_for_user_input_p as it was
4422 when we were called, in case the filter clobbered it. */
4423 waiting_for_user_input_p
= waiting
;
4425 #if 0 /* Call record_asynch_buffer_change unconditionally,
4426 because we might have changed minor modes or other things
4427 that affect key bindings. */
4428 if (! EQ (Fcurrent_buffer (), obuffer
)
4429 || ! EQ (current_buffer
->keymap
, okeymap
))
4431 /* But do it only if the caller is actually going to read events.
4432 Otherwise there's no need to make him wake up, and it could
4433 cause trouble (for example it would make Fsit_for return). */
4434 if (waiting_for_user_input_p
== -1)
4435 record_asynch_buffer_change ();
4438 start_vms_process_read (vs
);
4440 unbind_to (count
, Qnil
);
4444 /* If no filter, write into buffer if it isn't dead. */
4445 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
4447 Lisp_Object old_read_only
;
4448 int old_begv
, old_zv
;
4449 int old_begv_byte
, old_zv_byte
;
4450 Lisp_Object odeactivate
;
4451 int before
, before_byte
;
4456 odeactivate
= Vdeactivate_mark
;
4458 Fset_buffer (p
->buffer
);
4460 opoint_byte
= PT_BYTE
;
4461 old_read_only
= current_buffer
->read_only
;
4464 old_begv_byte
= BEGV_BYTE
;
4465 old_zv_byte
= ZV_BYTE
;
4467 current_buffer
->read_only
= Qnil
;
4469 /* Insert new output into buffer
4470 at the current end-of-output marker,
4471 thus preserving logical ordering of input and output. */
4472 if (XMARKER (p
->mark
)->buffer
)
4473 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
4474 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
4477 SET_PT_BOTH (ZV
, ZV_BYTE
);
4479 before_byte
= PT_BYTE
;
4481 /* If the output marker is outside of the visible region, save
4482 the restriction and widen. */
4483 if (! (BEGV
<= PT
&& PT
<= ZV
))
4486 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
4488 Vlast_coding_system_used
= coding
->symbol
;
4489 /* A new coding system might be found. See the comment in the
4490 similar code in the previous `if' block. */
4491 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
4493 p
->decode_coding_system
= coding
->symbol
;
4494 if (NILP (p
->encode_coding_system
)
4495 && proc_encode_coding_system
[XINT (p
->outfd
)])
4497 p
->encode_coding_system
= coding
->symbol
;
4498 setup_coding_system (coding
->symbol
,
4499 proc_encode_coding_system
[XINT (p
->outfd
)]);
4502 carryover
= nbytes
- coding
->consumed
;
4503 bcopy (chars
+ coding
->consumed
, XSTRING (p
->decoding_buf
)->data
,
4505 XSETINT (p
->decoding_carryover
, carryover
);
4506 /* Adjust the multibyteness of TEXT to that of the buffer. */
4507 if (NILP (current_buffer
->enable_multibyte_characters
)
4508 != ! STRING_MULTIBYTE (text
))
4509 text
= (STRING_MULTIBYTE (text
)
4510 ? Fstring_as_unibyte (text
)
4511 : Fstring_as_multibyte (text
));
4512 nbytes
= STRING_BYTES (XSTRING (text
));
4513 nchars
= XSTRING (text
)->size
;
4514 /* Insert before markers in case we are inserting where
4515 the buffer's mark is, and the user's next command is Meta-y. */
4516 insert_from_string_before_markers (text
, 0, 0, nchars
, nbytes
, 0);
4518 /* Make sure the process marker's position is valid when the
4519 process buffer is changed in the signal_after_change above.
4520 W3 is known to do that. */
4521 if (BUFFERP (p
->buffer
)
4522 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
4523 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
4525 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
4527 update_mode_lines
++;
4529 /* Make sure opoint and the old restrictions
4530 float ahead of any new text just as point would. */
4531 if (opoint
>= before
)
4533 opoint
+= PT
- before
;
4534 opoint_byte
+= PT_BYTE
- before_byte
;
4536 if (old_begv
> before
)
4538 old_begv
+= PT
- before
;
4539 old_begv_byte
+= PT_BYTE
- before_byte
;
4541 if (old_zv
>= before
)
4543 old_zv
+= PT
- before
;
4544 old_zv_byte
+= PT_BYTE
- before_byte
;
4547 /* If the restriction isn't what it should be, set it. */
4548 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
4549 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
4551 /* Handling the process output should not deactivate the mark. */
4552 Vdeactivate_mark
= odeactivate
;
4554 current_buffer
->read_only
= old_read_only
;
4555 SET_PT_BOTH (opoint
, opoint_byte
);
4556 set_buffer_internal (old
);
4559 start_vms_process_read (vs
);
4564 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
4566 doc
: /* Returns non-nil if emacs is waiting for input from the user.
4567 This is intended for use by asynchronous process output filters and sentinels. */)
4570 return (waiting_for_user_input_p
? Qt
: Qnil
);
4573 /* Sending data to subprocess */
4575 jmp_buf send_process_frame
;
4576 Lisp_Object process_sent_to
;
4579 send_process_trap ()
4585 longjmp (send_process_frame
, 1);
4588 /* Send some data to process PROC.
4589 BUF is the beginning of the data; LEN is the number of characters.
4590 OBJECT is the Lisp object that the data comes from. If OBJECT is
4591 nil or t, it means that the data comes from C string.
4593 If OBJECT is not nil, the data is encoded by PROC's coding-system
4594 for encoding before it is sent.
4596 This function can evaluate Lisp code and can garbage collect. */
4599 send_process (proc
, buf
, len
, object
)
4600 volatile Lisp_Object proc
;
4601 unsigned char *volatile buf
;
4603 volatile Lisp_Object object
;
4605 /* Use volatile to protect variables from being clobbered by longjmp. */
4607 struct coding_system
*coding
;
4608 struct gcpro gcpro1
;
4613 struct Lisp_Process
*p
= XPROCESS (proc
);
4614 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4617 if (! NILP (XPROCESS (proc
)->raw_status_low
))
4618 update_status (XPROCESS (proc
));
4619 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
4620 error ("Process %s not running",
4621 XSTRING (XPROCESS (proc
)->name
)->data
);
4622 if (XINT (XPROCESS (proc
)->outfd
) < 0)
4623 error ("Output file descriptor of %s is closed",
4624 XSTRING (XPROCESS (proc
)->name
)->data
);
4626 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
4627 Vlast_coding_system_used
= coding
->symbol
;
4629 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
4630 || (BUFFERP (object
)
4631 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
4634 if (!EQ (coding
->symbol
, XPROCESS (proc
)->encode_coding_system
))
4635 /* The coding system for encoding was changed to raw-text
4636 because we sent a unibyte text previously. Now we are
4637 sending a multibyte text, thus we must encode it by the
4638 original coding system specified for the current
4640 setup_coding_system (XPROCESS (proc
)->encode_coding_system
, coding
);
4641 /* src_multibyte should be set to 1 _after_ a call to
4642 setup_coding_system, since it resets src_multibyte to
4644 coding
->src_multibyte
= 1;
4648 /* For sending a unibyte text, character code conversion should
4649 not take place but EOL conversion should. So, setup raw-text
4650 or one of the subsidiary if we have not yet done it. */
4651 if (coding
->type
!= coding_type_raw_text
)
4653 if (CODING_REQUIRE_FLUSHING (coding
))
4655 /* But, before changing the coding, we must flush out data. */
4656 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4657 send_process (proc
, "", 0, Qt
);
4659 coding
->src_multibyte
= 0;
4660 setup_raw_text_coding_system (coding
);
4663 coding
->dst_multibyte
= 0;
4665 if (CODING_REQUIRE_ENCODING (coding
))
4667 int require
= encoding_buffer_size (coding
, len
);
4668 int from_byte
= -1, from
= -1, to
= -1;
4669 unsigned char *temp_buf
= NULL
;
4671 if (BUFFERP (object
))
4673 from_byte
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
4674 from
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
);
4675 to
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
+ len
);
4677 else if (STRINGP (object
))
4679 from_byte
= buf
- XSTRING (object
)->data
;
4680 from
= string_byte_to_char (object
, from_byte
);
4681 to
= string_byte_to_char (object
, from_byte
+ len
);
4684 if (coding
->composing
!= COMPOSITION_DISABLED
)
4687 coding_save_composition (coding
, from
, to
, object
);
4689 coding
->composing
= COMPOSITION_DISABLED
;
4692 if (STRING_BYTES (XSTRING (XPROCESS (proc
)->encoding_buf
)) < require
)
4693 XPROCESS (proc
)->encoding_buf
= make_uninit_string (require
);
4696 buf
= (BUFFERP (object
)
4697 ? BUF_BYTE_ADDRESS (XBUFFER (object
), from_byte
)
4698 : XSTRING (object
)->data
+ from_byte
);
4700 object
= XPROCESS (proc
)->encoding_buf
;
4701 encode_coding (coding
, (char *) buf
, XSTRING (object
)->data
,
4702 len
, STRING_BYTES (XSTRING (object
)));
4703 len
= coding
->produced
;
4704 buf
= XSTRING (object
)->data
;
4710 vs
= get_vms_process_pointer (p
->pid
);
4712 error ("Could not find this process: %x", p
->pid
);
4713 else if (write_to_vms_process (vs
, buf
, len
))
4717 if (pty_max_bytes
== 0)
4719 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
4720 pty_max_bytes
= fpathconf (XFASTINT (XPROCESS (proc
)->outfd
),
4722 if (pty_max_bytes
< 0)
4723 pty_max_bytes
= 250;
4725 pty_max_bytes
= 250;
4727 /* Deduct one, to leave space for the eof. */
4731 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
4732 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
4733 when returning with longjmp despite being declared volatile. */
4734 if (!setjmp (send_process_frame
))
4736 process_sent_to
= proc
;
4740 SIGTYPE (*old_sigpipe
)();
4742 /* Decide how much data we can send in one batch.
4743 Long lines need to be split into multiple batches. */
4744 if (!NILP (XPROCESS (proc
)->pty_flag
))
4746 /* Starting this at zero is always correct when not the first
4747 iteration because the previous iteration ended by sending C-d.
4748 It may not be correct for the first iteration
4749 if a partial line was sent in a separate send_process call.
4750 If that proves worth handling, we need to save linepos
4751 in the process object. */
4753 unsigned char *ptr
= (unsigned char *) buf
;
4754 unsigned char *end
= (unsigned char *) buf
+ len
;
4756 /* Scan through this text for a line that is too long. */
4757 while (ptr
!= end
&& linepos
< pty_max_bytes
)
4765 /* If we found one, break the line there
4766 and put in a C-d to force the buffer through. */
4770 /* Send this batch, using one or more write calls. */
4773 int outfd
= XINT (XPROCESS (proc
)->outfd
);
4774 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
4775 #ifdef DATAGRAM_SOCKETS
4776 if (DATAGRAM_CHAN_P (outfd
))
4778 rv
= sendto (outfd
, (char *) buf
, this,
4779 0, datagram_address
[outfd
].sa
,
4780 datagram_address
[outfd
].len
);
4781 if (rv
< 0 && errno
== EMSGSIZE
)
4782 report_file_error ("sending datagram", Fcons (proc
, Qnil
));
4786 rv
= emacs_write (outfd
, (char *) buf
, this);
4787 signal (SIGPIPE
, old_sigpipe
);
4793 || errno
== EWOULDBLOCK
4799 /* Buffer is full. Wait, accepting input;
4800 that may allow the program
4801 to finish doing output and read more. */
4806 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
4807 /* A gross hack to work around a bug in FreeBSD.
4808 In the following sequence, read(2) returns
4812 write(2) 954 bytes, get EAGAIN
4813 read(2) 1024 bytes in process_read_output
4814 read(2) 11 bytes in process_read_output
4816 That is, read(2) returns more bytes than have
4817 ever been written successfully. The 1033 bytes
4818 read are the 1022 bytes written successfully
4819 after processing (for example with CRs added if
4820 the terminal is set up that way which it is
4821 here). The same bytes will be seen again in a
4822 later read(2), without the CRs. */
4824 if (errno
== EAGAIN
)
4827 ioctl (XINT (XPROCESS (proc
)->outfd
), TIOCFLUSH
,
4830 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
4832 /* Running filters might relocate buffers or strings.
4833 Arrange to relocate BUF. */
4834 if (BUFFERP (object
))
4835 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
4836 else if (STRINGP (object
))
4837 offset
= buf
- XSTRING (object
)->data
;
4839 XSETFASTINT (zero
, 0);
4840 #ifdef EMACS_HAS_USECS
4841 wait_reading_process_input (0, 20000, zero
, 0);
4843 wait_reading_process_input (1, 0, zero
, 0);
4846 if (BUFFERP (object
))
4847 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
4848 else if (STRINGP (object
))
4849 buf
= offset
+ XSTRING (object
)->data
;
4854 /* This is a real error. */
4855 report_file_error ("writing to process", Fcons (proc
, Qnil
));
4862 /* If we sent just part of the string, put in an EOF
4863 to force it through, before we send the rest. */
4865 Fprocess_send_eof (proc
);
4868 #endif /* not VMS */
4872 proc
= process_sent_to
;
4874 XPROCESS (proc
)->raw_status_low
= Qnil
;
4875 XPROCESS (proc
)->raw_status_high
= Qnil
;
4876 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4877 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4878 deactivate_process (proc
);
4880 error ("Error writing to process %s; closed it",
4881 XSTRING (XPROCESS (proc
)->name
)->data
);
4883 error ("SIGPIPE raised on process %s; closed it",
4884 XSTRING (XPROCESS (proc
)->name
)->data
);
4891 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
4893 doc
: /* Send current contents of region as input to PROCESS.
4894 PROCESS may be a process, a buffer, the name of a process or buffer, or
4895 nil, indicating the current buffer's process.
4896 Called from program, takes three arguments, PROCESS, START and END.
4897 If the region is more than 500 characters long,
4898 it is sent in several bunches. This may happen even for shorter regions.
4899 Output from processes can arrive in between bunches. */)
4900 (process
, start
, end
)
4901 Lisp_Object process
, start
, end
;
4906 proc
= get_process (process
);
4907 validate_region (&start
, &end
);
4909 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
4910 move_gap (XINT (start
));
4912 start1
= CHAR_TO_BYTE (XINT (start
));
4913 end1
= CHAR_TO_BYTE (XINT (end
));
4914 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
4915 Fcurrent_buffer ());
4920 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
4922 doc
: /* Send PROCESS the contents of STRING as input.
4923 PROCESS may be a process, a buffer, the name of a process or buffer, or
4924 nil, indicating the current buffer's process.
4925 If STRING is more than 500 characters long,
4926 it is sent in several bunches. This may happen even for shorter strings.
4927 Output from processes can arrive in between bunches. */)
4929 Lisp_Object process
, string
;
4932 CHECK_STRING (string
);
4933 proc
= get_process (process
);
4934 send_process (proc
, XSTRING (string
)->data
,
4935 STRING_BYTES (XSTRING (string
)), string
);
4939 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
4940 Sprocess_running_child_p
, 0, 1, 0,
4941 doc
: /* Return t if PROCESS has given the terminal to a child.
4942 If the operating system does not make it possible to find out,
4943 return t unconditionally. */)
4945 Lisp_Object process
;
4947 /* Initialize in case ioctl doesn't exist or gives an error,
4948 in a way that will cause returning t. */
4951 struct Lisp_Process
*p
;
4953 proc
= get_process (process
);
4954 p
= XPROCESS (proc
);
4956 if (!EQ (p
->childp
, Qt
))
4957 error ("Process %s is not a subprocess",
4958 XSTRING (p
->name
)->data
);
4959 if (XINT (p
->infd
) < 0)
4960 error ("Process %s is not active",
4961 XSTRING (p
->name
)->data
);
4964 if (!NILP (p
->subtty
))
4965 ioctl (XFASTINT (p
->subtty
), TIOCGPGRP
, &gid
);
4967 ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
);
4968 #endif /* defined (TIOCGPGRP ) */
4970 if (gid
== XFASTINT (p
->pid
))
4975 /* send a signal number SIGNO to PROCESS.
4976 If CURRENT_GROUP is t, that means send to the process group
4977 that currently owns the terminal being used to communicate with PROCESS.
4978 This is used for various commands in shell mode.
4979 If CURRENT_GROUP is lambda, that means send to the process group
4980 that currently owns the terminal, but only if it is NOT the shell itself.
4982 If NOMSG is zero, insert signal-announcements into process's buffers
4985 If we can, we try to signal PROCESS by sending control characters
4986 down the pty. This allows us to signal inferiors who have changed
4987 their uid, for which killpg would return an EPERM error. */
4990 process_send_signal (process
, signo
, current_group
, nomsg
)
4991 Lisp_Object process
;
4993 Lisp_Object current_group
;
4997 register struct Lisp_Process
*p
;
5001 proc
= get_process (process
);
5002 p
= XPROCESS (proc
);
5004 if (!EQ (p
->childp
, Qt
))
5005 error ("Process %s is not a subprocess",
5006 XSTRING (p
->name
)->data
);
5007 if (XINT (p
->infd
) < 0)
5008 error ("Process %s is not active",
5009 XSTRING (p
->name
)->data
);
5011 if (NILP (p
->pty_flag
))
5012 current_group
= Qnil
;
5014 /* If we are using pgrps, get a pgrp number and make it negative. */
5015 if (!NILP (current_group
))
5017 #ifdef SIGNALS_VIA_CHARACTERS
5018 /* If possible, send signals to the entire pgrp
5019 by sending an input character to it. */
5021 /* TERMIOS is the latest and bestest, and seems most likely to
5022 work. If the system has it, use it. */
5029 tcgetattr (XINT (p
->infd
), &t
);
5030 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5034 tcgetattr (XINT (p
->infd
), &t
);
5035 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5039 tcgetattr (XINT (p
->infd
), &t
);
5040 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5041 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5043 send_process (proc
, &t
.c_cc
[VSUSP
], 1, Qnil
);
5048 #else /* ! HAVE_TERMIOS */
5050 /* On Berkeley descendants, the following IOCTL's retrieve the
5051 current control characters. */
5052 #if defined (TIOCGLTC) && defined (TIOCGETC)
5060 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5061 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5064 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5065 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5069 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5070 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5072 #endif /* ! defined (SIGTSTP) */
5075 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5077 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5084 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5085 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5088 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5089 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5093 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5094 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5096 #endif /* ! defined (SIGTSTP) */
5098 #else /* ! defined (TCGETA) */
5099 Your configuration files are messed up
.
5100 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5101 you'd better be using one of the alternatives above! */
5102 #endif /* ! defined (TCGETA) */
5103 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5104 #endif /* ! defined HAVE_TERMIOS */
5105 #endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
5108 /* Get the pgrp using the tty itself, if we have that.
5109 Otherwise, use the pty to get the pgrp.
5110 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5111 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5112 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5113 His patch indicates that if TIOCGPGRP returns an error, then
5114 we should just assume that p->pid is also the process group id. */
5118 if (!NILP (p
->subtty
))
5119 err
= ioctl (XFASTINT (p
->subtty
), TIOCGPGRP
, &gid
);
5121 err
= ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
);
5125 gid
= - XFASTINT (p
->pid
);
5126 #endif /* ! defined (pfa) */
5132 #else /* ! defined (TIOCGPGRP ) */
5133 /* Can't select pgrps on this system, so we know that
5134 the child itself heads the pgrp. */
5135 gid
= - XFASTINT (p
->pid
);
5136 #endif /* ! defined (TIOCGPGRP ) */
5138 /* If current_group is lambda, and the shell owns the terminal,
5139 don't send any signal. */
5140 if (EQ (current_group
, Qlambda
) && gid
== - XFASTINT (p
->pid
))
5144 gid
= - XFASTINT (p
->pid
);
5150 p
->raw_status_low
= Qnil
;
5151 p
->raw_status_high
= Qnil
;
5153 XSETINT (p
->tick
, ++process_tick
);
5157 #endif /* ! defined (SIGCONT) */
5160 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5165 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5170 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
5173 flush_pending_output (XINT (p
->infd
));
5177 /* If we don't have process groups, send the signal to the immediate
5178 subprocess. That isn't really right, but it's better than any
5179 obvious alternative. */
5182 kill (XFASTINT (p
->pid
), signo
);
5186 /* gid may be a pid, or minus a pgrp's number */
5188 if (!NILP (current_group
))
5189 ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
);
5192 gid
= - XFASTINT (p
->pid
);
5195 #else /* ! defined (TIOCSIGSEND) */
5196 EMACS_KILLPG (-gid
, signo
);
5197 #endif /* ! defined (TIOCSIGSEND) */
5200 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5201 doc
: /* Interrupt process PROCESS.
5202 PROCESS may be a process, a buffer, or the name of a process or buffer.
5203 nil or no arg means current buffer's process.
5204 Second arg CURRENT-GROUP non-nil means send signal to
5205 the current process-group of the process's controlling terminal
5206 rather than to the process's own process group.
5207 If the process is a shell, this means interrupt current subjob
5208 rather than the shell.
5210 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5211 don't send the signal. */)
5212 (process
, current_group
)
5213 Lisp_Object process
, current_group
;
5215 process_send_signal (process
, SIGINT
, current_group
, 0);
5219 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5220 doc
: /* Kill process PROCESS. May be process or name of one.
5221 See function `interrupt-process' for more details on usage. */)
5222 (process
, current_group
)
5223 Lisp_Object process
, current_group
;
5225 process_send_signal (process
, SIGKILL
, current_group
, 0);
5229 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5230 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5231 See function `interrupt-process' for more details on usage. */)
5232 (process
, current_group
)
5233 Lisp_Object process
, current_group
;
5235 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5239 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5240 doc
: /* Stop process PROCESS. May be process or name of one.
5241 See function `interrupt-process' for more details on usage.
5242 If PROCESS is a network process, inhibit handling of incoming traffic. */)
5243 (process
, current_group
)
5244 Lisp_Object process
, current_group
;
5247 if (PROCESSP (process
) && NETCONN_P (process
))
5249 struct Lisp_Process
*p
;
5251 p
= XPROCESS (process
);
5252 if (NILP (p
->command
)
5253 && XINT (p
->infd
) >= 0)
5255 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5256 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5263 error ("no SIGTSTP support");
5265 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5270 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
5271 doc
: /* Continue process PROCESS. May be process or name of one.
5272 See function `interrupt-process' for more details on usage.
5273 If PROCESS is a network process, resume handling of incoming traffic. */)
5274 (process
, current_group
)
5275 Lisp_Object process
, current_group
;
5278 if (PROCESSP (process
) && NETCONN_P (process
))
5280 struct Lisp_Process
*p
;
5282 p
= XPROCESS (process
);
5283 if (EQ (p
->command
, Qt
)
5284 && XINT (p
->infd
) >= 0
5285 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
5287 FD_SET (XINT (p
->infd
), &input_wait_mask
);
5288 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
5295 process_send_signal (process
, SIGCONT
, current_group
, 0);
5297 error ("no SIGCONT support");
5302 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
5303 2, 2, "nProcess number: \nnSignal code: ",
5304 doc
: /* Send the process with process id PID the signal with code SIGCODE.
5305 PID must be an integer. The process need not be a child of this Emacs.
5306 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
5308 Lisp_Object pid
, sigcode
;
5312 #define handle_signal(NAME, VALUE) \
5313 else if (!strcmp (name, NAME)) \
5314 XSETINT (sigcode, VALUE)
5316 if (INTEGERP (sigcode
))
5320 unsigned char *name
;
5322 CHECK_SYMBOL (sigcode
);
5323 name
= XSYMBOL (sigcode
)->name
->data
;
5328 handle_signal ("SIGHUP", SIGHUP
);
5331 handle_signal ("SIGINT", SIGINT
);
5334 handle_signal ("SIGQUIT", SIGQUIT
);
5337 handle_signal ("SIGILL", SIGILL
);
5340 handle_signal ("SIGABRT", SIGABRT
);
5343 handle_signal ("SIGEMT", SIGEMT
);
5346 handle_signal ("SIGKILL", SIGKILL
);
5349 handle_signal ("SIGFPE", SIGFPE
);
5352 handle_signal ("SIGBUS", SIGBUS
);
5355 handle_signal ("SIGSEGV", SIGSEGV
);
5358 handle_signal ("SIGSYS", SIGSYS
);
5361 handle_signal ("SIGPIPE", SIGPIPE
);
5364 handle_signal ("SIGALRM", SIGALRM
);
5367 handle_signal ("SIGTERM", SIGTERM
);
5370 handle_signal ("SIGURG", SIGURG
);
5373 handle_signal ("SIGSTOP", SIGSTOP
);
5376 handle_signal ("SIGTSTP", SIGTSTP
);
5379 handle_signal ("SIGCONT", SIGCONT
);
5382 handle_signal ("SIGCHLD", SIGCHLD
);
5385 handle_signal ("SIGTTIN", SIGTTIN
);
5388 handle_signal ("SIGTTOU", SIGTTOU
);
5391 handle_signal ("SIGIO", SIGIO
);
5394 handle_signal ("SIGXCPU", SIGXCPU
);
5397 handle_signal ("SIGXFSZ", SIGXFSZ
);
5400 handle_signal ("SIGVTALRM", SIGVTALRM
);
5403 handle_signal ("SIGPROF", SIGPROF
);
5406 handle_signal ("SIGWINCH", SIGWINCH
);
5409 handle_signal ("SIGINFO", SIGINFO
);
5412 handle_signal ("SIGUSR1", SIGUSR1
);
5415 handle_signal ("SIGUSR2", SIGUSR2
);
5418 error ("Undefined signal name %s", name
);
5421 #undef handle_signal
5423 return make_number (kill (XINT (pid
), XINT (sigcode
)));
5426 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
5427 doc
: /* Make PROCESS see end-of-file in its input.
5428 EOF comes after any text already sent to it.
5429 PROCESS may be a process, a buffer, the name of a process or buffer, or
5430 nil, indicating the current buffer's process.
5431 If PROCESS is a network connection, or is a process communicating
5432 through a pipe (as opposed to a pty), then you cannot send any more
5433 text to PROCESS after you call this function. */)
5435 Lisp_Object process
;
5438 struct coding_system
*coding
;
5440 if (DATAGRAM_CONN_P (process
))
5443 proc
= get_process (process
);
5444 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
5446 /* Make sure the process is really alive. */
5447 if (! NILP (XPROCESS (proc
)->raw_status_low
))
5448 update_status (XPROCESS (proc
));
5449 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
5450 error ("Process %s not running", XSTRING (XPROCESS (proc
)->name
)->data
);
5452 if (CODING_REQUIRE_FLUSHING (coding
))
5454 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5455 send_process (proc
, "", 0, Qnil
);
5459 send_process (proc
, "\032", 1, Qnil
); /* ^z */
5461 if (!NILP (XPROCESS (proc
)->pty_flag
))
5462 send_process (proc
, "\004", 1, Qnil
);
5465 int old_outfd
, new_outfd
;
5467 #ifdef HAVE_SHUTDOWN
5468 /* If this is a network connection, or socketpair is used
5469 for communication with the subprocess, call shutdown to cause EOF.
5470 (In some old system, shutdown to socketpair doesn't work.
5471 Then we just can't win.) */
5472 if (NILP (XPROCESS (proc
)->pid
)
5473 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
5474 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
5475 /* In case of socketpair, outfd == infd, so don't close it. */
5476 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
5477 emacs_close (XINT (XPROCESS (proc
)->outfd
));
5478 #else /* not HAVE_SHUTDOWN */
5479 emacs_close (XINT (XPROCESS (proc
)->outfd
));
5480 #endif /* not HAVE_SHUTDOWN */
5481 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
5482 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
5484 if (!proc_encode_coding_system
[new_outfd
])
5485 proc_encode_coding_system
[new_outfd
]
5486 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
5487 bcopy (proc_encode_coding_system
[old_outfd
],
5488 proc_encode_coding_system
[new_outfd
],
5489 sizeof (struct coding_system
));
5490 bzero (proc_encode_coding_system
[old_outfd
],
5491 sizeof (struct coding_system
));
5493 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
5499 /* Kill all processes associated with `buffer'.
5500 If `buffer' is nil, kill all processes */
5503 kill_buffer_processes (buffer
)
5506 Lisp_Object tail
, proc
;
5508 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5510 proc
= XCDR (XCAR (tail
));
5511 if (GC_PROCESSP (proc
)
5512 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
5514 if (NETCONN_P (proc
))
5515 Fdelete_process (proc
);
5516 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
5517 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
5522 /* On receipt of a signal that a child status has changed, loop asking
5523 about children with changed statuses until the system says there
5526 All we do is change the status; we do not run sentinels or print
5527 notifications. That is saved for the next time keyboard input is
5528 done, in order to avoid timing errors.
5530 ** WARNING: this can be called during garbage collection.
5531 Therefore, it must not be fooled by the presence of mark bits in
5534 ** USG WARNING: Although it is not obvious from the documentation
5535 in signal(2), on a USG system the SIGCLD handler MUST NOT call
5536 signal() before executing at least one wait(), otherwise the
5537 handler will be called again, resulting in an infinite loop. The
5538 relevant portion of the documentation reads "SIGCLD signals will be
5539 queued and the signal-catching function will be continually
5540 reentered until the queue is empty". Invoking signal() causes the
5541 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
5545 sigchld_handler (signo
)
5548 int old_errno
= errno
;
5550 register struct Lisp_Process
*p
;
5551 extern EMACS_TIME
*input_available_clear_time
;
5555 sigheld
|= sigbit (SIGCHLD
);
5567 #endif /* no WUNTRACED */
5568 /* Keep trying to get a status until we get a definitive result. */
5572 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
5574 while (pid
< 0 && errno
== EINTR
);
5578 /* PID == 0 means no processes found, PID == -1 means a real
5579 failure. We have done all our job, so return. */
5581 /* USG systems forget handlers when they are used;
5582 must reestablish each time */
5583 #if defined (USG) && !defined (POSIX_SIGNALS)
5584 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
5587 sigheld
&= ~sigbit (SIGCHLD
);
5595 #endif /* no WNOHANG */
5597 /* Find the process that signaled us, and record its status. */
5600 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5602 proc
= XCDR (XCAR (tail
));
5603 p
= XPROCESS (proc
);
5604 if (GC_EQ (p
->childp
, Qt
) && XINT (p
->pid
) == pid
)
5609 /* Look for an asynchronous process whose pid hasn't been filled
5612 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5614 proc
= XCDR (XCAR (tail
));
5615 p
= XPROCESS (proc
);
5616 if (GC_INTEGERP (p
->pid
) && XINT (p
->pid
) == -1)
5621 /* Change the status of the process that was found. */
5624 union { int i
; WAITTYPE wt
; } u
;
5625 int clear_desc_flag
= 0;
5627 XSETINT (p
->tick
, ++process_tick
);
5629 XSETINT (p
->raw_status_low
, u
.i
& 0xffff);
5630 XSETINT (p
->raw_status_high
, u
.i
>> 16);
5632 /* If process has terminated, stop waiting for its output. */
5633 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
5634 && XINT (p
->infd
) >= 0)
5635 clear_desc_flag
= 1;
5637 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
5638 if (clear_desc_flag
)
5640 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5641 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5644 /* Tell wait_reading_process_input that it needs to wake up and
5646 if (input_available_clear_time
)
5647 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
5650 /* There was no asynchronous process found for that id. Check
5651 if we have a synchronous process. */
5654 synch_process_alive
= 0;
5656 /* Report the status of the synchronous process. */
5658 synch_process_retcode
= WRETCODE (w
);
5659 else if (WIFSIGNALED (w
))
5661 int code
= WTERMSIG (w
);
5664 synchronize_system_messages_locale ();
5665 signame
= strsignal (code
);
5668 signame
= "unknown";
5670 synch_process_death
= signame
;
5673 /* Tell wait_reading_process_input that it needs to wake up and
5675 if (input_available_clear_time
)
5676 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
5679 /* On some systems, we must return right away.
5680 If any more processes want to signal us, we will
5682 Otherwise (on systems that have WNOHANG), loop around
5683 to use up all the processes that have something to tell us. */
5684 #if (defined WINDOWSNT \
5685 || (defined USG && !defined GNU_LINUX \
5686 && !(defined HPUX && defined WNOHANG)))
5687 #if defined (USG) && ! defined (POSIX_SIGNALS)
5688 signal (signo
, sigchld_handler
);
5692 #endif /* USG, but not HPUX with WNOHANG */
5698 exec_sentinel_unwind (data
)
5701 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
5706 exec_sentinel_error_handler (error
)
5709 cmd_error_internal (error
, "error in process sentinel: ");
5711 update_echo_area ();
5712 Fsleep_for (make_number (2), Qnil
);
5717 exec_sentinel (proc
, reason
)
5718 Lisp_Object proc
, reason
;
5720 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
5721 register struct Lisp_Process
*p
= XPROCESS (proc
);
5722 int count
= specpdl_ptr
- specpdl
;
5723 int outer_running_asynch_code
= running_asynch_code
;
5724 int waiting
= waiting_for_user_input_p
;
5726 /* No need to gcpro these, because all we do with them later
5727 is test them for EQness, and none of them should be a string. */
5728 odeactivate
= Vdeactivate_mark
;
5729 XSETBUFFER (obuffer
, current_buffer
);
5730 okeymap
= current_buffer
->keymap
;
5732 sentinel
= p
->sentinel
;
5733 if (NILP (sentinel
))
5736 /* Zilch the sentinel while it's running, to avoid recursive invocations;
5737 assure that it gets restored no matter how the sentinel exits. */
5739 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
5740 /* Inhibit quit so that random quits don't screw up a running filter. */
5741 specbind (Qinhibit_quit
, Qt
);
5742 specbind (Qlast_nonmenu_event
, Qt
);
5744 /* In case we get recursively called,
5745 and we already saved the match data nonrecursively,
5746 save the same match data in safely recursive fashion. */
5747 if (outer_running_asynch_code
)
5750 tem
= Fmatch_data (Qnil
, Qnil
);
5751 restore_match_data ();
5752 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
5753 Fset_match_data (tem
);
5756 /* For speed, if a search happens within this code,
5757 save the match data in a special nonrecursive fashion. */
5758 running_asynch_code
= 1;
5760 internal_condition_case_1 (read_process_output_call
,
5762 Fcons (proc
, Fcons (reason
, Qnil
))),
5763 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5764 exec_sentinel_error_handler
);
5766 /* If we saved the match data nonrecursively, restore it now. */
5767 restore_match_data ();
5768 running_asynch_code
= outer_running_asynch_code
;
5770 Vdeactivate_mark
= odeactivate
;
5772 /* Restore waiting_for_user_input_p as it was
5773 when we were called, in case the filter clobbered it. */
5774 waiting_for_user_input_p
= waiting
;
5777 if (! EQ (Fcurrent_buffer (), obuffer
)
5778 || ! EQ (current_buffer
->keymap
, okeymap
))
5780 /* But do it only if the caller is actually going to read events.
5781 Otherwise there's no need to make him wake up, and it could
5782 cause trouble (for example it would make Fsit_for return). */
5783 if (waiting_for_user_input_p
== -1)
5784 record_asynch_buffer_change ();
5786 unbind_to (count
, Qnil
);
5789 /* Report all recent events of a change in process status
5790 (either run the sentinel or output a message).
5791 This is usually done while Emacs is waiting for keyboard input
5792 but can be done at other times. */
5797 register Lisp_Object proc
, buffer
;
5798 Lisp_Object tail
, msg
;
5799 struct gcpro gcpro1
, gcpro2
;
5803 /* We need to gcpro tail; if read_process_output calls a filter
5804 which deletes a process and removes the cons to which tail points
5805 from Vprocess_alist, and then causes a GC, tail is an unprotected
5809 /* Set this now, so that if new processes are created by sentinels
5810 that we run, we get called again to handle their status changes. */
5811 update_tick
= process_tick
;
5813 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
5816 register struct Lisp_Process
*p
;
5818 proc
= Fcdr (Fcar (tail
));
5819 p
= XPROCESS (proc
);
5821 if (XINT (p
->tick
) != XINT (p
->update_tick
))
5823 XSETINT (p
->update_tick
, XINT (p
->tick
));
5825 /* If process is still active, read any output that remains. */
5826 while (! EQ (p
->filter
, Qt
)
5827 && ! EQ (p
->status
, Qconnect
)
5828 && ! EQ (p
->status
, Qlisten
)
5829 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
5830 && XINT (p
->infd
) >= 0
5831 && read_process_output (proc
, XINT (p
->infd
)) > 0);
5835 /* Get the text to use for the message. */
5836 if (!NILP (p
->raw_status_low
))
5838 msg
= status_message (p
->status
);
5840 /* If process is terminated, deactivate it or delete it. */
5842 if (CONSP (p
->status
))
5843 symbol
= XCAR (p
->status
);
5845 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
5846 || EQ (symbol
, Qclosed
))
5848 if (delete_exited_processes
)
5849 remove_process (proc
);
5851 deactivate_process (proc
);
5854 /* The actions above may have further incremented p->tick.
5855 So set p->update_tick again
5856 so that an error in the sentinel will not cause
5857 this code to be run again. */
5858 XSETINT (p
->update_tick
, XINT (p
->tick
));
5859 /* Now output the message suitably. */
5860 if (!NILP (p
->sentinel
))
5861 exec_sentinel (proc
, msg
);
5862 /* Don't bother with a message in the buffer
5863 when a process becomes runnable. */
5864 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
5866 Lisp_Object ro
, tem
;
5867 struct buffer
*old
= current_buffer
;
5868 int opoint
, opoint_byte
;
5869 int before
, before_byte
;
5871 ro
= XBUFFER (buffer
)->read_only
;
5873 /* Avoid error if buffer is deleted
5874 (probably that's why the process is dead, too) */
5875 if (NILP (XBUFFER (buffer
)->name
))
5877 Fset_buffer (buffer
);
5880 opoint_byte
= PT_BYTE
;
5881 /* Insert new output into buffer
5882 at the current end-of-output marker,
5883 thus preserving logical ordering of input and output. */
5884 if (XMARKER (p
->mark
)->buffer
)
5885 Fgoto_char (p
->mark
);
5887 SET_PT_BOTH (ZV
, ZV_BYTE
);
5890 before_byte
= PT_BYTE
;
5892 tem
= current_buffer
->read_only
;
5893 current_buffer
->read_only
= Qnil
;
5894 insert_string ("\nProcess ");
5895 Finsert (1, &p
->name
);
5896 insert_string (" ");
5898 current_buffer
->read_only
= tem
;
5899 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5901 if (opoint
>= before
)
5902 SET_PT_BOTH (opoint
+ (PT
- before
),
5903 opoint_byte
+ (PT_BYTE
- before_byte
));
5905 SET_PT_BOTH (opoint
, opoint_byte
);
5907 set_buffer_internal (old
);
5912 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
5913 redisplay_preserve_echo_area (13);
5919 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
5920 Sset_process_coding_system
, 1, 3, 0,
5921 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
5922 DECODING will be used to decode subprocess output and ENCODING to
5923 encode subprocess input. */)
5924 (proc
, decoding
, encoding
)
5925 register Lisp_Object proc
, decoding
, encoding
;
5927 register struct Lisp_Process
*p
;
5929 CHECK_PROCESS (proc
);
5930 p
= XPROCESS (proc
);
5931 if (XINT (p
->infd
) < 0)
5932 error ("Input file descriptor of %s closed", XSTRING (p
->name
)->data
);
5933 if (XINT (p
->outfd
) < 0)
5934 error ("Output file descriptor of %s closed", XSTRING (p
->name
)->data
);
5936 p
->decode_coding_system
= Fcheck_coding_system (decoding
);
5937 p
->encode_coding_system
= Fcheck_coding_system (encoding
);
5938 setup_coding_system (decoding
,
5939 proc_decode_coding_system
[XINT (p
->infd
)]);
5940 setup_coding_system (encoding
,
5941 proc_encode_coding_system
[XINT (p
->outfd
)]);
5946 DEFUN ("process-coding-system",
5947 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
5948 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
5950 register Lisp_Object proc
;
5952 CHECK_PROCESS (proc
);
5953 return Fcons (XPROCESS (proc
)->decode_coding_system
,
5954 XPROCESS (proc
)->encode_coding_system
);
5957 /* The first time this is called, assume keyboard input comes from DESC
5958 instead of from where we used to expect it.
5959 Subsequent calls mean assume input keyboard can come from DESC
5960 in addition to other places. */
5962 static int add_keyboard_wait_descriptor_called_flag
;
5965 add_keyboard_wait_descriptor (desc
)
5968 if (! add_keyboard_wait_descriptor_called_flag
)
5969 FD_CLR (0, &input_wait_mask
);
5970 add_keyboard_wait_descriptor_called_flag
= 1;
5971 FD_SET (desc
, &input_wait_mask
);
5972 FD_SET (desc
, &non_process_wait_mask
);
5973 if (desc
> max_keyboard_desc
)
5974 max_keyboard_desc
= desc
;
5977 /* From now on, do not expect DESC to give keyboard input. */
5980 delete_keyboard_wait_descriptor (desc
)
5984 int lim
= max_keyboard_desc
;
5986 FD_CLR (desc
, &input_wait_mask
);
5987 FD_CLR (desc
, &non_process_wait_mask
);
5989 if (desc
== max_keyboard_desc
)
5990 for (fd
= 0; fd
< lim
; fd
++)
5991 if (FD_ISSET (fd
, &input_wait_mask
)
5992 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
5993 max_keyboard_desc
= fd
;
5996 /* Return nonzero if *MASK has a bit set
5997 that corresponds to one of the keyboard input descriptors. */
6000 keyboard_bit_set (mask
)
6005 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6006 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6007 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6020 if (! noninteractive
|| initialized
)
6022 signal (SIGCHLD
, sigchld_handler
);
6025 FD_ZERO (&input_wait_mask
);
6026 FD_ZERO (&non_keyboard_wait_mask
);
6027 FD_ZERO (&non_process_wait_mask
);
6028 max_process_desc
= 0;
6030 FD_SET (0, &input_wait_mask
);
6032 Vprocess_alist
= Qnil
;
6033 for (i
= 0; i
< MAXDESC
; i
++)
6035 chan_process
[i
] = Qnil
;
6036 proc_buffered_char
[i
] = -1;
6038 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6039 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6040 #ifdef DATAGRAM_SOCKETS
6041 bzero (datagram_address
, sizeof datagram_address
);
6046 Lisp_Object subfeatures
= Qnil
;
6047 #define ADD_SUBFEATURE(key, val) \
6048 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6050 #ifdef NON_BLOCKING_CONNECT
6051 ADD_SUBFEATURE (QCnowait
, Qt
);
6053 #ifdef DATAGRAM_SOCKETS
6054 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6056 #ifdef HAVE_LOCAL_SOCKETS
6057 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6059 #ifdef HAVE_GETSOCKNAME
6060 ADD_SUBFEATURE (QCservice
, Qt
);
6063 ADD_SUBFEATURE (QCserver
, Qt
);
6065 #ifdef SO_BINDTODEVICE
6066 ADD_SUBFEATURE (QCoptions
, intern ("bindtodevice"));
6069 ADD_SUBFEATURE (QCoptions
, intern ("broadcast"));
6072 ADD_SUBFEATURE (QCoptions
, intern ("dontroute"));
6075 ADD_SUBFEATURE (QCoptions
, intern ("keepalive"));
6078 ADD_SUBFEATURE (QCoptions
, intern ("linger"));
6081 ADD_SUBFEATURE (QCoptions
, intern ("oobinline"));
6084 ADD_SUBFEATURE (QCoptions
, intern ("priority"));
6087 ADD_SUBFEATURE (QCoptions
, intern ("reuseaddr"));
6089 Fprovide (intern ("make-network-process"), subfeatures
);
6091 #endif /* HAVE_SOCKETS */
6097 Qprocessp
= intern ("processp");
6098 staticpro (&Qprocessp
);
6099 Qrun
= intern ("run");
6101 Qstop
= intern ("stop");
6103 Qsignal
= intern ("signal");
6104 staticpro (&Qsignal
);
6106 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
6109 Qexit = intern ("exit");
6110 staticpro (&Qexit); */
6112 Qopen
= intern ("open");
6114 Qclosed
= intern ("closed");
6115 staticpro (&Qclosed
);
6116 Qconnect
= intern ("connect");
6117 staticpro (&Qconnect
);
6118 Qfailed
= intern ("failed");
6119 staticpro (&Qfailed
);
6120 Qlisten
= intern ("listen");
6121 staticpro (&Qlisten
);
6122 Qlocal
= intern ("local");
6123 staticpro (&Qlocal
);
6124 Qdatagram
= intern ("datagram");
6125 staticpro (&Qdatagram
);
6127 QCname
= intern (":name");
6128 staticpro (&QCname
);
6129 QCbuffer
= intern (":buffer");
6130 staticpro (&QCbuffer
);
6131 QChost
= intern (":host");
6132 staticpro (&QChost
);
6133 QCservice
= intern (":service");
6134 staticpro (&QCservice
);
6135 QCtype
= intern (":type");
6136 staticpro (&QCtype
);
6137 QClocal
= intern (":local");
6138 staticpro (&QClocal
);
6139 QCremote
= intern (":remote");
6140 staticpro (&QCremote
);
6141 QCcoding
= intern (":coding");
6142 staticpro (&QCcoding
);
6143 QCserver
= intern (":server");
6144 staticpro (&QCserver
);
6145 QCnowait
= intern (":nowait");
6146 staticpro (&QCnowait
);
6147 QCsentinel
= intern (":sentinel");
6148 staticpro (&QCsentinel
);
6149 QClog
= intern (":log");
6151 QCnoquery
= intern (":noquery");
6152 staticpro (&QCnoquery
);
6153 QCstop
= intern (":stop");
6154 staticpro (&QCstop
);
6155 QCoptions
= intern (":options");
6156 staticpro (&QCoptions
);
6158 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
6159 staticpro (&Qlast_nonmenu_event
);
6161 staticpro (&Vprocess_alist
);
6163 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
6164 doc
: /* *Non-nil means delete processes immediately when they exit.
6165 nil means don't delete them until `list-processes' is run. */);
6167 delete_exited_processes
= 1;
6169 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
6170 doc
: /* Control type of device used to communicate with subprocesses.
6171 Values are nil to use a pipe, or t or `pty' to use a pty.
6172 The value has no effect if the system has no ptys or if all ptys are busy:
6173 then a pipe is used in any case.
6174 The value takes effect when `start-process' is called. */);
6175 Vprocess_connection_type
= Qt
;
6177 defsubr (&Sprocessp
);
6178 defsubr (&Sget_process
);
6179 defsubr (&Sget_buffer_process
);
6180 defsubr (&Sdelete_process
);
6181 defsubr (&Sprocess_status
);
6182 defsubr (&Sprocess_exit_status
);
6183 defsubr (&Sprocess_id
);
6184 defsubr (&Sprocess_name
);
6185 defsubr (&Sprocess_tty_name
);
6186 defsubr (&Sprocess_command
);
6187 defsubr (&Sset_process_buffer
);
6188 defsubr (&Sprocess_buffer
);
6189 defsubr (&Sprocess_mark
);
6190 defsubr (&Sset_process_filter
);
6191 defsubr (&Sprocess_filter
);
6192 defsubr (&Sset_process_sentinel
);
6193 defsubr (&Sprocess_sentinel
);
6194 defsubr (&Sset_process_window_size
);
6195 defsubr (&Sset_process_inherit_coding_system_flag
);
6196 defsubr (&Sprocess_inherit_coding_system_flag
);
6197 defsubr (&Sset_process_query_on_exit_flag
);
6198 defsubr (&Sprocess_query_on_exit_flag
);
6199 defsubr (&Sprocess_contact
);
6200 defsubr (&Slist_processes
);
6201 defsubr (&Sprocess_list
);
6202 defsubr (&Sstart_process
);
6204 defsubr (&Sset_network_process_options
);
6205 defsubr (&Smake_network_process
);
6206 #endif /* HAVE_SOCKETS */
6207 #ifdef DATAGRAM_SOCKETS
6208 defsubr (&Sprocess_datagram_address
);
6209 defsubr (&Sset_process_datagram_address
);
6211 defsubr (&Saccept_process_output
);
6212 defsubr (&Sprocess_send_region
);
6213 defsubr (&Sprocess_send_string
);
6214 defsubr (&Sinterrupt_process
);
6215 defsubr (&Skill_process
);
6216 defsubr (&Squit_process
);
6217 defsubr (&Sstop_process
);
6218 defsubr (&Scontinue_process
);
6219 defsubr (&Sprocess_running_child_p
);
6220 defsubr (&Sprocess_send_eof
);
6221 defsubr (&Ssignal_process
);
6222 defsubr (&Swaiting_for_user_input_p
);
6223 /* defsubr (&Sprocess_connection); */
6224 defsubr (&Sset_process_coding_system
);
6225 defsubr (&Sprocess_coding_system
);
6229 #else /* not subprocesses */
6231 #include <sys/types.h>
6235 #include "systime.h"
6236 #include "charset.h"
6238 #include "termopts.h"
6239 #include "sysselect.h"
6241 extern int frame_garbaged
;
6243 extern EMACS_TIME
timer_check ();
6244 extern int timers_run
;
6248 /* As described above, except assuming that there are no subprocesses:
6250 Wait for timeout to elapse and/or keyboard input to be available.
6253 timeout in seconds, or
6254 zero for no limit, or
6255 -1 means gobble data immediately available but don't wait for any.
6257 read_kbd is a Lisp_Object:
6258 0 to ignore keyboard input, or
6259 1 to return when input is available, or
6260 -1 means caller will actually read the input, so don't throw to
6262 a cons cell, meaning wait until its car is non-nil
6263 (and gobble terminal input into the buffer if any arrives), or
6264 We know that read_kbd will never be a Lisp_Process, since
6265 `subprocesses' isn't defined.
6267 do_display != 0 means redisplay should be done to show subprocess
6268 output that arrives.
6270 Return true iff we received input from any process. */
6273 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
6274 int time_limit
, microsecs
;
6275 Lisp_Object read_kbd
;
6279 EMACS_TIME end_time
, timeout
;
6280 SELECT_TYPE waitchannels
;
6282 /* Either nil or a cons cell, the car of which is of interest and
6283 may be changed outside of this routine. */
6284 Lisp_Object wait_for_cell
= Qnil
;
6286 /* If waiting for non-nil in a cell, record where. */
6287 if (CONSP (read_kbd
))
6289 wait_for_cell
= read_kbd
;
6290 XSETFASTINT (read_kbd
, 0);
6293 /* What does time_limit really mean? */
6294 if (time_limit
|| microsecs
)
6296 EMACS_GET_TIME (end_time
);
6297 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
6298 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
6301 /* Turn off periodic alarms (in case they are in use)
6302 because the select emulator uses alarms. */
6303 turn_on_atimers (0);
6307 int timeout_reduced_for_timers
= 0;
6309 /* If calling from keyboard input, do not quit
6310 since we want to return C-g as an input character.
6311 Otherwise, do pending quit if requested. */
6312 if (XINT (read_kbd
) >= 0)
6315 /* Exit now if the cell we're waiting for became non-nil. */
6316 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6319 /* Compute time from now till when time limit is up */
6320 /* Exit if already run out */
6321 if (time_limit
== -1)
6323 /* -1 specified for timeout means
6324 gobble output available now
6325 but don't wait at all. */
6327 EMACS_SET_SECS_USECS (timeout
, 0, 0);
6329 else if (time_limit
|| microsecs
)
6331 EMACS_GET_TIME (timeout
);
6332 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
6333 if (EMACS_TIME_NEG_P (timeout
))
6338 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
6341 /* If our caller will not immediately handle keyboard events,
6342 run timer events directly.
6343 (Callers that will immediately read keyboard events
6344 call timer_delay on their own.) */
6345 if (NILP (wait_for_cell
))
6347 EMACS_TIME timer_delay
;
6351 int old_timers_run
= timers_run
;
6352 timer_delay
= timer_check (1);
6353 if (timers_run
!= old_timers_run
&& do_display
)
6354 /* We must retry, since a timer may have requeued itself
6355 and that could alter the time delay. */
6356 redisplay_preserve_echo_area (14);
6360 while (!detect_input_pending ());
6362 /* If there is unread keyboard input, also return. */
6363 if (XINT (read_kbd
) != 0
6364 && requeued_events_pending_p ())
6367 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
6369 EMACS_TIME difference
;
6370 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
6371 if (EMACS_TIME_NEG_P (difference
))
6373 timeout
= timer_delay
;
6374 timeout_reduced_for_timers
= 1;
6379 /* Cause C-g and alarm signals to take immediate action,
6380 and cause input available signals to zero out timeout. */
6381 if (XINT (read_kbd
) < 0)
6382 set_waiting_for_input (&timeout
);
6384 /* Wait till there is something to do. */
6386 if (! XINT (read_kbd
) && NILP (wait_for_cell
))
6387 FD_ZERO (&waitchannels
);
6389 FD_SET (0, &waitchannels
);
6391 /* If a frame has been newly mapped and needs updating,
6392 reprocess its display stuff. */
6393 if (frame_garbaged
&& do_display
)
6395 clear_waiting_for_input ();
6396 redisplay_preserve_echo_area (15);
6397 if (XINT (read_kbd
) < 0)
6398 set_waiting_for_input (&timeout
);
6401 if (XINT (read_kbd
) && detect_input_pending ())
6404 FD_ZERO (&waitchannels
);
6407 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
6412 /* Make C-g and alarm signals set flags again */
6413 clear_waiting_for_input ();
6415 /* If we woke up due to SIGWINCH, actually change size now. */
6416 do_pending_window_change (0);
6418 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
6419 /* We waited the full specified time, so return now. */
6424 /* If the system call was interrupted, then go around the
6426 if (xerrno
== EINTR
)
6427 FD_ZERO (&waitchannels
);
6429 error ("select error: %s", emacs_strerror (xerrno
));
6432 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
6433 /* System sometimes fails to deliver SIGIO. */
6434 kill (getpid (), SIGIO
);
6437 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
6438 kill (getpid (), SIGIO
);
6441 /* Check for keyboard input */
6443 if ((XINT (read_kbd
) != 0)
6444 && detect_input_pending_run_timers (do_display
))
6446 swallow_events (do_display
);
6447 if (detect_input_pending_run_timers (do_display
))
6451 /* If there is unread keyboard input, also return. */
6452 if (XINT (read_kbd
) != 0
6453 && requeued_events_pending_p ())
6456 /* If wait_for_cell. check for keyboard input
6457 but don't run any timers.
6458 ??? (It seems wrong to me to check for keyboard
6459 input at all when wait_for_cell, but the code
6460 has been this way since July 1994.
6461 Try changing this after version 19.31.) */
6462 if (! NILP (wait_for_cell
)
6463 && detect_input_pending ())
6465 swallow_events (do_display
);
6466 if (detect_input_pending ())
6470 /* Exit now if the cell we're waiting for became non-nil. */
6471 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6481 /* Don't confuse make-docfile by having two doc strings for this function.
6482 make-docfile does not pay attention to #if, for good reason! */
6483 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
6486 register Lisp_Object name
;
6491 /* Don't confuse make-docfile by having two doc strings for this function.
6492 make-docfile does not pay attention to #if, for good reason! */
6493 DEFUN ("process-inherit-coding-system-flag",
6494 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
6498 register Lisp_Object process
;
6500 /* Ignore the argument and return the value of
6501 inherit-process-coding-system. */
6502 return inherit_process_coding_system
? Qt
: Qnil
;
6505 /* Kill all processes associated with `buffer'.
6506 If `buffer' is nil, kill all processes.
6507 Since we have no subprocesses, this does nothing. */
6510 kill_buffer_processes (buffer
)
6523 QCtype
= intern (":type");
6524 staticpro (&QCtype
);
6526 defsubr (&Sget_buffer_process
);
6527 defsubr (&Sprocess_inherit_coding_system_flag
);
6531 #endif /* not subprocesses */