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 */
107 #include <sys/wait.h>
119 #include "termhooks.h"
120 #include "termopts.h"
121 #include "commands.h"
122 #include "keyboard.h"
124 #include "blockinput.h"
125 #include "dispextern.h"
126 #include "composite.h"
129 Lisp_Object Qprocessp
;
130 Lisp_Object Qrun
, Qstop
, Qsignal
;
131 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
132 Lisp_Object Qlocal
, Qdatagram
;
133 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
134 Lisp_Object QClocal
, QCremote
, QCcoding
;
135 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
136 Lisp_Object QCsentinel
, QClog
, QCoptions
;
137 Lisp_Object Qlast_nonmenu_event
;
138 /* QCfamily is declared and initialized in xfaces.c,
139 QCfilter in keyboard.c. */
140 extern Lisp_Object QCfamily
, QCfilter
;
142 /* Qexit is declared and initialized in eval.c. */
144 /* QCfamily is defined in xfaces.c. */
145 extern Lisp_Object QCfamily
;
146 /* QCfilter is defined in keyboard.c. */
147 extern Lisp_Object QCfilter
;
149 /* a process object is a network connection when its childp field is neither
150 Qt nor Qnil but is instead a cons cell (HOSTNAME PORTNUM). */
153 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
154 #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
156 #define NETCONN_P(p) 0
157 #define NETCONN1_P(p) 0
158 #endif /* HAVE_SOCKETS */
160 /* Define first descriptor number available for subprocesses. */
162 #define FIRST_PROC_DESC 1
164 #define FIRST_PROC_DESC 3
167 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
170 #if !defined (SIGCHLD) && defined (SIGCLD)
171 #define SIGCHLD SIGCLD
174 #include "syssignal.h"
178 extern void set_waiting_for_input
P_ ((EMACS_TIME
*));
184 extern char *sys_errlist
[];
191 /* t means use pty, nil means use a pipe,
192 maybe other values to come. */
193 static Lisp_Object Vprocess_connection_type
;
197 #include <sys/socket.h>
201 /* These next two vars are non-static since sysdep.c uses them in the
202 emulation of `select'. */
203 /* Number of events of change of status of a process. */
205 /* Number of events for which the user or sentinel has been notified. */
208 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
210 #ifdef BROKEN_NON_BLOCKING_CONNECT
211 #undef NON_BLOCKING_CONNECT
213 #ifndef NON_BLOCKING_CONNECT
216 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
217 #if defined (O_NONBLOCK) || defined (O_NDELAY)
218 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
219 #define NON_BLOCKING_CONNECT
220 #endif /* EWOULDBLOCK || EINPROGRESS */
221 #endif /* O_NONBLOCK || O_NDELAY */
222 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
223 #endif /* HAVE_SELECT */
224 #endif /* HAVE_SOCKETS */
225 #endif /* NON_BLOCKING_CONNECT */
226 #endif /* BROKEN_NON_BLOCKING_CONNECT */
228 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
229 this system. We need to read full packets, so we need a
230 "non-destructive" select. So we require either native select,
231 or emulation of select using FIONREAD. */
233 #ifdef BROKEN_DATAGRAM_SOCKETS
234 #undef DATAGRAM_SOCKETS
236 #ifndef DATAGRAM_SOCKETS
238 #if defined (HAVE_SELECT) || defined (FIONREAD)
239 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
240 #define DATAGRAM_SOCKETS
241 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
242 #endif /* HAVE_SELECT || FIONREAD */
243 #endif /* HAVE_SOCKETS */
244 #endif /* DATAGRAM_SOCKETS */
245 #endif /* BROKEN_DATAGRAM_SOCKETS */
248 #undef NON_BLOCKING_CONNECT
249 #undef DATAGRAM_SOCKETS
253 #include "sysselect.h"
255 extern int keyboard_bit_set
P_ ((SELECT_TYPE
*));
257 /* If we support a window system, turn on the code to poll periodically
258 to detect C-g. It isn't actually used when doing interrupt input. */
259 #ifdef HAVE_WINDOW_SYSTEM
260 #define POLL_FOR_INPUT
263 /* Mask of bits indicating the descriptors that we wait for input on. */
265 static SELECT_TYPE input_wait_mask
;
267 /* Mask that excludes keyboard input descriptor (s). */
269 static SELECT_TYPE non_keyboard_wait_mask
;
271 /* Mask that excludes process input descriptor (s). */
273 static SELECT_TYPE non_process_wait_mask
;
275 /* Mask of bits indicating the descriptors that we wait for connect to
276 complete on. Once they complete, they are removed from this mask
277 and added to the input_wait_mask and non_keyboard_wait_mask. */
279 static SELECT_TYPE connect_wait_mask
;
281 /* Number of bits set in connect_wait_mask. */
282 static int num_pending_connects
;
284 /* The largest descriptor currently in use for a process object. */
285 static int max_process_desc
;
287 /* The largest descriptor currently in use for keyboard input. */
288 static int max_keyboard_desc
;
290 /* Nonzero means delete a process right away if it exits. */
291 static int delete_exited_processes
;
293 /* Indexed by descriptor, gives the process (if any) for that descriptor */
294 Lisp_Object chan_process
[MAXDESC
];
296 /* Alist of elements (NAME . PROCESS) */
297 Lisp_Object Vprocess_alist
;
299 /* Buffered-ahead input char from process, indexed by channel.
300 -1 means empty (no char is buffered).
301 Used on sys V where the only way to tell if there is any
302 output from the process is to read at least one char.
303 Always -1 on systems that support FIONREAD. */
305 /* Don't make static; need to access externally. */
306 int proc_buffered_char
[MAXDESC
];
308 /* Table of `struct coding-system' for each process. */
309 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
310 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
312 #ifdef DATAGRAM_SOCKETS
313 /* Table of `partner address' for datagram sockets. */
314 struct sockaddr_and_len
{
317 } datagram_address
[MAXDESC
];
318 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
319 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
321 #define DATAGRAM_CHAN_P(chan) (0)
322 #define DATAGRAM_CONN_P(proc) (0)
325 static Lisp_Object
get_process ();
326 static void exec_sentinel ();
328 extern EMACS_TIME
timer_check ();
329 extern int timers_run
;
331 /* Maximum number of bytes to send to a pty without an eof. */
332 static int pty_max_bytes
;
334 extern Lisp_Object Vfile_name_coding_system
, Vdefault_file_name_coding_system
;
340 /* The file name of the pty opened by allocate_pty. */
342 static char pty_name
[24];
345 /* Compute the Lisp form of the process status, p->status, from
346 the numeric status that was returned by `wait'. */
348 Lisp_Object
status_convert ();
352 struct Lisp_Process
*p
;
354 union { int i
; WAITTYPE wt
; } u
;
355 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
356 p
->status
= status_convert (u
.wt
);
357 p
->raw_status_low
= Qnil
;
358 p
->raw_status_high
= Qnil
;
361 /* Convert a process status word in Unix format to
362 the list that we use internally. */
369 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
370 else if (WIFEXITED (w
))
371 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
372 WCOREDUMP (w
) ? Qt
: Qnil
));
373 else if (WIFSIGNALED (w
))
374 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
375 WCOREDUMP (w
) ? Qt
: Qnil
));
380 /* Given a status-list, extract the three pieces of information
381 and store them individually through the three pointers. */
384 decode_status (l
, symbol
, code
, coredump
)
402 *code
= XFASTINT (XCAR (tem
));
404 *coredump
= !NILP (tem
);
408 /* Return a string describing a process status list. */
411 status_message (status
)
416 Lisp_Object string
, string2
;
418 decode_status (status
, &symbol
, &code
, &coredump
);
420 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
423 synchronize_system_messages_locale ();
424 signame
= strsignal (code
);
427 string
= build_string (signame
);
428 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
429 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
430 return concat2 (string
, string2
);
432 else if (EQ (symbol
, Qexit
))
435 return build_string ("finished\n");
436 string
= Fnumber_to_string (make_number (code
));
437 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
438 return concat3 (build_string ("exited abnormally with code "),
441 else if (EQ (symbol
, Qfailed
))
443 string
= Fnumber_to_string (make_number (code
));
444 string2
= build_string ("\n");
445 return concat3 (build_string ("failed with code "),
449 return Fcopy_sequence (Fsymbol_name (symbol
));
454 /* Open an available pty, returning a file descriptor.
455 Return -1 on failure.
456 The file name of the terminal corresponding to the pty
457 is left in the variable pty_name. */
466 /* Some systems name their pseudoterminals so that there are gaps in
467 the usual sequence - for example, on HP9000/S700 systems, there
468 are no pseudoterminals with names ending in 'f'. So we wait for
469 three failures in a row before deciding that we've reached the
471 int failed_count
= 0;
476 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
477 for (i
= 0; i
< 16; i
++)
480 #ifdef PTY_NAME_SPRINTF
483 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
484 #endif /* no PTY_NAME_SPRINTF */
488 #else /* no PTY_OPEN */
490 /* Unusual IRIS code */
491 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
494 if (fstat (fd
, &stb
) < 0)
497 if (stat (pty_name
, &stb
) < 0)
500 if (failed_count
>= 3)
506 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
508 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
510 #endif /* not IRIS */
511 #endif /* no PTY_OPEN */
515 /* check to make certain that both sides are available
516 this avoids a nasty yet stupid bug in rlogins */
517 #ifdef PTY_TTY_NAME_SPRINTF
520 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
521 #endif /* no PTY_TTY_NAME_SPRINTF */
523 if (access (pty_name
, 6) != 0)
526 #if !defined(IRIS) && !defined(__sgi)
532 #endif /* not UNIPLUS */
539 #endif /* HAVE_PTYS */
545 register Lisp_Object val
, tem
, name1
;
546 register struct Lisp_Process
*p
;
550 p
= allocate_process ();
552 XSETINT (p
->infd
, -1);
553 XSETINT (p
->outfd
, -1);
554 XSETFASTINT (p
->pid
, 0);
555 XSETFASTINT (p
->tick
, 0);
556 XSETFASTINT (p
->update_tick
, 0);
557 p
->raw_status_low
= Qnil
;
558 p
->raw_status_high
= Qnil
;
560 p
->mark
= Fmake_marker ();
562 /* If name is already in use, modify it until it is unused. */
567 tem
= Fget_process (name1
);
568 if (NILP (tem
)) break;
569 sprintf (suffix
, "<%d>", i
);
570 name1
= concat2 (name
, build_string (suffix
));
574 XSETPROCESS (val
, p
);
575 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
580 remove_process (proc
)
581 register Lisp_Object proc
;
583 register Lisp_Object pair
;
585 pair
= Frassq (proc
, Vprocess_alist
);
586 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
588 deactivate_process (proc
);
591 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
592 doc
: /* Return t if OBJECT is a process. */)
596 return PROCESSP (object
) ? Qt
: Qnil
;
599 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
600 doc
: /* Return the process named NAME, or nil if there is none. */)
602 register Lisp_Object name
;
607 return Fcdr (Fassoc (name
, Vprocess_alist
));
610 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
611 doc
: /* Return the (or a) process associated with BUFFER.
612 BUFFER may be a buffer or the name of one. */)
614 register Lisp_Object buffer
;
616 register Lisp_Object buf
, tail
, proc
;
618 if (NILP (buffer
)) return Qnil
;
619 buf
= Fget_buffer (buffer
);
620 if (NILP (buf
)) return Qnil
;
622 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
624 proc
= Fcdr (Fcar (tail
));
625 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
631 /* This is how commands for the user decode process arguments. It
632 accepts a process, a process name, a buffer, a buffer name, or nil.
633 Buffers denote the first process in the buffer, and nil denotes the
638 register Lisp_Object name
;
640 register Lisp_Object proc
, obj
;
643 obj
= Fget_process (name
);
645 obj
= Fget_buffer (name
);
647 error ("Process %s does not exist", SDATA (name
));
649 else if (NILP (name
))
650 obj
= Fcurrent_buffer ();
654 /* Now obj should be either a buffer object or a process object.
658 proc
= Fget_buffer_process (obj
);
660 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
670 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
671 doc
: /* Delete PROCESS: kill it and forget about it immediately.
672 PROCESS may be a process, a buffer, the name of a process or buffer, or
673 nil, indicating the current buffer's process. */)
675 register Lisp_Object process
;
677 process
= get_process (process
);
678 XPROCESS (process
)->raw_status_low
= Qnil
;
679 XPROCESS (process
)->raw_status_high
= Qnil
;
680 if (NETCONN_P (process
))
682 XPROCESS (process
)->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
683 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
685 else if (XINT (XPROCESS (process
)->infd
) >= 0)
687 Fkill_process (process
, Qnil
);
688 /* Do this now, since remove_process will make sigchld_handler do nothing. */
689 XPROCESS (process
)->status
690 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
691 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
694 remove_process (process
);
698 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
699 doc
: /* Return the status of PROCESS.
700 The returned value is one of the following symbols:
701 run -- for a process that is running.
702 stop -- for a process stopped but continuable.
703 exit -- for a process that has exited.
704 signal -- for a process that has got a fatal signal.
705 open -- for a network stream connection that is open.
706 listen -- for a network stream server that is listening.
707 closed -- for a network stream connection that is closed.
708 connect -- when waiting for a non-blocking connection to complete.
709 failed -- when a non-blocking connection has failed.
710 nil -- if arg is a process name and no such process exists.
711 PROCESS may be a process, a buffer, the name of a process, or
712 nil, indicating the current buffer's process. */)
714 register Lisp_Object process
;
716 register struct Lisp_Process
*p
;
717 register Lisp_Object status
;
719 if (STRINGP (process
))
720 process
= Fget_process (process
);
722 process
= get_process (process
);
727 p
= XPROCESS (process
);
728 if (!NILP (p
->raw_status_low
))
732 status
= XCAR (status
);
735 if (EQ (status
, Qexit
))
737 else if (EQ (p
->command
, Qt
))
739 else if (EQ (status
, Qrun
))
745 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
747 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
748 If PROCESS has not yet exited or died, return 0. */)
750 register Lisp_Object process
;
752 CHECK_PROCESS (process
);
753 if (!NILP (XPROCESS (process
)->raw_status_low
))
754 update_status (XPROCESS (process
));
755 if (CONSP (XPROCESS (process
)->status
))
756 return XCAR (XCDR (XPROCESS (process
)->status
));
757 return make_number (0);
760 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
761 doc
: /* Return the process id of PROCESS.
762 This is the pid of the Unix process which PROCESS uses or talks to.
763 For a network connection, this value is nil. */)
765 register Lisp_Object process
;
767 CHECK_PROCESS (process
);
768 return XPROCESS (process
)->pid
;
771 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
772 doc
: /* Return the name of PROCESS, as a string.
773 This is the name of the program invoked in PROCESS,
774 possibly modified to make it unique among process names. */)
776 register Lisp_Object process
;
778 CHECK_PROCESS (process
);
779 return XPROCESS (process
)->name
;
782 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
783 doc
: /* Return the command that was executed to start PROCESS.
784 This is a list of strings, the first string being the program executed
785 and the rest of the strings being the arguments given to it.
786 For a non-child channel, this is nil. */)
788 register Lisp_Object process
;
790 CHECK_PROCESS (process
);
791 return XPROCESS (process
)->command
;
794 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
795 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
796 This is the terminal that the process itself reads and writes on,
797 not the name of the pty that Emacs uses to talk with that terminal. */)
799 register Lisp_Object process
;
801 CHECK_PROCESS (process
);
802 return XPROCESS (process
)->tty_name
;
805 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
807 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
809 register Lisp_Object process
, buffer
;
811 struct Lisp_Process
*p
;
813 CHECK_PROCESS (process
);
815 CHECK_BUFFER (buffer
);
816 p
= XPROCESS (process
);
819 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
823 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
825 doc
: /* Return the buffer PROCESS is associated with.
826 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
828 register Lisp_Object process
;
830 CHECK_PROCESS (process
);
831 return XPROCESS (process
)->buffer
;
834 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
836 doc
: /* Return the marker for the end of the last output from PROCESS. */)
838 register Lisp_Object process
;
840 CHECK_PROCESS (process
);
841 return XPROCESS (process
)->mark
;
844 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
846 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
847 t means stop accepting output from the process.
848 When a process has a filter, each time it does output
849 the entire string of output is passed to the filter.
850 The filter gets two arguments: the process and the string of output.
851 If the process has a filter, its buffer is not used for output. */)
853 register Lisp_Object process
, filter
;
855 struct Lisp_Process
*p
;
857 CHECK_PROCESS (process
);
858 p
= XPROCESS (process
);
860 /* Don't signal an error if the process' input file descriptor
861 is closed. This could make debugging Lisp more difficult,
862 for example when doing something like
864 (setq process (start-process ...))
866 (set-process-filter process ...) */
868 if (XINT (p
->infd
) >= 0)
870 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
872 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
873 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
875 else if (EQ (p
->filter
, Qt
)
876 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
878 FD_SET (XINT (p
->infd
), &input_wait_mask
);
879 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
885 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
889 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
891 doc
: /* Returns the filter function of PROCESS; nil if none.
892 See `set-process-filter' for more info on filter functions. */)
894 register Lisp_Object process
;
896 CHECK_PROCESS (process
);
897 return XPROCESS (process
)->filter
;
900 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
902 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
903 The sentinel is called as a function when the process changes state.
904 It gets two arguments: the process, and a string describing the change. */)
906 register Lisp_Object process
, sentinel
;
908 CHECK_PROCESS (process
);
909 XPROCESS (process
)->sentinel
= sentinel
;
913 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
915 doc
: /* Return the sentinel of PROCESS; nil if none.
916 See `set-process-sentinel' for more info on sentinels. */)
918 register Lisp_Object process
;
920 CHECK_PROCESS (process
);
921 return XPROCESS (process
)->sentinel
;
924 DEFUN ("set-process-window-size", Fset_process_window_size
,
925 Sset_process_window_size
, 3, 3, 0,
926 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
927 (process
, height
, width
)
928 register Lisp_Object process
, height
, width
;
930 CHECK_PROCESS (process
);
931 CHECK_NATNUM (height
);
932 CHECK_NATNUM (width
);
934 if (XINT (XPROCESS (process
)->infd
) < 0
935 || set_window_size (XINT (XPROCESS (process
)->infd
),
936 XINT (height
), XINT (width
)) <= 0)
942 DEFUN ("set-process-inherit-coding-system-flag",
943 Fset_process_inherit_coding_system_flag
,
944 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
945 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
946 If the second argument FLAG is non-nil, then the variable
947 `buffer-file-coding-system' of the buffer associated with PROCESS
948 will be bound to the value of the coding system used to decode
951 This is useful when the coding system specified for the process buffer
952 leaves either the character code conversion or the end-of-line conversion
953 unspecified, or if the coding system used to decode the process output
954 is more appropriate for saving the process buffer.
956 Binding the variable `inherit-process-coding-system' to non-nil before
957 starting the process is an alternative way of setting the inherit flag
958 for the process which will run. */)
960 register Lisp_Object process
, flag
;
962 CHECK_PROCESS (process
);
963 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
967 DEFUN ("process-inherit-coding-system-flag",
968 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
970 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
971 If this flag is t, `buffer-file-coding-system' of the buffer
972 associated with PROCESS will inherit the coding system used to decode
973 the process output. */)
975 register Lisp_Object process
;
977 CHECK_PROCESS (process
);
978 return XPROCESS (process
)->inherit_coding_system_flag
;
981 DEFUN ("set-process-query-on-exit-flag",
982 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
984 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
985 If the second argument FLAG is non-nil, emacs will query the user before
986 exiting if PROCESS is running. */)
988 register Lisp_Object process
, flag
;
990 CHECK_PROCESS (process
);
991 XPROCESS (process
)->kill_without_query
= Fnull (flag
);
995 DEFUN ("process-query-on-exit-flag",
996 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
998 doc
: /* Return the current value of query on exit flag for PROCESS. */)
1000 register Lisp_Object process
;
1002 CHECK_PROCESS (process
);
1003 return Fnull (XPROCESS (process
)->kill_without_query
);
1006 #ifdef DATAGRAM_SOCKETS
1007 Lisp_Object
Fprocess_datagram_address ();
1010 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1012 doc
: /* Return the contact info of PROCESS; t for a real child.
1013 For a net connection, the value depends on the optional KEY arg.
1014 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1015 if KEY is t, the complete contact information for the connection is
1016 returned, else the specific value for the keyword KEY is returned.
1017 See `make-network-process' for a list of keywords. */)
1019 register Lisp_Object process
, key
;
1021 Lisp_Object contact
;
1023 CHECK_PROCESS (process
);
1024 contact
= XPROCESS (process
)->childp
;
1026 #ifdef DATAGRAM_SOCKETS
1027 if (DATAGRAM_CONN_P (process
)
1028 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1029 contact
= Fplist_put (contact
, QCremote
,
1030 Fprocess_datagram_address (process
));
1033 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1036 return Fcons (Fplist_get (contact
, QChost
),
1037 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1038 return Fplist_get (contact
, key
);
1041 #if 0 /* Turned off because we don't currently record this info
1042 in the process. Perhaps add it. */
1043 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1044 doc
: /* Return the connection type of PROCESS.
1045 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1046 a socket connection. */)
1048 Lisp_Object process
;
1050 return XPROCESS (process
)->type
;
1055 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1057 doc
: /* Convert network ADDRESS from internal format to a string.
1058 Returns nil if format of ADDRESS is invalid. */)
1060 Lisp_Object address
;
1062 register struct Lisp_Vector
*p
;
1063 register unsigned char *cp
;
1069 if (STRINGP (address
)) /* AF_LOCAL */
1072 if (VECTORP (address
)) /* AF_INET */
1074 register struct Lisp_Vector
*p
= XVECTOR (address
);
1075 Lisp_Object args
[6];
1080 args
[0] = build_string ("%d.%d.%d.%d:%d");
1081 args
[1] = XINT (p
->contents
[0]);
1082 args
[2] = XINT (p
->contents
[1]);
1083 args
[3] = XINT (p
->contents
[2]);
1084 args
[4] = XINT (p
->contents
[3]);
1085 args
[5] = XINT (p
->contents
[4]);
1086 return Fformat (6, args
);
1089 if (CONSP (address
))
1091 Lisp_Object args
[2];
1092 args
[0] = build_string ("<Family %d>");
1093 args
[1] = XINT (Fcar (address
));
1094 return Fformat (2, args
);
1103 list_processes_1 (query_only
)
1104 Lisp_Object query_only
;
1106 register Lisp_Object tail
, tem
;
1107 Lisp_Object proc
, minspace
, tem1
;
1108 register struct Lisp_Process
*p
;
1110 int w_proc
, w_buffer
, w_tty
;
1111 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1113 w_proc
= 4; /* Proc */
1114 w_buffer
= 6; /* Buffer */
1115 w_tty
= 0; /* Omit if no ttys */
1117 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1121 proc
= Fcdr (Fcar (tail
));
1122 p
= XPROCESS (proc
);
1123 if (NILP (p
->childp
))
1125 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1127 if (STRINGP (p
->name
)
1128 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1130 if (!NILP (p
->buffer
))
1132 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1133 w_buffer
= 8; /* (Killed) */
1134 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1137 if (STRINGP (p
->tty_name
)
1138 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1142 XSETFASTINT (i_status
, w_proc
+ 1);
1143 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1146 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1147 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1150 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1153 XSETFASTINT (minspace
, 1);
1155 set_buffer_internal (XBUFFER (Vstandard_output
));
1156 Fbuffer_disable_undo (Vstandard_output
);
1158 current_buffer
->truncate_lines
= Qt
;
1160 write_string ("Proc", -1);
1161 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1162 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1165 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1167 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1168 write_string ("\n", -1);
1170 write_string ("----", -1);
1171 Findent_to (i_status
, minspace
); write_string ("------", -1);
1172 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1175 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1177 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1178 write_string ("\n", -1);
1180 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1184 proc
= Fcdr (Fcar (tail
));
1185 p
= XPROCESS (proc
);
1186 if (NILP (p
->childp
))
1188 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1191 Finsert (1, &p
->name
);
1192 Findent_to (i_status
, minspace
);
1194 if (!NILP (p
->raw_status_low
))
1197 if (CONSP (p
->status
))
1198 symbol
= XCAR (p
->status
);
1201 if (EQ (symbol
, Qsignal
))
1204 tem
= Fcar (Fcdr (p
->status
));
1206 if (XINT (tem
) < NSIG
)
1207 write_string (sys_errlist
[XINT (tem
)], -1);
1210 Fprinc (symbol
, Qnil
);
1212 else if (NETCONN1_P (p
))
1214 if (EQ (symbol
, Qexit
))
1215 write_string ("closed", -1);
1216 else if (EQ (p
->command
, Qt
))
1217 write_string ("stopped", -1);
1218 else if (EQ (symbol
, Qrun
))
1219 write_string ("open", -1);
1221 Fprinc (symbol
, Qnil
);
1224 Fprinc (symbol
, Qnil
);
1226 if (EQ (symbol
, Qexit
))
1229 tem
= Fcar (Fcdr (p
->status
));
1232 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1233 write_string (tembuf
, -1);
1237 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
1238 remove_process (proc
);
1240 Findent_to (i_buffer
, minspace
);
1241 if (NILP (p
->buffer
))
1242 insert_string ("(none)");
1243 else if (NILP (XBUFFER (p
->buffer
)->name
))
1244 insert_string ("(Killed)");
1246 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1250 Findent_to (i_tty
, minspace
);
1251 if (STRINGP (p
->tty_name
))
1252 Finsert (1, &p
->tty_name
);
1255 Findent_to (i_command
, minspace
);
1257 if (EQ (p
->status
, Qlisten
))
1259 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1260 if (INTEGERP (port
))
1261 port
= Fnumber_to_string (port
);
1263 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
));
1264 sprintf (tembuf
, "(network %s server on %s)\n",
1265 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1266 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1267 insert_string (tembuf
);
1269 else if (NETCONN1_P (p
))
1271 /* For a local socket, there is no host name,
1272 so display service instead. */
1273 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1274 if (!STRINGP (host
))
1276 host
= Fplist_get (p
->childp
, QCservice
);
1277 if (INTEGERP (host
))
1278 host
= Fnumber_to_string (host
);
1281 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
));
1282 sprintf (tembuf
, "(network %s connection to %s)\n",
1283 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1284 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1285 insert_string (tembuf
);
1297 insert_string (" ");
1299 insert_string ("\n");
1305 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1306 doc
: /* Display a list of all processes.
1307 If optional argument QUERY-ONLY is non-nil, only processes with
1308 the query-on-exit flag set will be listed.
1309 Any process listed as exited or signaled is actually eliminated
1310 after the listing is made. */)
1312 Lisp_Object query_only
;
1314 internal_with_output_to_temp_buffer ("*Process List*",
1315 list_processes_1
, query_only
);
1319 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1320 doc
: /* Return a list of all processes. */)
1323 return Fmapcar (Qcdr
, Vprocess_alist
);
1326 /* Starting asynchronous inferior processes. */
1328 static Lisp_Object
start_process_unwind ();
1330 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1331 doc
: /* Start a program in a subprocess. Return the process object for it.
1332 NAME is name for process. It is modified if necessary to make it unique.
1333 BUFFER is the buffer or (buffer-name) to associate with the process.
1334 Process output goes at end of that buffer, unless you specify
1335 an output stream or filter function to handle the output.
1336 BUFFER may be also nil, meaning that this process is not associated
1338 Third arg is program file name. It is searched for in PATH.
1339 Remaining arguments are strings to give program as arguments.
1341 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1344 register Lisp_Object
*args
;
1346 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1348 register unsigned char *new_argv
;
1351 register unsigned char **new_argv
;
1354 int count
= SPECPDL_INDEX ();
1358 buffer
= Fget_buffer_create (buffer
);
1360 /* Make sure that the child will be able to chdir to the current
1361 buffer's current directory, or its unhandled equivalent. We
1362 can't just have the child check for an error when it does the
1363 chdir, since it's in a vfork.
1365 We have to GCPRO around this because Fexpand_file_name and
1366 Funhandled_file_name_directory might call a file name handling
1367 function. The argument list is protected by the caller, so all
1368 we really have to worry about is buffer. */
1370 struct gcpro gcpro1
, gcpro2
;
1372 current_dir
= current_buffer
->directory
;
1374 GCPRO2 (buffer
, current_dir
);
1377 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1379 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1380 report_file_error ("Setting current directory",
1381 Fcons (current_buffer
->directory
, Qnil
));
1387 CHECK_STRING (name
);
1391 CHECK_STRING (program
);
1393 proc
= make_process (name
);
1394 /* If an error occurs and we can't start the process, we want to
1395 remove it from the process list. This means that each error
1396 check in create_process doesn't need to call remove_process
1397 itself; it's all taken care of here. */
1398 record_unwind_protect (start_process_unwind
, proc
);
1400 XPROCESS (proc
)->childp
= Qt
;
1401 XPROCESS (proc
)->command_channel_p
= Qnil
;
1402 XPROCESS (proc
)->buffer
= buffer
;
1403 XPROCESS (proc
)->sentinel
= Qnil
;
1404 XPROCESS (proc
)->filter
= Qnil
;
1405 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1407 /* Make the process marker point into the process buffer (if any). */
1409 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1410 BUF_ZV (XBUFFER (buffer
)),
1411 BUF_ZV_BYTE (XBUFFER (buffer
)));
1414 /* Decide coding systems for communicating with the process. Here
1415 we don't setup the structure coding_system nor pay attention to
1416 unibyte mode. They are done in create_process. */
1418 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1419 Lisp_Object coding_systems
= Qt
;
1420 Lisp_Object val
, *args2
;
1421 struct gcpro gcpro1
, gcpro2
;
1423 val
= Vcoding_system_for_read
;
1426 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1427 args2
[0] = Qstart_process
;
1428 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1429 GCPRO2 (proc
, current_dir
);
1430 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1432 if (CONSP (coding_systems
))
1433 val
= XCAR (coding_systems
);
1434 else if (CONSP (Vdefault_process_coding_system
))
1435 val
= XCAR (Vdefault_process_coding_system
);
1437 XPROCESS (proc
)->decode_coding_system
= val
;
1439 val
= Vcoding_system_for_write
;
1442 if (EQ (coding_systems
, Qt
))
1444 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1445 args2
[0] = Qstart_process
;
1446 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1447 GCPRO2 (proc
, current_dir
);
1448 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1451 if (CONSP (coding_systems
))
1452 val
= XCDR (coding_systems
);
1453 else if (CONSP (Vdefault_process_coding_system
))
1454 val
= XCDR (Vdefault_process_coding_system
);
1456 XPROCESS (proc
)->encode_coding_system
= val
;
1460 /* Make a one member argv with all args concatenated
1461 together separated by a blank. */
1462 len
= SBYTES (program
) + 2;
1463 for (i
= 3; i
< nargs
; i
++)
1467 len
+= SBYTES (tem
) + 1; /* count the blank */
1469 new_argv
= (unsigned char *) alloca (len
);
1470 strcpy (new_argv
, SDATA (program
));
1471 for (i
= 3; i
< nargs
; i
++)
1475 strcat (new_argv
, " ");
1476 strcat (new_argv
, SDATA (tem
));
1478 /* Need to add code here to check for program existence on VMS */
1481 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1483 /* If program file name is not absolute, search our path for it.
1484 Put the name we will really use in TEM. */
1485 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1486 && !(SCHARS (program
) > 1
1487 && IS_DEVICE_SEP (SREF (program
, 1))))
1489 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1492 GCPRO4 (name
, program
, buffer
, current_dir
);
1493 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1496 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1497 tem
= Fexpand_file_name (tem
, Qnil
);
1501 if (!NILP (Ffile_directory_p (program
)))
1502 error ("Specified program for new process is a directory");
1506 /* If program file name starts with /: for quoting a magic name,
1508 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1509 && SREF (tem
, 1) == ':')
1510 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1512 /* Encode the file name and put it in NEW_ARGV.
1513 That's where the child will use it to execute the program. */
1514 tem
= ENCODE_FILE (tem
);
1515 new_argv
[0] = SDATA (tem
);
1517 /* Here we encode arguments by the coding system used for sending
1518 data to the process. We don't support using different coding
1519 systems for encoding arguments and for encoding data sent to the
1522 for (i
= 3; i
< nargs
; i
++)
1526 if (STRING_MULTIBYTE (tem
))
1527 tem
= (code_convert_string_norecord
1528 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1529 new_argv
[i
- 2] = SDATA (tem
);
1531 new_argv
[i
- 2] = 0;
1532 #endif /* not VMS */
1534 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1535 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1536 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1537 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1539 XPROCESS (proc
)->inherit_coding_system_flag
1540 = (NILP (buffer
) || !inherit_process_coding_system
1543 create_process (proc
, (char **) new_argv
, current_dir
);
1545 return unbind_to (count
, proc
);
1548 /* This function is the unwind_protect form for Fstart_process. If
1549 PROC doesn't have its pid set, then we know someone has signaled
1550 an error and the process wasn't started successfully, so we should
1551 remove it from the process list. */
1553 start_process_unwind (proc
)
1556 if (!PROCESSP (proc
))
1559 /* Was PROC started successfully? */
1560 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1561 remove_process (proc
);
1567 create_process_1 (timer
)
1568 struct atimer
*timer
;
1570 /* Nothing to do. */
1574 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1577 /* Mimic blocking of signals on system V, which doesn't really have it. */
1579 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1580 int sigchld_deferred
;
1583 create_process_sigchld ()
1585 signal (SIGCHLD
, create_process_sigchld
);
1587 sigchld_deferred
= 1;
1593 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1595 create_process (process
, new_argv
, current_dir
)
1596 Lisp_Object process
;
1598 Lisp_Object current_dir
;
1600 int pid
, inchannel
, outchannel
;
1602 #ifdef POSIX_SIGNALS
1605 struct sigaction sigint_action
;
1606 struct sigaction sigquit_action
;
1608 struct sigaction sighup_action
;
1610 #else /* !POSIX_SIGNALS */
1613 SIGTYPE (*sigchld
)();
1616 #endif /* !POSIX_SIGNALS */
1617 /* Use volatile to protect variables from being clobbered by longjmp. */
1618 volatile int forkin
, forkout
;
1619 volatile int pty_flag
= 0;
1621 extern char **environ
;
1624 inchannel
= outchannel
= -1;
1627 if (!NILP (Vprocess_connection_type
))
1628 outchannel
= inchannel
= allocate_pty ();
1632 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1633 /* On most USG systems it does not work to open the pty's tty here,
1634 then close it and reopen it in the child. */
1636 /* Don't let this terminal become our controlling terminal
1637 (in case we don't have one). */
1638 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1640 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1643 report_file_error ("Opening pty", Qnil
);
1645 forkin
= forkout
= -1;
1646 #endif /* not USG, or USG_SUBTTY_WORKS */
1650 #endif /* HAVE_PTYS */
1653 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1654 report_file_error ("Opening socketpair", Qnil
);
1655 outchannel
= inchannel
= sv
[0];
1656 forkout
= forkin
= sv
[1];
1658 #else /* not SKTPAIR */
1663 report_file_error ("Creating pipe", Qnil
);
1669 emacs_close (inchannel
);
1670 emacs_close (forkout
);
1671 report_file_error ("Creating pipe", Qnil
);
1676 #endif /* not SKTPAIR */
1679 /* Replaced by close_process_descs */
1680 set_exclusive_use (inchannel
);
1681 set_exclusive_use (outchannel
);
1684 /* Stride people say it's a mystery why this is needed
1685 as well as the O_NDELAY, but that it fails without this. */
1686 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1689 ioctl (inchannel
, FIONBIO
, &one
);
1694 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1695 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1698 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1699 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1703 /* Record this as an active process, with its channels.
1704 As a result, child_setup will close Emacs's side of the pipes. */
1705 chan_process
[inchannel
] = process
;
1706 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1707 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1708 /* Record the tty descriptor used in the subprocess. */
1710 XPROCESS (process
)->subtty
= Qnil
;
1712 XSETFASTINT (XPROCESS (process
)->subtty
, forkin
);
1713 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1714 XPROCESS (process
)->status
= Qrun
;
1715 if (!proc_decode_coding_system
[inchannel
])
1716 proc_decode_coding_system
[inchannel
]
1717 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
1718 setup_coding_system (XPROCESS (process
)->decode_coding_system
,
1719 proc_decode_coding_system
[inchannel
]);
1720 if (!proc_encode_coding_system
[outchannel
])
1721 proc_encode_coding_system
[outchannel
]
1722 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
1723 setup_coding_system (XPROCESS (process
)->encode_coding_system
,
1724 proc_encode_coding_system
[outchannel
]);
1726 /* Delay interrupts until we have a chance to store
1727 the new fork's pid in its process structure */
1728 #ifdef POSIX_SIGNALS
1729 sigemptyset (&blocked
);
1731 sigaddset (&blocked
, SIGCHLD
);
1733 #ifdef HAVE_WORKING_VFORK
1734 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1735 this sets the parent's signal handlers as well as the child's.
1736 So delay all interrupts whose handlers the child might munge,
1737 and record the current handlers so they can be restored later. */
1738 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1739 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1741 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1743 #endif /* HAVE_WORKING_VFORK */
1744 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1745 #else /* !POSIX_SIGNALS */
1749 #else /* not BSD4_1 */
1750 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1751 sigsetmask (sigmask (SIGCHLD
));
1752 #else /* ordinary USG */
1754 sigchld_deferred
= 0;
1755 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1757 #endif /* ordinary USG */
1758 #endif /* not BSD4_1 */
1759 #endif /* SIGCHLD */
1760 #endif /* !POSIX_SIGNALS */
1762 FD_SET (inchannel
, &input_wait_mask
);
1763 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1764 if (inchannel
> max_process_desc
)
1765 max_process_desc
= inchannel
;
1767 /* Until we store the proper pid, enable sigchld_handler
1768 to recognize an unknown pid as standing for this process.
1769 It is very important not to let this `marker' value stay
1770 in the table after this function has returned; if it does
1771 it might cause call-process to hang and subsequent asynchronous
1772 processes to get their return values scrambled. */
1773 XSETINT (XPROCESS (process
)->pid
, -1);
1778 /* child_setup must clobber environ on systems with true vfork.
1779 Protect it from permanent change. */
1780 char **save_environ
= environ
;
1782 current_dir
= ENCODE_FILE (current_dir
);
1787 #endif /* not WINDOWSNT */
1789 int xforkin
= forkin
;
1790 int xforkout
= forkout
;
1792 #if 0 /* This was probably a mistake--it duplicates code later on,
1793 but fails to handle all the cases. */
1794 /* Make sure SIGCHLD is not blocked in the child. */
1795 sigsetmask (SIGEMPTYMASK
);
1798 /* Make the pty be the controlling terminal of the process. */
1800 /* First, disconnect its current controlling terminal. */
1802 /* We tried doing setsid only if pty_flag, but it caused
1803 process_set_signal to fail on SGI when using a pipe. */
1805 /* Make the pty's terminal the controlling terminal. */
1809 /* We ignore the return value
1810 because faith@cs.unc.edu says that is necessary on Linux. */
1811 ioctl (xforkin
, TIOCSCTTY
, 0);
1814 #else /* not HAVE_SETSID */
1816 /* It's very important to call setpgrp here and no time
1817 afterwards. Otherwise, we lose our controlling tty which
1818 is set when we open the pty. */
1821 #endif /* not HAVE_SETSID */
1822 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1823 if (pty_flag
&& xforkin
>= 0)
1826 tcgetattr (xforkin
, &t
);
1828 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1829 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1832 #if defined (NTTYDISC) && defined (TIOCSETD)
1833 if (pty_flag
&& xforkin
>= 0)
1835 /* Use new line discipline. */
1836 int ldisc
= NTTYDISC
;
1837 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1842 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1843 can do TIOCSPGRP only to the process's controlling tty. */
1846 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1847 I can't test it since I don't have 4.3. */
1848 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
1849 ioctl (j
, TIOCNOTTY
, 0);
1852 /* In order to get a controlling terminal on some versions
1853 of BSD, it is necessary to put the process in pgrp 0
1854 before it opens the terminal. */
1862 #endif /* TIOCNOTTY */
1864 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
1865 /*** There is a suggestion that this ought to be a
1866 conditional on TIOCSPGRP,
1867 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1868 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1869 that system does seem to need this code, even though
1870 both HAVE_SETSID and TIOCSCTTY are defined. */
1871 /* Now close the pty (if we had it open) and reopen it.
1872 This makes the pty the controlling terminal of the subprocess. */
1875 #ifdef SET_CHILD_PTY_PGRP
1876 int pgrp
= getpid ();
1879 /* I wonder if emacs_close (emacs_open (pty_name, ...))
1882 emacs_close (xforkin
);
1883 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
1887 emacs_write (1, "Couldn't open the pty terminal ", 31);
1888 emacs_write (1, pty_name
, strlen (pty_name
));
1889 emacs_write (1, "\n", 1);
1893 #ifdef SET_CHILD_PTY_PGRP
1894 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
1895 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
1898 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
1900 #ifdef SETUP_SLAVE_PTY
1905 #endif /* SETUP_SLAVE_PTY */
1907 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1908 Now reenable it in the child, so it will die when we want it to. */
1910 signal (SIGHUP
, SIG_DFL
);
1912 #endif /* HAVE_PTYS */
1914 signal (SIGINT
, SIG_DFL
);
1915 signal (SIGQUIT
, SIG_DFL
);
1917 /* Stop blocking signals in the child. */
1918 #ifdef POSIX_SIGNALS
1919 sigprocmask (SIG_SETMASK
, &procmask
, 0);
1920 #else /* !POSIX_SIGNALS */
1924 #else /* not BSD4_1 */
1925 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1926 sigsetmask (SIGEMPTYMASK
);
1927 #else /* ordinary USG */
1929 signal (SIGCHLD
, sigchld
);
1931 #endif /* ordinary USG */
1932 #endif /* not BSD4_1 */
1933 #endif /* SIGCHLD */
1934 #endif /* !POSIX_SIGNALS */
1937 child_setup_tty (xforkout
);
1939 pid
= child_setup (xforkin
, xforkout
, xforkout
,
1940 new_argv
, 1, current_dir
);
1941 #else /* not WINDOWSNT */
1942 child_setup (xforkin
, xforkout
, xforkout
,
1943 new_argv
, 1, current_dir
);
1944 #endif /* not WINDOWSNT */
1946 environ
= save_environ
;
1951 /* This runs in the Emacs process. */
1955 emacs_close (forkin
);
1956 if (forkin
!= forkout
&& forkout
>= 0)
1957 emacs_close (forkout
);
1961 /* vfork succeeded. */
1962 XSETFASTINT (XPROCESS (process
)->pid
, pid
);
1965 register_child (pid
, inchannel
);
1966 #endif /* WINDOWSNT */
1968 /* If the subfork execv fails, and it exits,
1969 this close hangs. I don't know why.
1970 So have an interrupt jar it loose. */
1972 struct atimer
*timer
;
1976 EMACS_SET_SECS_USECS (offset
, 1, 0);
1977 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
1979 XPROCESS (process
)->subtty
= Qnil
;
1981 emacs_close (forkin
);
1983 cancel_atimer (timer
);
1987 if (forkin
!= forkout
&& forkout
>= 0)
1988 emacs_close (forkout
);
1992 XPROCESS (process
)->tty_name
= build_string (pty_name
);
1995 XPROCESS (process
)->tty_name
= Qnil
;
1998 /* Restore the signal state whether vfork succeeded or not.
1999 (We will signal an error, below, if it failed.) */
2000 #ifdef POSIX_SIGNALS
2001 #ifdef HAVE_WORKING_VFORK
2002 /* Restore the parent's signal handlers. */
2003 sigaction (SIGINT
, &sigint_action
, 0);
2004 sigaction (SIGQUIT
, &sigquit_action
, 0);
2006 sigaction (SIGHUP
, &sighup_action
, 0);
2008 #endif /* HAVE_WORKING_VFORK */
2009 /* Stop blocking signals in the parent. */
2010 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2011 #else /* !POSIX_SIGNALS */
2015 #else /* not BSD4_1 */
2016 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2017 sigsetmask (SIGEMPTYMASK
);
2018 #else /* ordinary USG */
2020 signal (SIGCHLD
, sigchld
);
2021 /* Now really handle any of these signals
2022 that came in during this function. */
2023 if (sigchld_deferred
)
2024 kill (getpid (), SIGCHLD
);
2026 #endif /* ordinary USG */
2027 #endif /* not BSD4_1 */
2028 #endif /* SIGCHLD */
2029 #endif /* !POSIX_SIGNALS */
2031 /* Now generate the error if vfork failed. */
2033 report_file_error ("Doing vfork", Qnil
);
2035 #endif /* not VMS */
2040 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2041 The address family of sa is not included in the result. */
2044 conv_sockaddr_to_lisp (sa
, len
)
2045 struct sockaddr
*sa
;
2048 Lisp_Object address
;
2051 register struct Lisp_Vector
*p
;
2053 switch (sa
->sa_family
)
2057 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2058 len
= sizeof (sin
->sin_addr
) + 1;
2059 address
= Fmake_vector (make_number (len
), Qnil
);
2060 p
= XVECTOR (address
);
2061 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2062 cp
= (unsigned char *)&sin
->sin_addr
;
2065 #ifdef HAVE_LOCAL_SOCKETS
2068 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2069 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2070 if (sockun
->sun_path
[i
] == 0)
2072 return make_unibyte_string (sockun
->sun_path
, i
);
2076 len
-= sizeof (sa
->sa_family
);
2077 address
= Fcons (make_number (sa
->sa_family
),
2078 Fmake_vector (make_number (len
), Qnil
));
2079 p
= XVECTOR (XCDR (address
));
2080 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2086 p
->contents
[i
++] = make_number (*cp
++);
2092 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2095 get_lisp_to_sockaddr_size (address
, familyp
)
2096 Lisp_Object address
;
2099 register struct Lisp_Vector
*p
;
2101 if (VECTORP (address
))
2103 p
= XVECTOR (address
);
2107 return sizeof (struct sockaddr_in
);
2110 #ifdef HAVE_LOCAL_SOCKETS
2111 else if (STRINGP (address
))
2113 *familyp
= AF_LOCAL
;
2114 return sizeof (struct sockaddr_un
);
2117 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2119 struct sockaddr
*sa
;
2120 *familyp
= XINT (XCAR (address
));
2121 p
= XVECTOR (XCDR (address
));
2122 return p
->size
+ sizeof (sa
->sa_family
);
2127 /* Convert an address object (vector or string) to an internal sockaddr.
2128 Format of address has already been validated by size_lisp_to_sockaddr. */
2131 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2133 Lisp_Object address
;
2134 struct sockaddr
*sa
;
2137 register struct Lisp_Vector
*p
;
2138 register unsigned char *cp
;
2142 sa
->sa_family
= family
;
2144 if (VECTORP (address
))
2146 p
= XVECTOR (address
);
2147 if (family
== AF_INET
)
2149 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2150 len
= sizeof (sin
->sin_addr
) + 1;
2151 i
= XINT (p
->contents
[--len
]);
2152 sin
->sin_port
= htons (i
);
2153 cp
= (unsigned char *)&sin
->sin_addr
;
2156 else if (STRINGP (address
))
2158 #ifdef HAVE_LOCAL_SOCKETS
2159 if (family
== AF_LOCAL
)
2161 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2162 cp
= SDATA (address
);
2163 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2164 sockun
->sun_path
[i
] = *cp
++;
2171 p
= XVECTOR (XCDR (address
));
2172 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2175 for (i
= 0; i
< len
; i
++)
2176 if (INTEGERP (p
->contents
[i
]))
2177 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2180 #ifdef DATAGRAM_SOCKETS
2181 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2183 doc
: /* Get the current datagram address associated with PROCESS. */)
2185 Lisp_Object process
;
2189 CHECK_PROCESS (process
);
2191 if (!DATAGRAM_CONN_P (process
))
2194 channel
= XINT (XPROCESS (process
)->infd
);
2195 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2196 datagram_address
[channel
].len
);
2199 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2201 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2202 Returns nil upon error setting address, ADDRESS otherwise. */)
2204 Lisp_Object process
, address
;
2209 CHECK_PROCESS (process
);
2211 if (!DATAGRAM_CONN_P (process
))
2214 channel
= XINT (XPROCESS (process
)->infd
);
2216 len
= get_lisp_to_sockaddr_size (address
, &family
);
2217 if (datagram_address
[channel
].len
!= len
)
2219 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2225 static struct socket_options
{
2226 /* The name of this option. Should be lowercase version of option
2227 name without SO_ prefix. */
2229 /* Length of name. */
2231 /* Option level SOL_... */
2233 /* Option number SO_... */
2235 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_STR
, SOPT_LINGER
} opttype
;
2236 } socket_options
[] =
2238 #ifdef SO_BINDTODEVICE
2239 { "bindtodevice", 12, SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_STR
},
2242 { "broadcast", 9, SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
},
2245 { "dontroute", 9, SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
},
2248 { "keepalive", 9, SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
},
2251 { "linger", 6, SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
},
2254 { "oobinline", 9, SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
},
2257 { "priority", 8, SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
},
2260 { "reuseaddr", 9, SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
},
2262 { 0, 0, 0, 0, SOPT_UNKNOWN
}
2265 /* Process list of socket options OPTS on socket S.
2266 Only check if options are supported is S < 0.
2267 If NO_ERROR is non-zero, continue silently if an option
2270 Each element specifies one option. An element is either a string
2271 "OPTION=VALUE" or a cons (OPTION . VALUE) where OPTION is a string
2275 set_socket_options (s
, opts
, no_error
)
2281 opts
= Fcons (opts
, Qnil
);
2283 while (CONSP (opts
))
2288 struct socket_options
*sopt
;
2302 name
= (char *) SDATA (opt
);
2303 else if (SYMBOLP (opt
))
2304 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2306 error ("Mal-formed option list");
2310 if (strncmp (name
, "no", 2) == 0)
2317 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2318 if (strncmp (name
, sopt
->name
, sopt
->nlen
) == 0)
2320 if (name
[sopt
->nlen
] == 0)
2322 if (name
[sopt
->nlen
] == '=')
2324 arg
= name
+ sopt
->nlen
+ 1;
2329 switch (sopt
->opttype
)
2337 optval
= (*arg
== '0' || *arg
== 'n') ? 0 : 1;
2338 else if (INTEGERP (val
))
2339 optval
= XINT (val
) == 0 ? 0 : 1;
2341 optval
= NILP (val
) ? 0 : 1;
2342 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2343 &optval
, sizeof (optval
));
2352 else if (INTEGERP (val
))
2353 optval
= XINT (val
);
2355 error ("Bad option argument for %s", name
);
2358 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2359 &optval
, sizeof (optval
));
2369 else if (STRINGP (val
))
2370 arg
= (char *) SDATA (val
);
2371 else if (XSYMBOL (val
))
2372 arg
= (char *) SDATA (SYMBOL_NAME (val
));
2374 error ("Invalid argument to %s option", name
);
2376 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2383 struct linger linger
;
2386 linger
.l_linger
= 0;
2393 if (*arg
== 'n' || *arg
== 't' || *arg
== 'y')
2394 linger
.l_onoff
= (*arg
== 'n') ? 0 : 1;
2396 linger
.l_linger
= atoi(arg
);
2398 else if (INTEGERP (val
))
2399 linger
.l_linger
= XINT (val
);
2401 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2402 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2403 &linger
, sizeof (linger
));
2412 error ("Unsupported option: %s", name
);
2414 if (ret
< 0 && ! no_error
)
2415 report_file_error ("Cannot set network option: %s", opt
);
2420 DEFUN ("set-network-process-options",
2421 Fset_network_process_options
, Sset_network_process_options
,
2423 doc
: /* Set one or more options for network process PROCESS.
2424 Each option is either a string "OPT=VALUE" or a cons (OPT . VALUE).
2425 A boolean value is false if it either zero or nil, true otherwise.
2427 The following options are known. Consult the relevant system manual
2428 pages for more information.
2430 bindtodevice=NAME -- bind to interface NAME, or remove binding if nil.
2431 broadcast=BOOL -- Allow send and receive of datagram broadcasts.
2432 dontroute=BOOL -- Only send to directly connected hosts.
2433 keepalive=BOOL -- Send keep-alive messages on network stream.
2434 linger=BOOL or TIMEOUT -- Send queued messages before closing.
2435 oobinline=BOOL -- Place out-of-band data in receive data stream.
2436 priority=INT -- Set protocol defined priority for sent packets.
2437 reuseaddr=BOOL -- Allow reusing a recently used address.
2439 usage: (set-network-process-options PROCESS &rest OPTIONS) */)
2444 Lisp_Object process
;
2448 CHECK_PROCESS (process
);
2449 if (nargs
> 1 && XINT (XPROCESS (process
)->infd
) >= 0)
2451 opts
= Flist (nargs
, args
);
2452 set_socket_options (XINT (XPROCESS (process
)->infd
), opts
, 0);
2457 /* A version of request_sigio suitable for a record_unwind_protect. */
2460 unwind_request_sigio (dummy
)
2463 if (interrupt_input
)
2468 /* Create a network stream/datagram client/server process. Treated
2469 exactly like a normal process when reading and writing. Primary
2470 differences are in status display and process deletion. A network
2471 connection has no PID; you cannot signal it. All you can do is
2472 stop/continue it and deactivate/close it via delete-process */
2474 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2476 doc
: /* Create and return a network server or client process.
2478 In Emacs, network connections are represented by process objects, so
2479 input and output work as for subprocesses and `delete-process' closes
2480 a network connection. However, a network process has no process id,
2481 it cannot be signalled, and the status codes are different from normal
2484 Arguments are specified as keyword/argument pairs. The following
2485 arguments are defined:
2487 :name NAME -- NAME is name for process. It is modified if necessary
2490 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2491 with the process. Process output goes at end of that buffer, unless
2492 you specify an output stream or filter function to handle the output.
2493 BUFFER may be also nil, meaning that this process is not associated
2496 :host HOST -- HOST is name of the host to connect to, or its IP
2497 address. The symbol `local' specifies the local host. If specified
2498 for a server process, it must be a valid name or address for the local
2499 host, and only clients connecting to that address will be accepted.
2501 :service SERVICE -- SERVICE is name of the service desired, or an
2502 integer specifying a port number to connect to. If SERVICE is t,
2503 a random port number is selected for the server.
2505 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2506 stream type connection, `datagram' creates a datagram type connection.
2508 :family FAMILY -- FAMILY is the address (and protocol) family for the
2509 service specified by HOST and SERVICE. The default address family is
2510 Inet (or IPv4) for the host and port number specified by HOST and
2511 SERVICE. Other address families supported are:
2512 local -- for a local (i.e. UNIX) address specified by SERVICE.
2514 :local ADDRESS -- ADDRESS is the local address used for the connection.
2515 This parameter is ignored when opening a client process. When specified
2516 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2518 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2519 connection. This parameter is ignored when opening a stream server
2520 process. For a datagram server process, it specifies the initial
2521 setting of the remote datagram address. When specified for a client
2522 process, the FAMILY, HOST, and SERVICE args are ignored.
2524 The format of ADDRESS depends on the address family:
2525 - An IPv4 address is represented as an vector of integers [A B C D P]
2526 corresponding to numeric IP address A.B.C.D and port number P.
2527 - A local address is represented as a string with the address in the
2528 local address space.
2529 - An "unsupported family" address is represented by a cons (F . AV)
2530 where F is the family number and AV is a vector containing the socket
2531 address data with one element per address data byte. Do not rely on
2532 this format in portable code, as it may depend on implementation
2533 defined constants, data sizes, and data structure alignment.
2535 :coding CODING -- CODING is coding system for this process.
2537 :options OPTIONS -- Set the specified options for the network process.
2538 See `set-network-process-options' for details.
2540 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2541 return without waiting for the connection to complete; instead, the
2542 sentinel function will be called with second arg matching "open" (if
2543 successful) or "failed" when the connect completes. Default is to use
2544 a blocking connect (i.e. wait) for stream type connections.
2546 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2547 running when emacs is exited.
2549 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2550 In the stopped state, a server process does not accept new
2551 connections, and a client process does not handle incoming traffic.
2552 The stopped state is cleared by `continue-process' and set by
2555 :filter FILTER -- Install FILTER as the process filter.
2557 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2559 :log LOG -- Install LOG as the server process log function. This
2560 function is called when the server accepts a network connection from a
2561 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2562 is the server process, CLIENT is the new process for the connection,
2563 and MESSAGE is a string.
2565 :server BOOL -- if BOOL is non-nil, create a server process for the
2566 specified FAMILY, SERVICE, and connection type (stream or datagram).
2567 Default is a client process.
2569 A server process will listen for and accept connections from
2570 clients. When a client connection is accepted, a new network process
2571 is created for the connection with the following parameters:
2572 - The client's process name is constructed by concatenating the server
2573 process' NAME and a client identification string.
2574 - If the FILTER argument is non-nil, the client process will not get a
2575 separate process buffer; otherwise, the client's process buffer is a newly
2576 created buffer named after the server process' BUFFER name or process
2577 NAME concatenated with the client identification string.
2578 - The connection type and the process filter and sentinel parameters are
2579 inherited from the server process' TYPE, FILTER and SENTINEL.
2580 - The client process' contact info is set according to the client's
2581 addressing information (typically an IP address and a port number).
2583 Notice that the FILTER and SENTINEL args are never used directly by
2584 the server process. Also, the BUFFER argument is not used directly by
2585 the server process, but via the optional :log function, accepted (and
2586 failed) connections may be logged in the server process' buffer.
2588 usage: (make-network-process &rest ARGS) */)
2594 Lisp_Object contact
;
2595 struct Lisp_Process
*p
;
2596 #ifdef HAVE_GETADDRINFO
2597 struct addrinfo ai
, *res
, *lres
;
2598 struct addrinfo hints
;
2599 char *portstring
, portbuf
[128];
2600 #else /* HAVE_GETADDRINFO */
2601 struct _emacs_addrinfo
2607 struct sockaddr
*ai_addr
;
2608 struct _emacs_addrinfo
*ai_next
;
2610 #endif /* HAVE_GETADDRINFO */
2611 struct sockaddr_in address_in
;
2612 #ifdef HAVE_LOCAL_SOCKETS
2613 struct sockaddr_un address_un
;
2618 int s
= -1, outch
, inch
;
2619 struct gcpro gcpro1
;
2621 int count
= SPECPDL_INDEX ();
2623 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2625 Lisp_Object name
, buffer
, host
, service
, address
;
2626 Lisp_Object filter
, sentinel
;
2627 int is_non_blocking_client
= 0;
2635 /* Save arguments for process-contact and clone-process. */
2636 contact
= Flist (nargs
, args
);
2640 /* Ensure socket support is loaded if available. */
2641 init_winsock (TRUE
);
2644 /* :type TYPE (nil: stream, datagram */
2645 tem
= Fplist_get (contact
, QCtype
);
2647 socktype
= SOCK_STREAM
;
2648 #ifdef DATAGRAM_SOCKETS
2649 else if (EQ (tem
, Qdatagram
))
2650 socktype
= SOCK_DGRAM
;
2653 error ("Unsupported connection type");
2656 tem
= Fplist_get (contact
, QCserver
);
2659 /* Don't support network sockets when non-blocking mode is
2660 not available, since a blocked Emacs is not useful. */
2661 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2662 error ("Network servers not supported");
2668 /* Make QCaddress an alias for :local (server) or :remote (client). */
2669 QCaddress
= is_server
? QClocal
: QCremote
;
2672 if (!is_server
&& socktype
== SOCK_STREAM
2673 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2675 #ifndef NON_BLOCKING_CONNECT
2676 error ("Non-blocking connect not supported");
2678 is_non_blocking_client
= 1;
2682 name
= Fplist_get (contact
, QCname
);
2683 buffer
= Fplist_get (contact
, QCbuffer
);
2684 filter
= Fplist_get (contact
, QCfilter
);
2685 sentinel
= Fplist_get (contact
, QCsentinel
);
2687 CHECK_STRING (name
);
2690 /* Let's handle TERM before things get complicated ... */
2691 host
= Fplist_get (contact
, QChost
);
2692 CHECK_STRING (host
);
2694 service
= Fplist_get (contact
, QCservice
);
2695 if (INTEGERP (service
))
2696 port
= htons ((unsigned short) XINT (service
));
2699 struct servent
*svc_info
;
2700 CHECK_STRING (service
);
2701 svc_info
= getservbyname (SDATA (service
), "tcp");
2703 error ("Unknown service: %s", SDATA (service
));
2704 port
= svc_info
->s_port
;
2707 s
= connect_server (0);
2709 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2710 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2711 send_command (s
, C_DUMB
, 1, 0);
2713 #else /* not TERM */
2715 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2716 ai
.ai_socktype
= socktype
;
2721 /* :local ADDRESS or :remote ADDRESS */
2722 address
= Fplist_get (contact
, QCaddress
);
2723 if (!NILP (address
))
2725 host
= service
= Qnil
;
2727 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2728 error ("Malformed :address");
2729 ai
.ai_family
= family
;
2730 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2731 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2735 /* :family FAMILY -- nil (for Inet), local, or integer. */
2736 tem
= Fplist_get (contact
, QCfamily
);
2738 family
= XINT (tem
);
2743 #ifdef HAVE_LOCAL_SOCKETS
2744 else if (EQ (tem
, Qlocal
))
2749 error ("Unknown address family");
2750 ai
.ai_family
= family
;
2752 /* :service SERVICE -- string, integer (port number), or t (random port). */
2753 service
= Fplist_get (contact
, QCservice
);
2755 #ifdef HAVE_LOCAL_SOCKETS
2756 if (family
== AF_LOCAL
)
2758 /* Host is not used. */
2760 CHECK_STRING (service
);
2761 bzero (&address_un
, sizeof address_un
);
2762 address_un
.sun_family
= AF_LOCAL
;
2763 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
2764 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
2765 ai
.ai_addrlen
= sizeof address_un
;
2770 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2771 host
= Fplist_get (contact
, QChost
);
2774 if (EQ (host
, Qlocal
))
2775 host
= build_string ("localhost");
2776 CHECK_STRING (host
);
2779 /* Slow down polling to every ten seconds.
2780 Some kernels have a bug which causes retrying connect to fail
2781 after a connect. Polling can interfere with gethostbyname too. */
2782 #ifdef POLL_FOR_INPUT
2783 if (socktype
== SOCK_STREAM
)
2785 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
2786 bind_polling_period (10);
2790 #ifdef HAVE_GETADDRINFO
2791 /* If we have a host, use getaddrinfo to resolve both host and service.
2792 Otherwise, use getservbyname to lookup the service. */
2796 /* SERVICE can either be a string or int.
2797 Convert to a C string for later use by getaddrinfo. */
2798 if (EQ (service
, Qt
))
2800 else if (INTEGERP (service
))
2802 sprintf (portbuf
, "%ld", (long) XINT (service
));
2803 portstring
= portbuf
;
2807 CHECK_STRING (service
);
2808 portstring
= SDATA (service
);
2813 memset (&hints
, 0, sizeof (hints
));
2815 hints
.ai_family
= NILP (Fplist_member (contact
, QCfamily
)) ? AF_UNSPEC
: family
;
2816 hints
.ai_socktype
= socktype
;
2817 hints
.ai_protocol
= 0;
2818 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
2820 #ifdef HAVE_GAI_STRERROR
2821 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
2823 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
2829 #endif /* HAVE_GETADDRINFO */
2831 /* We end up here if getaddrinfo is not defined, or in case no hostname
2832 has been specified (e.g. for a local server process). */
2834 if (EQ (service
, Qt
))
2836 else if (INTEGERP (service
))
2837 port
= htons ((unsigned short) XINT (service
));
2840 struct servent
*svc_info
;
2841 CHECK_STRING (service
);
2842 svc_info
= getservbyname (SDATA (service
),
2843 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
2845 error ("Unknown service: %s", SDATA (service
));
2846 port
= svc_info
->s_port
;
2849 bzero (&address_in
, sizeof address_in
);
2850 address_in
.sin_family
= family
;
2851 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
2852 address_in
.sin_port
= port
;
2854 #ifndef HAVE_GETADDRINFO
2857 struct hostent
*host_info_ptr
;
2859 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
2860 as it may `hang' emacs for a very long time. */
2863 host_info_ptr
= gethostbyname (SDATA (host
));
2868 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
2869 host_info_ptr
->h_length
);
2870 family
= host_info_ptr
->h_addrtype
;
2871 address_in
.sin_family
= family
;
2874 /* Attempt to interpret host as numeric inet address */
2876 IN_ADDR numeric_addr
;
2877 numeric_addr
= inet_addr ((char *) SDATA (host
));
2878 if (NUMERIC_ADDR_ERROR
)
2879 error ("Unknown host \"%s\"", SDATA (host
));
2881 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
2882 sizeof (address_in
.sin_addr
));
2886 #endif /* not HAVE_GETADDRINFO */
2888 ai
.ai_family
= family
;
2889 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
2890 ai
.ai_addrlen
= sizeof address_in
;
2894 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
2895 when connect is interrupted. So let's not let it get interrupted.
2896 Note we do not turn off polling, because polling is only used
2897 when not interrupt_input, and thus not normally used on the systems
2898 which have this bug. On systems which use polling, there's no way
2899 to quit if polling is turned off. */
2901 && !is_server
&& socktype
== SOCK_STREAM
)
2903 /* Comment from KFS: The original open-network-stream code
2904 didn't unwind protect this, but it seems like the proper
2905 thing to do. In any case, I don't see how it could harm to
2906 do this -- and it makes cleanup (using unbind_to) easier. */
2907 record_unwind_protect (unwind_request_sigio
, Qnil
);
2911 /* Do this in case we never enter the for-loop below. */
2912 count1
= SPECPDL_INDEX ();
2915 for (lres
= res
; lres
; lres
= lres
->ai_next
)
2917 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
2924 #ifdef DATAGRAM_SOCKETS
2925 if (!is_server
&& socktype
== SOCK_DGRAM
)
2927 #endif /* DATAGRAM_SOCKETS */
2929 #ifdef NON_BLOCKING_CONNECT
2930 if (is_non_blocking_client
)
2933 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
2935 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
2947 /* Make us close S if quit. */
2948 record_unwind_protect (close_file_unwind
, make_number (s
));
2952 /* Configure as a server socket. */
2953 #ifdef HAVE_LOCAL_SOCKETS
2954 if (family
!= AF_LOCAL
)
2958 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
2959 report_file_error ("Cannot set reuse option on server socket.", Qnil
);
2962 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
2963 report_file_error ("Cannot bind server socket", Qnil
);
2965 #ifdef HAVE_GETSOCKNAME
2966 if (EQ (service
, Qt
))
2968 struct sockaddr_in sa1
;
2969 int len1
= sizeof (sa1
);
2970 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
2972 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
2973 service
= make_number (sa1
.sin_port
);
2974 contact
= Fplist_put (contact
, QCservice
, service
);
2979 if (socktype
== SOCK_STREAM
&& listen (s
, 5))
2980 report_file_error ("Cannot listen on server socket", Qnil
);
2990 /* This turns off all alarm-based interrupts; the
2991 bind_polling_period call above doesn't always turn all the
2992 short-interval ones off, especially if interrupt_input is
2995 It'd be nice to be able to control the connect timeout
2996 though. Would non-blocking connect calls be portable?
2998 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3000 turn_on_atimers (0);
3002 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3005 turn_on_atimers (1);
3007 if (ret
== 0 || xerrno
== EISCONN
)
3009 /* The unwind-protect will be discarded afterwards.
3010 Likewise for immediate_quit. */
3014 #ifdef NON_BLOCKING_CONNECT
3016 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3020 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3028 if (xerrno
== EINTR
)
3030 if (xerrno
== EADDRINUSE
&& retry
< 20)
3032 /* A delay here is needed on some FreeBSD systems,
3033 and it is harmless, since this retrying takes time anyway
3034 and should be infrequent. */
3035 Fsleep_for (make_number (1), Qnil
);
3040 /* Discard the unwind protect closing S. */
3041 specpdl_ptr
= specpdl
+ count1
;
3048 #ifdef DATAGRAM_SOCKETS
3049 if (socktype
== SOCK_DGRAM
)
3051 if (datagram_address
[s
].sa
)
3053 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3054 datagram_address
[s
].len
= lres
->ai_addrlen
;
3058 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3059 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3062 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3063 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3064 conv_lisp_to_sockaddr (rfamily
, remote
,
3065 datagram_address
[s
].sa
, rlen
);
3069 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3072 contact
= Fplist_put (contact
, QCaddress
,
3073 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3076 #ifdef HAVE_GETADDRINFO
3083 /* Discard the unwind protect for closing S, if any. */
3084 specpdl_ptr
= specpdl
+ count1
;
3086 /* Unwind bind_polling_period and request_sigio. */
3087 unbind_to (count
, Qnil
);
3091 /* If non-blocking got this far - and failed - assume non-blocking is
3092 not supported after all. This is probably a wrong assumption, but
3093 the normal blocking calls to open-network-stream handles this error
3095 if (is_non_blocking_client
)
3100 report_file_error ("make server process failed", contact
);
3102 report_file_error ("make client process failed", contact
);
3105 tem
= Fplist_get (contact
, QCoptions
);
3107 set_socket_options (s
, tem
, 1);
3109 #endif /* not TERM */
3115 buffer
= Fget_buffer_create (buffer
);
3116 proc
= make_process (name
);
3118 chan_process
[inch
] = proc
;
3121 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3124 fcntl (inch
, F_SETFL
, O_NDELAY
);
3128 p
= XPROCESS (proc
);
3130 p
->childp
= contact
;
3132 p
->sentinel
= sentinel
;
3134 p
->log
= Fplist_get (contact
, QClog
);
3135 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3136 p
->kill_without_query
= Qt
;
3137 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3140 XSETINT (p
->infd
, inch
);
3141 XSETINT (p
->outfd
, outch
);
3142 if (is_server
&& socktype
== SOCK_STREAM
)
3143 p
->status
= Qlisten
;
3145 #ifdef NON_BLOCKING_CONNECT
3146 if (is_non_blocking_client
)
3148 /* We may get here if connect did succeed immediately. However,
3149 in that case, we still need to signal this like a non-blocking
3151 p
->status
= Qconnect
;
3152 if (!FD_ISSET (inch
, &connect_wait_mask
))
3154 FD_SET (inch
, &connect_wait_mask
);
3155 num_pending_connects
++;
3160 /* A server may have a client filter setting of Qt, but it must
3161 still listen for incoming connects unless it is stopped. */
3162 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3163 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3165 FD_SET (inch
, &input_wait_mask
);
3166 FD_SET (inch
, &non_keyboard_wait_mask
);
3169 if (inch
> max_process_desc
)
3170 max_process_desc
= inch
;
3172 tem
= Fplist_member (contact
, QCcoding
);
3173 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3174 tem
= Qnil
; /* No error message (too late!). */
3177 /* Setup coding systems for communicating with the network stream. */
3178 struct gcpro gcpro1
;
3179 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3180 Lisp_Object coding_systems
= Qt
;
3181 Lisp_Object args
[5], val
;
3184 val
= XCAR (XCDR (tem
));
3185 else if (!NILP (Vcoding_system_for_read
))
3186 val
= Vcoding_system_for_read
;
3187 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3188 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3189 /* We dare not decode end-of-line format by setting VAL to
3190 Qraw_text, because the existing Emacs Lisp libraries
3191 assume that they receive bare code including a sequene of
3196 if (NILP (host
) || NILP (service
))
3197 coding_systems
= Qnil
;
3200 args
[0] = Qopen_network_stream
, args
[1] = name
,
3201 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3203 coding_systems
= Ffind_operation_coding_system (5, args
);
3206 if (CONSP (coding_systems
))
3207 val
= XCAR (coding_systems
);
3208 else if (CONSP (Vdefault_process_coding_system
))
3209 val
= XCAR (Vdefault_process_coding_system
);
3213 p
->decode_coding_system
= val
;
3216 val
= XCAR (XCDR (tem
));
3217 else if (!NILP (Vcoding_system_for_write
))
3218 val
= Vcoding_system_for_write
;
3219 else if (NILP (current_buffer
->enable_multibyte_characters
))
3223 if (EQ (coding_systems
, Qt
))
3225 if (NILP (host
) || NILP (service
))
3226 coding_systems
= Qnil
;
3229 args
[0] = Qopen_network_stream
, args
[1] = name
,
3230 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3232 coding_systems
= Ffind_operation_coding_system (5, args
);
3236 if (CONSP (coding_systems
))
3237 val
= XCDR (coding_systems
);
3238 else if (CONSP (Vdefault_process_coding_system
))
3239 val
= XCDR (Vdefault_process_coding_system
);
3243 p
->encode_coding_system
= val
;
3246 if (!proc_decode_coding_system
[inch
])
3247 proc_decode_coding_system
[inch
]
3248 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
3249 setup_coding_system (p
->decode_coding_system
,
3250 proc_decode_coding_system
[inch
]);
3251 if (!proc_encode_coding_system
[outch
])
3252 proc_encode_coding_system
[outch
]
3253 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
3254 setup_coding_system (p
->encode_coding_system
,
3255 proc_encode_coding_system
[outch
]);
3257 p
->decoding_buf
= make_uninit_string (0);
3258 p
->decoding_carryover
= make_number (0);
3259 p
->encoding_buf
= make_uninit_string (0);
3260 p
->encoding_carryover
= make_number (0);
3262 p
->inherit_coding_system_flag
3263 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3269 #endif /* HAVE_SOCKETS */
3272 deactivate_process (proc
)
3275 register int inchannel
, outchannel
;
3276 register struct Lisp_Process
*p
= XPROCESS (proc
);
3278 inchannel
= XINT (p
->infd
);
3279 outchannel
= XINT (p
->outfd
);
3283 /* Beware SIGCHLD hereabouts. */
3284 flush_pending_output (inchannel
);
3287 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3288 sys$
dassgn (outchannel
);
3289 vs
= get_vms_process_pointer (p
->pid
);
3291 give_back_vms_process_stuff (vs
);
3294 emacs_close (inchannel
);
3295 if (outchannel
>= 0 && outchannel
!= inchannel
)
3296 emacs_close (outchannel
);
3299 XSETINT (p
->infd
, -1);
3300 XSETINT (p
->outfd
, -1);
3301 #ifdef DATAGRAM_SOCKETS
3302 if (DATAGRAM_CHAN_P (inchannel
))
3304 xfree (datagram_address
[inchannel
].sa
);
3305 datagram_address
[inchannel
].sa
= 0;
3306 datagram_address
[inchannel
].len
= 0;
3309 chan_process
[inchannel
] = Qnil
;
3310 FD_CLR (inchannel
, &input_wait_mask
);
3311 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3312 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3314 FD_CLR (inchannel
, &connect_wait_mask
);
3315 if (--num_pending_connects
< 0)
3318 if (inchannel
== max_process_desc
)
3321 /* We just closed the highest-numbered process input descriptor,
3322 so recompute the highest-numbered one now. */
3323 max_process_desc
= 0;
3324 for (i
= 0; i
< MAXDESC
; i
++)
3325 if (!NILP (chan_process
[i
]))
3326 max_process_desc
= i
;
3331 /* Close all descriptors currently in use for communication
3332 with subprocess. This is used in a newly-forked subprocess
3333 to get rid of irrelevant descriptors. */
3336 close_process_descs ()
3340 for (i
= 0; i
< MAXDESC
; i
++)
3342 Lisp_Object process
;
3343 process
= chan_process
[i
];
3344 if (!NILP (process
))
3346 int in
= XINT (XPROCESS (process
)->infd
);
3347 int out
= XINT (XPROCESS (process
)->outfd
);
3350 if (out
>= 0 && in
!= out
)
3357 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3359 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3360 It is read into the process' buffers or given to their filter functions.
3361 Non-nil arg PROCESS means do not return until some output has been received
3363 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of
3364 seconds and microseconds to wait; return after that much time whether
3365 or not there is input.
3366 Return non-nil iff we received any output before the timeout expired. */)
3367 (process
, timeout
, timeout_msecs
)
3368 register Lisp_Object process
, timeout
, timeout_msecs
;
3373 if (! NILP (process
))
3374 CHECK_PROCESS (process
);
3376 if (! NILP (timeout_msecs
))
3378 CHECK_NUMBER (timeout_msecs
);
3379 useconds
= XINT (timeout_msecs
);
3380 if (!INTEGERP (timeout
))
3381 XSETINT (timeout
, 0);
3384 int carry
= useconds
/ 1000000;
3386 XSETINT (timeout
, XINT (timeout
) + carry
);
3387 useconds
-= carry
* 1000000;
3389 /* I think this clause is necessary because C doesn't
3390 guarantee a particular rounding direction for negative
3394 XSETINT (timeout
, XINT (timeout
) - 1);
3395 useconds
+= 1000000;
3402 if (! NILP (timeout
))
3404 CHECK_NUMBER (timeout
);
3405 seconds
= XINT (timeout
);
3406 if (seconds
< 0 || (seconds
== 0 && useconds
== 0))
3418 XSETFASTINT (process
, 0);
3421 (wait_reading_process_input (seconds
, useconds
, process
, 0)
3425 /* Accept a connection for server process SERVER on CHANNEL. */
3427 static int connect_counter
= 0;
3430 server_accept_connection (server
, channel
)
3434 Lisp_Object proc
, caller
, name
, buffer
;
3435 Lisp_Object contact
, host
, service
;
3436 struct Lisp_Process
*ps
= XPROCESS (server
);
3437 struct Lisp_Process
*p
;
3441 struct sockaddr_in in
;
3442 #ifdef HAVE_LOCAL_SOCKETS
3443 struct sockaddr_un un
;
3446 int len
= sizeof saddr
;
3448 s
= accept (channel
, &saddr
.sa
, &len
);
3457 if (code
== EWOULDBLOCK
)
3461 if (!NILP (ps
->log
))
3462 call3 (ps
->log
, server
, Qnil
,
3463 concat3 (build_string ("accept failed with code"),
3464 Fnumber_to_string (make_number (code
)),
3465 build_string ("\n")));
3471 /* Setup a new process to handle the connection. */
3473 /* Generate a unique identification of the caller, and build contact
3474 information for this process. */
3477 switch (saddr
.sa
.sa_family
)
3481 Lisp_Object args
[5];
3482 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
3483 args
[0] = build_string ("%d.%d.%d.%d");
3484 args
[1] = make_number (*ip
++);
3485 args
[2] = make_number (*ip
++);
3486 args
[3] = make_number (*ip
++);
3487 args
[4] = make_number (*ip
++);
3488 host
= Fformat (5, args
);
3489 service
= make_number (ntohs (saddr
.in
.sin_port
));
3491 args
[0] = build_string (" <%s:%d>");
3494 caller
= Fformat (3, args
);
3498 #ifdef HAVE_LOCAL_SOCKETS
3502 caller
= Fnumber_to_string (make_number (connect_counter
));
3503 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
3507 /* Create a new buffer name for this process if it doesn't have a
3508 filter. The new buffer name is based on the buffer name or
3509 process name of the server process concatenated with the caller
3512 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
3516 buffer
= ps
->buffer
;
3518 buffer
= Fbuffer_name (buffer
);
3523 buffer
= concat2 (buffer
, caller
);
3524 buffer
= Fget_buffer_create (buffer
);
3528 /* Generate a unique name for the new server process. Combine the
3529 server process name with the caller identification. */
3531 name
= concat2 (ps
->name
, caller
);
3532 proc
= make_process (name
);
3534 chan_process
[s
] = proc
;
3537 fcntl (s
, F_SETFL
, O_NONBLOCK
);
3540 fcntl (s
, F_SETFL
, O_NDELAY
);
3544 p
= XPROCESS (proc
);
3546 /* Build new contact information for this setup. */
3547 contact
= Fcopy_sequence (ps
->childp
);
3548 contact
= Fplist_put (contact
, QCserver
, Qnil
);
3549 contact
= Fplist_put (contact
, QChost
, host
);
3550 if (!NILP (service
))
3551 contact
= Fplist_put (contact
, QCservice
, service
);
3552 contact
= Fplist_put (contact
, QCremote
,
3553 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
3554 #ifdef HAVE_GETSOCKNAME
3556 if (getsockname (channel
, &saddr
.sa
, &len
) == 0)
3557 contact
= Fplist_put (contact
, QClocal
,
3558 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
3561 p
->childp
= contact
;
3563 p
->sentinel
= ps
->sentinel
;
3564 p
->filter
= ps
->filter
;
3567 XSETINT (p
->infd
, s
);
3568 XSETINT (p
->outfd
, s
);
3571 /* Client processes for accepted connections are not stopped initially. */
3572 if (!EQ (p
->filter
, Qt
))
3574 FD_SET (s
, &input_wait_mask
);
3575 FD_SET (s
, &non_keyboard_wait_mask
);
3578 if (s
> max_process_desc
)
3579 max_process_desc
= s
;
3581 /* Setup coding system for new process based on server process.
3582 This seems to be the proper thing to do, as the coding system
3583 of the new process should reflect the settings at the time the
3584 server socket was opened; not the current settings. */
3586 p
->decode_coding_system
= ps
->decode_coding_system
;
3587 p
->encode_coding_system
= ps
->encode_coding_system
;
3589 if (!proc_decode_coding_system
[s
])
3590 proc_decode_coding_system
[s
]
3591 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
3592 setup_coding_system (p
->decode_coding_system
,
3593 proc_decode_coding_system
[s
]);
3594 if (!proc_encode_coding_system
[s
])
3595 proc_encode_coding_system
[s
]
3596 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
3597 setup_coding_system (p
->encode_coding_system
,
3598 proc_encode_coding_system
[s
]);
3600 p
->decoding_buf
= make_uninit_string (0);
3601 p
->decoding_carryover
= make_number (0);
3602 p
->encoding_buf
= make_uninit_string (0);
3603 p
->encoding_carryover
= make_number (0);
3605 p
->inherit_coding_system_flag
3606 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
3608 if (!NILP (ps
->log
))
3609 call3 (ps
->log
, server
, proc
,
3610 concat3 (build_string ("accept from "),
3611 (STRINGP (host
) ? host
: build_string ("-")),
3612 build_string ("\n")));
3614 if (!NILP (p
->sentinel
))
3615 exec_sentinel (proc
,
3616 concat3 (build_string ("open from "),
3617 (STRINGP (host
) ? host
: build_string ("-")),
3618 build_string ("\n")));
3621 /* This variable is different from waiting_for_input in keyboard.c.
3622 It is used to communicate to a lisp process-filter/sentinel (via the
3623 function Fwaiting_for_user_input_p below) whether emacs was waiting
3624 for user-input when that process-filter was called.
3625 waiting_for_input cannot be used as that is by definition 0 when
3626 lisp code is being evalled.
3627 This is also used in record_asynch_buffer_change.
3628 For that purpose, this must be 0
3629 when not inside wait_reading_process_input. */
3630 static int waiting_for_user_input_p
;
3632 /* This is here so breakpoints can be put on it. */
3634 wait_reading_process_input_1 ()
3638 /* Read and dispose of subprocess output while waiting for timeout to
3639 elapse and/or keyboard input to be available.
3642 timeout in seconds, or
3643 zero for no limit, or
3644 -1 means gobble data immediately available but don't wait for any.
3647 an additional duration to wait, measured in microseconds.
3648 If this is nonzero and time_limit is 0, then the timeout
3649 consists of MICROSECS only.
3651 READ_KBD is a lisp value:
3652 0 to ignore keyboard input, or
3653 1 to return when input is available, or
3654 -1 meaning caller will actually read the input, so don't throw to
3655 the quit handler, or
3656 a cons cell, meaning wait until its car is non-nil
3657 (and gobble terminal input into the buffer if any arrives), or
3658 a process object, meaning wait until something arrives from that
3659 process. The return value is true iff we read some input from
3662 DO_DISPLAY != 0 means redisplay should be done to show subprocess
3663 output that arrives.
3665 If READ_KBD is a pointer to a struct Lisp_Process, then the
3666 function returns true iff we received input from that process
3667 before the timeout elapsed.
3668 Otherwise, return true iff we received input from any process. */
3671 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
3672 int time_limit
, microsecs
;
3673 Lisp_Object read_kbd
;
3676 register int channel
, nfds
;
3677 static SELECT_TYPE Available
;
3678 static SELECT_TYPE Connecting
;
3679 int check_connect
, no_avail
;
3682 EMACS_TIME timeout
, end_time
;
3683 int wait_channel
= -1;
3684 struct Lisp_Process
*wait_proc
= 0;
3685 int got_some_input
= 0;
3686 /* Either nil or a cons cell, the car of which is of interest and
3687 may be changed outside of this routine. */
3688 Lisp_Object wait_for_cell
= Qnil
;
3690 FD_ZERO (&Available
);
3691 FD_ZERO (&Connecting
);
3693 /* If read_kbd is a process to watch, set wait_proc and wait_channel
3695 if (PROCESSP (read_kbd
))
3697 wait_proc
= XPROCESS (read_kbd
);
3698 wait_channel
= XINT (wait_proc
->infd
);
3699 XSETFASTINT (read_kbd
, 0);
3702 /* If waiting for non-nil in a cell, record where. */
3703 if (CONSP (read_kbd
))
3705 wait_for_cell
= read_kbd
;
3706 XSETFASTINT (read_kbd
, 0);
3709 waiting_for_user_input_p
= XINT (read_kbd
);
3711 /* Since we may need to wait several times,
3712 compute the absolute time to return at. */
3713 if (time_limit
|| microsecs
)
3715 EMACS_GET_TIME (end_time
);
3716 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
3717 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
3720 /* AlainF 5-Jul-1996
3721 HP-UX 10.10 seem to have problems with signals coming in
3722 Causes "poll: interrupted system call" messages when Emacs is run
3724 Turn off periodic alarms (in case they are in use),
3725 and then turn off any other atimers. */
3727 turn_on_atimers (0);
3732 int timeout_reduced_for_timers
= 0;
3734 /* If calling from keyboard input, do not quit
3735 since we want to return C-g as an input character.
3736 Otherwise, do pending quit if requested. */
3737 if (XINT (read_kbd
) >= 0)
3740 /* Exit now if the cell we're waiting for became non-nil. */
3741 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
3744 /* Compute time from now till when time limit is up */
3745 /* Exit if already run out */
3746 if (time_limit
== -1)
3748 /* -1 specified for timeout means
3749 gobble output available now
3750 but don't wait at all. */
3752 EMACS_SET_SECS_USECS (timeout
, 0, 0);
3754 else if (time_limit
|| microsecs
)
3756 EMACS_GET_TIME (timeout
);
3757 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
3758 if (EMACS_TIME_NEG_P (timeout
))
3763 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
3766 /* Normally we run timers here.
3767 But not if wait_for_cell; in those cases,
3768 the wait is supposed to be short,
3769 and those callers cannot handle running arbitrary Lisp code here. */
3770 if (NILP (wait_for_cell
))
3772 EMACS_TIME timer_delay
;
3776 int old_timers_run
= timers_run
;
3777 struct buffer
*old_buffer
= current_buffer
;
3779 timer_delay
= timer_check (1);
3781 /* If a timer has run, this might have changed buffers
3782 an alike. Make read_key_sequence aware of that. */
3783 if (timers_run
!= old_timers_run
3784 && old_buffer
!= current_buffer
3785 && waiting_for_user_input_p
== -1)
3786 record_asynch_buffer_change ();
3788 if (timers_run
!= old_timers_run
&& do_display
)
3789 /* We must retry, since a timer may have requeued itself
3790 and that could alter the time_delay. */
3791 redisplay_preserve_echo_area (9);
3795 while (!detect_input_pending ());
3797 /* If there is unread keyboard input, also return. */
3798 if (XINT (read_kbd
) != 0
3799 && requeued_events_pending_p ())
3802 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
3804 EMACS_TIME difference
;
3805 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
3806 if (EMACS_TIME_NEG_P (difference
))
3808 timeout
= timer_delay
;
3809 timeout_reduced_for_timers
= 1;
3812 /* If time_limit is -1, we are not going to wait at all. */
3813 else if (time_limit
!= -1)
3815 /* This is so a breakpoint can be put here. */
3816 wait_reading_process_input_1 ();
3820 /* Cause C-g and alarm signals to take immediate action,
3821 and cause input available signals to zero out timeout.
3823 It is important that we do this before checking for process
3824 activity. If we get a SIGCHLD after the explicit checks for
3825 process activity, timeout is the only way we will know. */
3826 if (XINT (read_kbd
) < 0)
3827 set_waiting_for_input (&timeout
);
3829 /* If status of something has changed, and no input is
3830 available, notify the user of the change right away. After
3831 this explicit check, we'll let the SIGCHLD handler zap
3832 timeout to get our attention. */
3833 if (update_tick
!= process_tick
&& do_display
)
3835 SELECT_TYPE Atemp
, Ctemp
;
3837 Atemp
= input_wait_mask
;
3839 /* On Mac OS X, the SELECT system call always says input is
3840 present (for reading) at stdin, even when none is. This
3841 causes the call to SELECT below to return 1 and
3842 status_notify not to be called. As a result output of
3843 subprocesses are incorrectly discarded. */
3846 Ctemp
= connect_wait_mask
;
3847 EMACS_SET_SECS_USECS (timeout
, 0, 0);
3848 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
3850 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
3851 (SELECT_TYPE
*)0, &timeout
)
3854 /* It's okay for us to do this and then continue with
3855 the loop, since timeout has already been zeroed out. */
3856 clear_waiting_for_input ();
3861 /* Don't wait for output from a non-running process. Just
3862 read whatever data has already been received. */
3863 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
3864 update_status (wait_proc
);
3866 && ! EQ (wait_proc
->status
, Qrun
)
3867 && ! EQ (wait_proc
->status
, Qconnect
))
3869 int nread
, total_nread
= 0;
3871 clear_waiting_for_input ();
3872 XSETPROCESS (proc
, wait_proc
);
3874 /* Read data from the process, until we exhaust it. */
3875 while (XINT (wait_proc
->infd
) >= 0)
3877 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
3883 total_nread
+= nread
;
3885 else if (nread
== -1 && EIO
== errno
)
3889 else if (nread
== -1 && EAGAIN
== errno
)
3893 else if (nread
== -1 && EWOULDBLOCK
== errno
)
3897 if (total_nread
> 0 && do_display
)
3898 redisplay_preserve_echo_area (10);
3903 /* Wait till there is something to do */
3905 if (!NILP (wait_for_cell
))
3907 Available
= non_process_wait_mask
;
3912 if (! XINT (read_kbd
))
3913 Available
= non_keyboard_wait_mask
;
3915 Available
= input_wait_mask
;
3916 check_connect
= (num_pending_connects
> 0);
3919 /* If frame size has changed or the window is newly mapped,
3920 redisplay now, before we start to wait. There is a race
3921 condition here; if a SIGIO arrives between now and the select
3922 and indicates that a frame is trashed, the select may block
3923 displaying a trashed screen. */
3924 if (frame_garbaged
&& do_display
)
3926 clear_waiting_for_input ();
3927 redisplay_preserve_echo_area (11);
3928 if (XINT (read_kbd
) < 0)
3929 set_waiting_for_input (&timeout
);
3933 if (XINT (read_kbd
) && detect_input_pending ())
3941 Connecting
= connect_wait_mask
;
3942 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
3944 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
3945 (SELECT_TYPE
*)0, &timeout
);
3950 /* Make C-g and alarm signals set flags again */
3951 clear_waiting_for_input ();
3953 /* If we woke up due to SIGWINCH, actually change size now. */
3954 do_pending_window_change (0);
3956 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
3957 /* We wanted the full specified time, so return now. */
3961 if (xerrno
== EINTR
)
3964 /* Ultrix select seems to return ENOMEM when it is
3965 interrupted. Treat it just like EINTR. Bleah. Note
3966 that we want to test for the "ultrix" CPP symbol, not
3967 "__ultrix__"; the latter is only defined under GCC, but
3968 not by DEC's bundled CC. -JimB */
3969 else if (xerrno
== ENOMEM
)
3973 /* This happens for no known reason on ALLIANT.
3974 I am guessing that this is the right response. -- RMS. */
3975 else if (xerrno
== EFAULT
)
3978 else if (xerrno
== EBADF
)
3981 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
3982 the child's closure of the pts gives the parent a SIGHUP, and
3983 the ptc file descriptor is automatically closed,
3984 yielding EBADF here or at select() call above.
3985 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
3986 in m/ibmrt-aix.h), and here we just ignore the select error.
3987 Cleanup occurs c/o status_notify after SIGCLD. */
3988 no_avail
= 1; /* Cannot depend on values returned */
3994 error ("select error: %s", emacs_strerror (xerrno
));
3999 FD_ZERO (&Available
);
4003 #if defined(sun) && !defined(USG5_4)
4004 if (nfds
> 0 && keyboard_bit_set (&Available
)
4006 /* System sometimes fails to deliver SIGIO.
4008 David J. Mackenzie says that Emacs doesn't compile under
4009 Solaris if this code is enabled, thus the USG5_4 in the CPP
4010 conditional. "I haven't noticed any ill effects so far.
4011 If you find a Solaris expert somewhere, they might know
4013 kill (getpid (), SIGIO
);
4016 #if 0 /* When polling is used, interrupt_input is 0,
4017 so get_input_pending should read the input.
4018 So this should not be needed. */
4019 /* If we are using polling for input,
4020 and we see input available, make it get read now.
4021 Otherwise it might not actually get read for a second.
4022 And on hpux, since we turn off polling in wait_reading_process_input,
4023 it might never get read at all if we don't spend much time
4024 outside of wait_reading_process_input. */
4025 if (XINT (read_kbd
) && interrupt_input
4026 && keyboard_bit_set (&Available
)
4027 && input_polling_used ())
4028 kill (getpid (), SIGALRM
);
4031 /* Check for keyboard input */
4032 /* If there is any, return immediately
4033 to give it higher priority than subprocesses */
4035 if (XINT (read_kbd
) != 0)
4037 int old_timers_run
= timers_run
;
4038 struct buffer
*old_buffer
= current_buffer
;
4041 if (detect_input_pending_run_timers (do_display
))
4043 swallow_events (do_display
);
4044 if (detect_input_pending_run_timers (do_display
))
4048 /* If a timer has run, this might have changed buffers
4049 an alike. Make read_key_sequence aware of that. */
4050 if (timers_run
!= old_timers_run
4051 && waiting_for_user_input_p
== -1
4052 && old_buffer
!= current_buffer
)
4053 record_asynch_buffer_change ();
4059 /* If there is unread keyboard input, also return. */
4060 if (XINT (read_kbd
) != 0
4061 && requeued_events_pending_p ())
4064 /* If we are not checking for keyboard input now,
4065 do process events (but don't run any timers).
4066 This is so that X events will be processed.
4067 Otherwise they may have to wait until polling takes place.
4068 That would causes delays in pasting selections, for example.
4070 (We used to do this only if wait_for_cell.) */
4071 if (XINT (read_kbd
) == 0 && detect_input_pending ())
4073 swallow_events (do_display
);
4074 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4075 if (detect_input_pending ())
4080 /* Exit now if the cell we're waiting for became non-nil. */
4081 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4085 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4086 go read it. This can happen with X on BSD after logging out.
4087 In that case, there really is no input and no SIGIO,
4088 but select says there is input. */
4090 if (XINT (read_kbd
) && interrupt_input
4091 && keyboard_bit_set (&Available
))
4092 kill (getpid (), SIGIO
);
4096 got_some_input
|= nfds
> 0;
4098 /* If checking input just got us a size-change event from X,
4099 obey it now if we should. */
4100 if (XINT (read_kbd
) || ! NILP (wait_for_cell
))
4101 do_pending_window_change (0);
4103 /* Check for data from a process. */
4104 if (no_avail
|| nfds
== 0)
4107 /* Really FIRST_PROC_DESC should be 0 on Unix,
4108 but this is safer in the short run. */
4109 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4111 if (FD_ISSET (channel
, &Available
)
4112 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4116 /* If waiting for this channel, arrange to return as
4117 soon as no more input to be processed. No more
4119 if (wait_channel
== channel
)
4125 proc
= chan_process
[channel
];
4129 /* If this is a server stream socket, accept connection. */
4130 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4132 server_accept_connection (proc
, channel
);
4136 /* Read data from the process, starting with our
4137 buffered-ahead character if we have one. */
4139 nread
= read_process_output (proc
, channel
);
4142 /* Since read_process_output can run a filter,
4143 which can call accept-process-output,
4144 don't try to read from any other processes
4145 before doing the select again. */
4146 FD_ZERO (&Available
);
4149 redisplay_preserve_echo_area (12);
4152 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4155 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4156 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4158 else if (nread
== -1 && errno
== EAGAIN
)
4162 else if (nread
== -1 && errno
== EAGAIN
)
4164 /* Note that we cannot distinguish between no input
4165 available now and a closed pipe.
4166 With luck, a closed pipe will be accompanied by
4167 subprocess termination and SIGCHLD. */
4168 else if (nread
== 0 && !NETCONN_P (proc
))
4170 #endif /* O_NDELAY */
4171 #endif /* O_NONBLOCK */
4173 /* On some OSs with ptys, when the process on one end of
4174 a pty exits, the other end gets an error reading with
4175 errno = EIO instead of getting an EOF (0 bytes read).
4176 Therefore, if we get an error reading and errno =
4177 EIO, just continue, because the child process has
4178 exited and should clean itself up soon (e.g. when we
4181 However, it has been known to happen that the SIGCHLD
4182 got lost. So raise the signl again just in case.
4184 else if (nread
== -1 && errno
== EIO
)
4185 kill (getpid (), SIGCHLD
);
4186 #endif /* HAVE_PTYS */
4187 /* If we can detect process termination, don't consider the process
4188 gone just because its pipe is closed. */
4190 else if (nread
== 0 && !NETCONN_P (proc
))
4195 /* Preserve status of processes already terminated. */
4196 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4197 deactivate_process (proc
);
4198 if (!NILP (XPROCESS (proc
)->raw_status_low
))
4199 update_status (XPROCESS (proc
));
4200 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4201 XPROCESS (proc
)->status
4202 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4205 #ifdef NON_BLOCKING_CONNECT
4206 if (check_connect
&& FD_ISSET (channel
, &Connecting
))
4208 struct Lisp_Process
*p
;
4210 FD_CLR (channel
, &connect_wait_mask
);
4211 if (--num_pending_connects
< 0)
4214 proc
= chan_process
[channel
];
4218 p
= XPROCESS (proc
);
4221 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4222 So only use it on systems where it is known to work. */
4224 int xlen
= sizeof(xerrno
);
4225 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4230 struct sockaddr pname
;
4231 int pnamelen
= sizeof(pname
);
4233 /* If connection failed, getpeername will fail. */
4235 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4237 /* Obtain connect failure code through error slippage. */
4240 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4247 XSETINT (p
->tick
, ++process_tick
);
4248 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4249 deactivate_process (proc
);
4254 /* Execute the sentinel here. If we had relied on
4255 status_notify to do it later, it will read input
4256 from the process before calling the sentinel. */
4257 exec_sentinel (proc
, build_string ("open\n"));
4258 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4260 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4261 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4265 #endif /* NON_BLOCKING_CONNECT */
4266 } /* end for each file descriptor */
4267 } /* end while exit conditions not met */
4269 waiting_for_user_input_p
= 0;
4271 /* If calling from keyboard input, do not quit
4272 since we want to return C-g as an input character.
4273 Otherwise, do pending quit if requested. */
4274 if (XINT (read_kbd
) >= 0)
4276 /* Prevent input_pending from remaining set if we quit. */
4277 clear_input_pending ();
4281 /* AlainF 5-Jul-1996
4282 HP-UX 10.10 seems to have problems with signals coming in
4283 Causes "poll: interrupted system call" messages when Emacs is run
4285 Turn periodic alarms back on */
4289 return got_some_input
;
4292 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4295 read_process_output_call (fun_and_args
)
4296 Lisp_Object fun_and_args
;
4298 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4302 read_process_output_error_handler (error
)
4305 cmd_error_internal (error
, "error in process filter: ");
4307 update_echo_area ();
4308 Fsleep_for (make_number (2), Qnil
);
4312 /* Read pending output from the process channel,
4313 starting with our buffered-ahead character if we have one.
4314 Yield number of decoded characters read.
4316 This function reads at most 1024 characters.
4317 If you want to read all available subprocess output,
4318 you must call it repeatedly until it returns zero.
4320 The characters read are decoded according to PROC's coding-system
4324 read_process_output (proc
, channel
)
4326 register int channel
;
4328 register int nchars
, nbytes
;
4330 register Lisp_Object outstream
;
4331 register struct buffer
*old
= current_buffer
;
4332 register struct Lisp_Process
*p
= XPROCESS (proc
);
4333 register int opoint
;
4334 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4335 int carryover
= XINT (p
->decoding_carryover
);
4339 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4341 vs
= get_vms_process_pointer (p
->pid
);
4345 return (0); /* Really weird if it does this */
4346 if (!(vs
->iosb
[0] & 1))
4347 return -1; /* I/O error */
4350 error ("Could not get VMS process pointer");
4351 chars
= vs
->inputBuffer
;
4352 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4355 start_vms_process_read (vs
); /* Crank up the next read on the process */
4356 return 1; /* Nothing worth printing, say we got 1 */
4360 /* The data carried over in the previous decoding (which are at
4361 the tail of decoding buffer) should be prepended to the new
4362 data read to decode all together. */
4363 chars
= (char *) alloca (nbytes
+ carryover
);
4364 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
4365 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4369 #ifdef DATAGRAM_SOCKETS
4370 /* A datagram is one packet; allow at least 1500+ bytes of data
4371 corresponding to the typical Ethernet frame size. */
4372 if (DATAGRAM_CHAN_P (channel
))
4374 /* carryover = 0; */ /* Does carryover make sense for datagrams? */
4379 chars
= (char *) alloca (carryover
+ readmax
);
4381 /* See the comment above. */
4382 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
4384 #ifdef DATAGRAM_SOCKETS
4385 /* We have a working select, so proc_buffered_char is always -1. */
4386 if (DATAGRAM_CHAN_P (channel
))
4388 int len
= datagram_address
[channel
].len
;
4389 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
- carryover
,
4390 0, datagram_address
[channel
].sa
, &len
);
4394 if (proc_buffered_char
[channel
] < 0)
4395 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
- carryover
);
4398 chars
[carryover
] = proc_buffered_char
[channel
];
4399 proc_buffered_char
[channel
] = -1;
4400 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1 - carryover
);
4404 nbytes
= nbytes
+ 1;
4406 #endif /* not VMS */
4408 XSETINT (p
->decoding_carryover
, 0);
4410 /* At this point, NBYTES holds number of bytes just received
4411 (including the one in proc_buffered_char[channel]). */
4414 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
4416 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4419 /* Now set NBYTES how many bytes we must decode. */
4420 nbytes
+= carryover
;
4422 /* Read and dispose of the process output. */
4423 outstream
= p
->filter
;
4424 if (!NILP (outstream
))
4426 /* We inhibit quit here instead of just catching it so that
4427 hitting ^G when a filter happens to be running won't screw
4429 int count
= SPECPDL_INDEX ();
4430 Lisp_Object odeactivate
;
4431 Lisp_Object obuffer
, okeymap
;
4433 int outer_running_asynch_code
= running_asynch_code
;
4434 int waiting
= waiting_for_user_input_p
;
4436 /* No need to gcpro these, because all we do with them later
4437 is test them for EQness, and none of them should be a string. */
4438 odeactivate
= Vdeactivate_mark
;
4439 XSETBUFFER (obuffer
, current_buffer
);
4440 okeymap
= current_buffer
->keymap
;
4442 specbind (Qinhibit_quit
, Qt
);
4443 specbind (Qlast_nonmenu_event
, Qt
);
4445 /* In case we get recursively called,
4446 and we already saved the match data nonrecursively,
4447 save the same match data in safely recursive fashion. */
4448 if (outer_running_asynch_code
)
4451 /* Don't clobber the CURRENT match data, either! */
4452 tem
= Fmatch_data (Qnil
, Qnil
);
4453 restore_match_data ();
4454 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
4455 Fset_match_data (tem
);
4458 /* For speed, if a search happens within this code,
4459 save the match data in a special nonrecursive fashion. */
4460 running_asynch_code
= 1;
4462 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
4464 if (NILP (buffer_defaults
.enable_multibyte_characters
))
4465 /* We had better return unibyte string. */
4466 text
= string_make_unibyte (text
);
4468 Vlast_coding_system_used
= coding
->symbol
;
4469 /* A new coding system might be found. */
4470 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
4472 p
->decode_coding_system
= coding
->symbol
;
4474 /* Don't call setup_coding_system for
4475 proc_decode_coding_system[channel] here. It is done in
4476 detect_coding called via decode_coding above. */
4478 /* If a coding system for encoding is not yet decided, we set
4479 it as the same as coding-system for decoding.
4481 But, before doing that we must check if
4482 proc_encode_coding_system[p->outfd] surely points to a
4483 valid memory because p->outfd will be changed once EOF is
4484 sent to the process. */
4485 if (NILP (p
->encode_coding_system
)
4486 && proc_encode_coding_system
[XINT (p
->outfd
)])
4488 p
->encode_coding_system
= coding
->symbol
;
4489 setup_coding_system (coding
->symbol
,
4490 proc_encode_coding_system
[XINT (p
->outfd
)]);
4494 carryover
= nbytes
- coding
->consumed
;
4495 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
4497 XSETINT (p
->decoding_carryover
, carryover
);
4498 nbytes
= SBYTES (text
);
4499 nchars
= SCHARS (text
);
4501 internal_condition_case_1 (read_process_output_call
,
4503 Fcons (proc
, Fcons (text
, Qnil
))),
4504 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
4505 read_process_output_error_handler
);
4507 /* If we saved the match data nonrecursively, restore it now. */
4508 restore_match_data ();
4509 running_asynch_code
= outer_running_asynch_code
;
4511 /* Handling the process output should not deactivate the mark. */
4512 Vdeactivate_mark
= odeactivate
;
4514 /* Restore waiting_for_user_input_p as it was
4515 when we were called, in case the filter clobbered it. */
4516 waiting_for_user_input_p
= waiting
;
4518 #if 0 /* Call record_asynch_buffer_change unconditionally,
4519 because we might have changed minor modes or other things
4520 that affect key bindings. */
4521 if (! EQ (Fcurrent_buffer (), obuffer
)
4522 || ! EQ (current_buffer
->keymap
, okeymap
))
4524 /* But do it only if the caller is actually going to read events.
4525 Otherwise there's no need to make him wake up, and it could
4526 cause trouble (for example it would make Fsit_for return). */
4527 if (waiting_for_user_input_p
== -1)
4528 record_asynch_buffer_change ();
4531 start_vms_process_read (vs
);
4533 unbind_to (count
, Qnil
);
4537 /* If no filter, write into buffer if it isn't dead. */
4538 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
4540 Lisp_Object old_read_only
;
4541 int old_begv
, old_zv
;
4542 int old_begv_byte
, old_zv_byte
;
4543 Lisp_Object odeactivate
;
4544 int before
, before_byte
;
4549 odeactivate
= Vdeactivate_mark
;
4551 Fset_buffer (p
->buffer
);
4553 opoint_byte
= PT_BYTE
;
4554 old_read_only
= current_buffer
->read_only
;
4557 old_begv_byte
= BEGV_BYTE
;
4558 old_zv_byte
= ZV_BYTE
;
4560 current_buffer
->read_only
= Qnil
;
4562 /* Insert new output into buffer
4563 at the current end-of-output marker,
4564 thus preserving logical ordering of input and output. */
4565 if (XMARKER (p
->mark
)->buffer
)
4566 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
4567 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
4570 SET_PT_BOTH (ZV
, ZV_BYTE
);
4572 before_byte
= PT_BYTE
;
4574 /* If the output marker is outside of the visible region, save
4575 the restriction and widen. */
4576 if (! (BEGV
<= PT
&& PT
<= ZV
))
4579 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
4581 Vlast_coding_system_used
= coding
->symbol
;
4582 /* A new coding system might be found. See the comment in the
4583 similar code in the previous `if' block. */
4584 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
4586 p
->decode_coding_system
= coding
->symbol
;
4587 if (NILP (p
->encode_coding_system
)
4588 && proc_encode_coding_system
[XINT (p
->outfd
)])
4590 p
->encode_coding_system
= coding
->symbol
;
4591 setup_coding_system (coding
->symbol
,
4592 proc_encode_coding_system
[XINT (p
->outfd
)]);
4595 carryover
= nbytes
- coding
->consumed
;
4596 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
4598 XSETINT (p
->decoding_carryover
, carryover
);
4599 /* Adjust the multibyteness of TEXT to that of the buffer. */
4600 if (NILP (current_buffer
->enable_multibyte_characters
)
4601 != ! STRING_MULTIBYTE (text
))
4602 text
= (STRING_MULTIBYTE (text
)
4603 ? Fstring_as_unibyte (text
)
4604 : Fstring_as_multibyte (text
));
4605 nbytes
= SBYTES (text
);
4606 nchars
= SCHARS (text
);
4607 /* Insert before markers in case we are inserting where
4608 the buffer's mark is, and the user's next command is Meta-y. */
4609 insert_from_string_before_markers (text
, 0, 0, nchars
, nbytes
, 0);
4611 /* Make sure the process marker's position is valid when the
4612 process buffer is changed in the signal_after_change above.
4613 W3 is known to do that. */
4614 if (BUFFERP (p
->buffer
)
4615 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
4616 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
4618 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
4620 update_mode_lines
++;
4622 /* Make sure opoint and the old restrictions
4623 float ahead of any new text just as point would. */
4624 if (opoint
>= before
)
4626 opoint
+= PT
- before
;
4627 opoint_byte
+= PT_BYTE
- before_byte
;
4629 if (old_begv
> before
)
4631 old_begv
+= PT
- before
;
4632 old_begv_byte
+= PT_BYTE
- before_byte
;
4634 if (old_zv
>= before
)
4636 old_zv
+= PT
- before
;
4637 old_zv_byte
+= PT_BYTE
- before_byte
;
4640 /* If the restriction isn't what it should be, set it. */
4641 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
4642 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
4644 /* Handling the process output should not deactivate the mark. */
4645 Vdeactivate_mark
= odeactivate
;
4647 current_buffer
->read_only
= old_read_only
;
4648 SET_PT_BOTH (opoint
, opoint_byte
);
4649 set_buffer_internal (old
);
4652 start_vms_process_read (vs
);
4657 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
4659 doc
: /* Returns non-nil if emacs is waiting for input from the user.
4660 This is intended for use by asynchronous process output filters and sentinels. */)
4663 return (waiting_for_user_input_p
? Qt
: Qnil
);
4666 /* Sending data to subprocess */
4668 jmp_buf send_process_frame
;
4669 Lisp_Object process_sent_to
;
4672 send_process_trap ()
4678 longjmp (send_process_frame
, 1);
4681 /* Send some data to process PROC.
4682 BUF is the beginning of the data; LEN is the number of characters.
4683 OBJECT is the Lisp object that the data comes from. If OBJECT is
4684 nil or t, it means that the data comes from C string.
4686 If OBJECT is not nil, the data is encoded by PROC's coding-system
4687 for encoding before it is sent.
4689 This function can evaluate Lisp code and can garbage collect. */
4692 send_process (proc
, buf
, len
, object
)
4693 volatile Lisp_Object proc
;
4694 unsigned char *volatile buf
;
4696 volatile Lisp_Object object
;
4698 /* Use volatile to protect variables from being clobbered by longjmp. */
4700 struct coding_system
*coding
;
4701 struct gcpro gcpro1
;
4706 struct Lisp_Process
*p
= XPROCESS (proc
);
4707 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4710 if (! NILP (XPROCESS (proc
)->raw_status_low
))
4711 update_status (XPROCESS (proc
));
4712 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
4713 error ("Process %s not running",
4714 SDATA (XPROCESS (proc
)->name
));
4715 if (XINT (XPROCESS (proc
)->outfd
) < 0)
4716 error ("Output file descriptor of %s is closed",
4717 SDATA (XPROCESS (proc
)->name
));
4719 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
4720 Vlast_coding_system_used
= coding
->symbol
;
4722 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
4723 || (BUFFERP (object
)
4724 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
4727 if (!EQ (coding
->symbol
, XPROCESS (proc
)->encode_coding_system
))
4728 /* The coding system for encoding was changed to raw-text
4729 because we sent a unibyte text previously. Now we are
4730 sending a multibyte text, thus we must encode it by the
4731 original coding system specified for the current
4733 setup_coding_system (XPROCESS (proc
)->encode_coding_system
, coding
);
4734 /* src_multibyte should be set to 1 _after_ a call to
4735 setup_coding_system, since it resets src_multibyte to
4737 coding
->src_multibyte
= 1;
4741 /* For sending a unibyte text, character code conversion should
4742 not take place but EOL conversion should. So, setup raw-text
4743 or one of the subsidiary if we have not yet done it. */
4744 if (coding
->type
!= coding_type_raw_text
)
4746 if (CODING_REQUIRE_FLUSHING (coding
))
4748 /* But, before changing the coding, we must flush out data. */
4749 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4750 send_process (proc
, "", 0, Qt
);
4752 coding
->src_multibyte
= 0;
4753 setup_raw_text_coding_system (coding
);
4756 coding
->dst_multibyte
= 0;
4758 if (CODING_REQUIRE_ENCODING (coding
))
4760 int require
= encoding_buffer_size (coding
, len
);
4761 int from_byte
= -1, from
= -1, to
= -1;
4762 unsigned char *temp_buf
= NULL
;
4764 if (BUFFERP (object
))
4766 from_byte
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
4767 from
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
);
4768 to
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
+ len
);
4770 else if (STRINGP (object
))
4772 from_byte
= buf
- SDATA (object
);
4773 from
= string_byte_to_char (object
, from_byte
);
4774 to
= string_byte_to_char (object
, from_byte
+ len
);
4777 if (coding
->composing
!= COMPOSITION_DISABLED
)
4780 coding_save_composition (coding
, from
, to
, object
);
4782 coding
->composing
= COMPOSITION_DISABLED
;
4785 if (SBYTES (XPROCESS (proc
)->encoding_buf
) < require
)
4786 XPROCESS (proc
)->encoding_buf
= make_uninit_string (require
);
4789 buf
= (BUFFERP (object
)
4790 ? BUF_BYTE_ADDRESS (XBUFFER (object
), from_byte
)
4791 : SDATA (object
) + from_byte
);
4793 object
= XPROCESS (proc
)->encoding_buf
;
4794 encode_coding (coding
, (char *) buf
, SDATA (object
),
4795 len
, SBYTES (object
));
4796 len
= coding
->produced
;
4797 buf
= SDATA (object
);
4803 vs
= get_vms_process_pointer (p
->pid
);
4805 error ("Could not find this process: %x", p
->pid
);
4806 else if (write_to_vms_process (vs
, buf
, len
))
4810 if (pty_max_bytes
== 0)
4812 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
4813 pty_max_bytes
= fpathconf (XFASTINT (XPROCESS (proc
)->outfd
),
4815 if (pty_max_bytes
< 0)
4816 pty_max_bytes
= 250;
4818 pty_max_bytes
= 250;
4820 /* Deduct one, to leave space for the eof. */
4824 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
4825 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
4826 when returning with longjmp despite being declared volatile. */
4827 if (!setjmp (send_process_frame
))
4829 process_sent_to
= proc
;
4833 SIGTYPE (*old_sigpipe
)();
4835 /* Decide how much data we can send in one batch.
4836 Long lines need to be split into multiple batches. */
4837 if (!NILP (XPROCESS (proc
)->pty_flag
))
4839 /* Starting this at zero is always correct when not the first
4840 iteration because the previous iteration ended by sending C-d.
4841 It may not be correct for the first iteration
4842 if a partial line was sent in a separate send_process call.
4843 If that proves worth handling, we need to save linepos
4844 in the process object. */
4846 unsigned char *ptr
= (unsigned char *) buf
;
4847 unsigned char *end
= (unsigned char *) buf
+ len
;
4849 /* Scan through this text for a line that is too long. */
4850 while (ptr
!= end
&& linepos
< pty_max_bytes
)
4858 /* If we found one, break the line there
4859 and put in a C-d to force the buffer through. */
4863 /* Send this batch, using one or more write calls. */
4866 int outfd
= XINT (XPROCESS (proc
)->outfd
);
4867 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
4868 #ifdef DATAGRAM_SOCKETS
4869 if (DATAGRAM_CHAN_P (outfd
))
4871 rv
= sendto (outfd
, (char *) buf
, this,
4872 0, datagram_address
[outfd
].sa
,
4873 datagram_address
[outfd
].len
);
4874 if (rv
< 0 && errno
== EMSGSIZE
)
4875 report_file_error ("sending datagram", Fcons (proc
, Qnil
));
4879 rv
= emacs_write (outfd
, (char *) buf
, this);
4880 signal (SIGPIPE
, old_sigpipe
);
4886 || errno
== EWOULDBLOCK
4892 /* Buffer is full. Wait, accepting input;
4893 that may allow the program
4894 to finish doing output and read more. */
4899 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
4900 /* A gross hack to work around a bug in FreeBSD.
4901 In the following sequence, read(2) returns
4905 write(2) 954 bytes, get EAGAIN
4906 read(2) 1024 bytes in process_read_output
4907 read(2) 11 bytes in process_read_output
4909 That is, read(2) returns more bytes than have
4910 ever been written successfully. The 1033 bytes
4911 read are the 1022 bytes written successfully
4912 after processing (for example with CRs added if
4913 the terminal is set up that way which it is
4914 here). The same bytes will be seen again in a
4915 later read(2), without the CRs. */
4917 if (errno
== EAGAIN
)
4920 ioctl (XINT (XPROCESS (proc
)->outfd
), TIOCFLUSH
,
4923 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
4925 /* Running filters might relocate buffers or strings.
4926 Arrange to relocate BUF. */
4927 if (BUFFERP (object
))
4928 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
4929 else if (STRINGP (object
))
4930 offset
= buf
- SDATA (object
);
4932 XSETFASTINT (zero
, 0);
4933 #ifdef EMACS_HAS_USECS
4934 wait_reading_process_input (0, 20000, zero
, 0);
4936 wait_reading_process_input (1, 0, zero
, 0);
4939 if (BUFFERP (object
))
4940 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
4941 else if (STRINGP (object
))
4942 buf
= offset
+ SDATA (object
);
4947 /* This is a real error. */
4948 report_file_error ("writing to process", Fcons (proc
, Qnil
));
4955 /* If we sent just part of the string, put in an EOF
4956 to force it through, before we send the rest. */
4958 Fprocess_send_eof (proc
);
4961 #endif /* not VMS */
4965 proc
= process_sent_to
;
4967 XPROCESS (proc
)->raw_status_low
= Qnil
;
4968 XPROCESS (proc
)->raw_status_high
= Qnil
;
4969 XPROCESS (proc
)->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4970 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4971 deactivate_process (proc
);
4973 error ("Error writing to process %s; closed it",
4974 SDATA (XPROCESS (proc
)->name
));
4976 error ("SIGPIPE raised on process %s; closed it",
4977 SDATA (XPROCESS (proc
)->name
));
4984 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
4986 doc
: /* Send current contents of region as input to PROCESS.
4987 PROCESS may be a process, a buffer, the name of a process or buffer, or
4988 nil, indicating the current buffer's process.
4989 Called from program, takes three arguments, PROCESS, START and END.
4990 If the region is more than 500 characters long,
4991 it is sent in several bunches. This may happen even for shorter regions.
4992 Output from processes can arrive in between bunches. */)
4993 (process
, start
, end
)
4994 Lisp_Object process
, start
, end
;
4999 proc
= get_process (process
);
5000 validate_region (&start
, &end
);
5002 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5003 move_gap (XINT (start
));
5005 start1
= CHAR_TO_BYTE (XINT (start
));
5006 end1
= CHAR_TO_BYTE (XINT (end
));
5007 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5008 Fcurrent_buffer ());
5013 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5015 doc
: /* Send PROCESS the contents of STRING as input.
5016 PROCESS may be a process, a buffer, the name of a process or buffer, or
5017 nil, indicating the current buffer's process.
5018 If STRING is more than 500 characters long,
5019 it is sent in several bunches. This may happen even for shorter strings.
5020 Output from processes can arrive in between bunches. */)
5022 Lisp_Object process
, string
;
5025 CHECK_STRING (string
);
5026 proc
= get_process (process
);
5027 send_process (proc
, SDATA (string
),
5028 SBYTES (string
), string
);
5032 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5033 Sprocess_running_child_p
, 0, 1, 0,
5034 doc
: /* Return t if PROCESS has given the terminal to a child.
5035 If the operating system does not make it possible to find out,
5036 return t unconditionally. */)
5038 Lisp_Object process
;
5040 /* Initialize in case ioctl doesn't exist or gives an error,
5041 in a way that will cause returning t. */
5044 struct Lisp_Process
*p
;
5046 proc
= get_process (process
);
5047 p
= XPROCESS (proc
);
5049 if (!EQ (p
->childp
, Qt
))
5050 error ("Process %s is not a subprocess",
5052 if (XINT (p
->infd
) < 0)
5053 error ("Process %s is not active",
5057 if (!NILP (p
->subtty
))
5058 ioctl (XFASTINT (p
->subtty
), TIOCGPGRP
, &gid
);
5060 ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
);
5061 #endif /* defined (TIOCGPGRP ) */
5063 if (gid
== XFASTINT (p
->pid
))
5068 /* send a signal number SIGNO to PROCESS.
5069 If CURRENT_GROUP is t, that means send to the process group
5070 that currently owns the terminal being used to communicate with PROCESS.
5071 This is used for various commands in shell mode.
5072 If CURRENT_GROUP is lambda, that means send to the process group
5073 that currently owns the terminal, but only if it is NOT the shell itself.
5075 If NOMSG is zero, insert signal-announcements into process's buffers
5078 If we can, we try to signal PROCESS by sending control characters
5079 down the pty. This allows us to signal inferiors who have changed
5080 their uid, for which killpg would return an EPERM error. */
5083 process_send_signal (process
, signo
, current_group
, nomsg
)
5084 Lisp_Object process
;
5086 Lisp_Object current_group
;
5090 register struct Lisp_Process
*p
;
5094 proc
= get_process (process
);
5095 p
= XPROCESS (proc
);
5097 if (!EQ (p
->childp
, Qt
))
5098 error ("Process %s is not a subprocess",
5100 if (XINT (p
->infd
) < 0)
5101 error ("Process %s is not active",
5104 if (NILP (p
->pty_flag
))
5105 current_group
= Qnil
;
5107 /* If we are using pgrps, get a pgrp number and make it negative. */
5108 if (NILP (current_group
))
5109 /* Send the signal to the shell's process group. */
5110 gid
= XFASTINT (p
->pid
);
5113 #ifdef SIGNALS_VIA_CHARACTERS
5114 /* If possible, send signals to the entire pgrp
5115 by sending an input character to it. */
5117 /* TERMIOS is the latest and bestest, and seems most likely to
5118 work. If the system has it, use it. */
5125 tcgetattr (XINT (p
->infd
), &t
);
5126 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5130 tcgetattr (XINT (p
->infd
), &t
);
5131 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5135 tcgetattr (XINT (p
->infd
), &t
);
5136 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5137 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5139 send_process (proc
, &t
.c_cc
[VSUSP
], 1, Qnil
);
5144 #else /* ! HAVE_TERMIOS */
5146 /* On Berkeley descendants, the following IOCTL's retrieve the
5147 current control characters. */
5148 #if defined (TIOCGLTC) && defined (TIOCGETC)
5156 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5157 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5160 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5161 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5165 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5166 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5168 #endif /* ! defined (SIGTSTP) */
5171 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5173 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5180 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5181 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5184 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5185 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5189 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5190 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5192 #endif /* ! defined (SIGTSTP) */
5194 #else /* ! defined (TCGETA) */
5195 Your configuration files are messed up
.
5196 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5197 you'd better be using one of the alternatives above! */
5198 #endif /* ! defined (TCGETA) */
5199 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5200 #endif /* ! defined HAVE_TERMIOS */
5202 /* The code above always returns from the function. */
5203 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5206 /* Get the current pgrp using the tty itself, if we have that.
5207 Otherwise, use the pty to get the pgrp.
5208 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5209 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5210 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5211 His patch indicates that if TIOCGPGRP returns an error, then
5212 we should just assume that p->pid is also the process group id. */
5216 if (!NILP (p
->subtty
))
5217 err
= ioctl (XFASTINT (p
->subtty
), TIOCGPGRP
, &gid
);
5219 err
= ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
);
5222 /* If we can't get the information, assume
5223 the shell owns the tty. */
5224 gid
= XFASTINT (p
->pid
);
5227 /* It is not clear whether anything really can set GID to -1.
5228 Perhaps on some system one of those ioctls can or could do so.
5229 Or perhaps this is vestigial. */
5232 #else /* ! defined (TIOCGPGRP ) */
5233 /* Can't select pgrps on this system, so we know that
5234 the child itself heads the pgrp. */
5235 gid
= XFASTINT (p
->pid
);
5236 #endif /* ! defined (TIOCGPGRP ) */
5238 /* If current_group is lambda, and the shell owns the terminal,
5239 don't send any signal. */
5240 if (EQ (current_group
, Qlambda
) && gid
== XFASTINT (p
->pid
))
5248 p
->raw_status_low
= Qnil
;
5249 p
->raw_status_high
= Qnil
;
5251 XSETINT (p
->tick
, ++process_tick
);
5255 #endif /* ! defined (SIGCONT) */
5258 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5263 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5268 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
5271 flush_pending_output (XINT (p
->infd
));
5275 /* If we don't have process groups, send the signal to the immediate
5276 subprocess. That isn't really right, but it's better than any
5277 obvious alternative. */
5280 kill (XFASTINT (p
->pid
), signo
);
5284 /* gid may be a pid, or minus a pgrp's number */
5286 if (!NILP (current_group
))
5287 ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
);
5290 gid
= - XFASTINT (p
->pid
);
5293 #else /* ! defined (TIOCSIGSEND) */
5294 EMACS_KILLPG (gid
, signo
);
5295 #endif /* ! defined (TIOCSIGSEND) */
5298 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5299 doc
: /* Interrupt process PROCESS.
5300 PROCESS may be a process, a buffer, or the name of a process or buffer.
5301 nil or no arg means current buffer's process.
5302 Second arg CURRENT-GROUP non-nil means send signal to
5303 the current process-group of the process's controlling terminal
5304 rather than to the process's own process group.
5305 If the process is a shell, this means interrupt current subjob
5306 rather than the shell.
5308 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5309 don't send the signal. */)
5310 (process
, current_group
)
5311 Lisp_Object process
, current_group
;
5313 process_send_signal (process
, SIGINT
, current_group
, 0);
5317 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5318 doc
: /* Kill process PROCESS. May be process or name of one.
5319 See function `interrupt-process' for more details on usage. */)
5320 (process
, current_group
)
5321 Lisp_Object process
, current_group
;
5323 process_send_signal (process
, SIGKILL
, current_group
, 0);
5327 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5328 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5329 See function `interrupt-process' for more details on usage. */)
5330 (process
, current_group
)
5331 Lisp_Object process
, current_group
;
5333 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5337 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5338 doc
: /* Stop process PROCESS. May be process or name of one.
5339 See function `interrupt-process' for more details on usage.
5340 If PROCESS is a network process, inhibit handling of incoming traffic. */)
5341 (process
, current_group
)
5342 Lisp_Object process
, current_group
;
5345 if (PROCESSP (process
) && NETCONN_P (process
))
5347 struct Lisp_Process
*p
;
5349 p
= XPROCESS (process
);
5350 if (NILP (p
->command
)
5351 && XINT (p
->infd
) >= 0)
5353 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5354 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5361 error ("no SIGTSTP support");
5363 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5368 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
5369 doc
: /* Continue process PROCESS. May be process or name of one.
5370 See function `interrupt-process' for more details on usage.
5371 If PROCESS is a network process, resume handling of incoming traffic. */)
5372 (process
, current_group
)
5373 Lisp_Object process
, current_group
;
5376 if (PROCESSP (process
) && NETCONN_P (process
))
5378 struct Lisp_Process
*p
;
5380 p
= XPROCESS (process
);
5381 if (EQ (p
->command
, Qt
)
5382 && XINT (p
->infd
) >= 0
5383 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
5385 FD_SET (XINT (p
->infd
), &input_wait_mask
);
5386 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
5393 process_send_signal (process
, SIGCONT
, current_group
, 0);
5395 error ("no SIGCONT support");
5400 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
5401 2, 2, "sProcess (name or number): \nnSignal code: ",
5402 doc
: /* Send PROCESS the signal with code SIGCODE.
5403 PROCESS may also be an integer specifying the process id of the
5404 process to signal; in this case, the process need not be a child of
5406 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
5408 Lisp_Object process
, sigcode
;
5412 if (INTEGERP (process
))
5418 if (STRINGP (process
))
5421 if (tem
= Fget_process (process
), NILP (tem
))
5423 pid
= Fstring_to_number (process
, make_number (10));
5424 if (XINT (pid
) != 0)
5430 process
= get_process (process
);
5435 CHECK_PROCESS (process
);
5436 pid
= XPROCESS (process
)->pid
;
5437 if (!INTEGERP (pid
) || XINT (pid
) <= 0)
5438 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
5442 #define handle_signal(NAME, VALUE) \
5443 else if (!strcmp (name, NAME)) \
5444 XSETINT (sigcode, VALUE)
5446 if (INTEGERP (sigcode
))
5450 unsigned char *name
;
5452 CHECK_SYMBOL (sigcode
);
5453 name
= SDATA (SYMBOL_NAME (sigcode
));
5458 handle_signal ("SIGHUP", SIGHUP
);
5461 handle_signal ("SIGINT", SIGINT
);
5464 handle_signal ("SIGQUIT", SIGQUIT
);
5467 handle_signal ("SIGILL", SIGILL
);
5470 handle_signal ("SIGABRT", SIGABRT
);
5473 handle_signal ("SIGEMT", SIGEMT
);
5476 handle_signal ("SIGKILL", SIGKILL
);
5479 handle_signal ("SIGFPE", SIGFPE
);
5482 handle_signal ("SIGBUS", SIGBUS
);
5485 handle_signal ("SIGSEGV", SIGSEGV
);
5488 handle_signal ("SIGSYS", SIGSYS
);
5491 handle_signal ("SIGPIPE", SIGPIPE
);
5494 handle_signal ("SIGALRM", SIGALRM
);
5497 handle_signal ("SIGTERM", SIGTERM
);
5500 handle_signal ("SIGURG", SIGURG
);
5503 handle_signal ("SIGSTOP", SIGSTOP
);
5506 handle_signal ("SIGTSTP", SIGTSTP
);
5509 handle_signal ("SIGCONT", SIGCONT
);
5512 handle_signal ("SIGCHLD", SIGCHLD
);
5515 handle_signal ("SIGTTIN", SIGTTIN
);
5518 handle_signal ("SIGTTOU", SIGTTOU
);
5521 handle_signal ("SIGIO", SIGIO
);
5524 handle_signal ("SIGXCPU", SIGXCPU
);
5527 handle_signal ("SIGXFSZ", SIGXFSZ
);
5530 handle_signal ("SIGVTALRM", SIGVTALRM
);
5533 handle_signal ("SIGPROF", SIGPROF
);
5536 handle_signal ("SIGWINCH", SIGWINCH
);
5539 handle_signal ("SIGINFO", SIGINFO
);
5542 handle_signal ("SIGUSR1", SIGUSR1
);
5545 handle_signal ("SIGUSR2", SIGUSR2
);
5548 error ("Undefined signal name %s", name
);
5551 #undef handle_signal
5553 return make_number (kill (XINT (pid
), XINT (sigcode
)));
5556 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
5557 doc
: /* Make PROCESS see end-of-file in its input.
5558 EOF comes after any text already sent to it.
5559 PROCESS may be a process, a buffer, the name of a process or buffer, or
5560 nil, indicating the current buffer's process.
5561 If PROCESS is a network connection, or is a process communicating
5562 through a pipe (as opposed to a pty), then you cannot send any more
5563 text to PROCESS after you call this function. */)
5565 Lisp_Object process
;
5568 struct coding_system
*coding
;
5570 if (DATAGRAM_CONN_P (process
))
5573 proc
= get_process (process
);
5574 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
5576 /* Make sure the process is really alive. */
5577 if (! NILP (XPROCESS (proc
)->raw_status_low
))
5578 update_status (XPROCESS (proc
));
5579 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
5580 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
5582 if (CODING_REQUIRE_FLUSHING (coding
))
5584 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5585 send_process (proc
, "", 0, Qnil
);
5589 send_process (proc
, "\032", 1, Qnil
); /* ^z */
5591 if (!NILP (XPROCESS (proc
)->pty_flag
))
5592 send_process (proc
, "\004", 1, Qnil
);
5595 int old_outfd
, new_outfd
;
5597 #ifdef HAVE_SHUTDOWN
5598 /* If this is a network connection, or socketpair is used
5599 for communication with the subprocess, call shutdown to cause EOF.
5600 (In some old system, shutdown to socketpair doesn't work.
5601 Then we just can't win.) */
5602 if (NILP (XPROCESS (proc
)->pid
)
5603 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
5604 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
5605 /* In case of socketpair, outfd == infd, so don't close it. */
5606 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
5607 emacs_close (XINT (XPROCESS (proc
)->outfd
));
5608 #else /* not HAVE_SHUTDOWN */
5609 emacs_close (XINT (XPROCESS (proc
)->outfd
));
5610 #endif /* not HAVE_SHUTDOWN */
5611 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
5612 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
5614 if (!proc_encode_coding_system
[new_outfd
])
5615 proc_encode_coding_system
[new_outfd
]
5616 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
5617 bcopy (proc_encode_coding_system
[old_outfd
],
5618 proc_encode_coding_system
[new_outfd
],
5619 sizeof (struct coding_system
));
5620 bzero (proc_encode_coding_system
[old_outfd
],
5621 sizeof (struct coding_system
));
5623 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
5629 /* Kill all processes associated with `buffer'.
5630 If `buffer' is nil, kill all processes */
5633 kill_buffer_processes (buffer
)
5636 Lisp_Object tail
, proc
;
5638 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5640 proc
= XCDR (XCAR (tail
));
5641 if (GC_PROCESSP (proc
)
5642 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
5644 if (NETCONN_P (proc
))
5645 Fdelete_process (proc
);
5646 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
5647 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
5652 /* On receipt of a signal that a child status has changed, loop asking
5653 about children with changed statuses until the system says there
5656 All we do is change the status; we do not run sentinels or print
5657 notifications. That is saved for the next time keyboard input is
5658 done, in order to avoid timing errors.
5660 ** WARNING: this can be called during garbage collection.
5661 Therefore, it must not be fooled by the presence of mark bits in
5664 ** USG WARNING: Although it is not obvious from the documentation
5665 in signal(2), on a USG system the SIGCLD handler MUST NOT call
5666 signal() before executing at least one wait(), otherwise the
5667 handler will be called again, resulting in an infinite loop. The
5668 relevant portion of the documentation reads "SIGCLD signals will be
5669 queued and the signal-catching function will be continually
5670 reentered until the queue is empty". Invoking signal() causes the
5671 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
5675 sigchld_handler (signo
)
5678 int old_errno
= errno
;
5680 register struct Lisp_Process
*p
;
5681 extern EMACS_TIME
*input_available_clear_time
;
5685 sigheld
|= sigbit (SIGCHLD
);
5697 #endif /* no WUNTRACED */
5698 /* Keep trying to get a status until we get a definitive result. */
5702 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
5704 while (pid
< 0 && errno
== EINTR
);
5708 /* PID == 0 means no processes found, PID == -1 means a real
5709 failure. We have done all our job, so return. */
5711 /* USG systems forget handlers when they are used;
5712 must reestablish each time */
5713 #if defined (USG) && !defined (POSIX_SIGNALS)
5714 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
5717 sigheld
&= ~sigbit (SIGCHLD
);
5725 #endif /* no WNOHANG */
5727 /* Find the process that signaled us, and record its status. */
5730 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5732 proc
= XCDR (XCAR (tail
));
5733 p
= XPROCESS (proc
);
5734 if (GC_EQ (p
->childp
, Qt
) && XINT (p
->pid
) == pid
)
5739 /* Look for an asynchronous process whose pid hasn't been filled
5742 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5744 proc
= XCDR (XCAR (tail
));
5745 p
= XPROCESS (proc
);
5746 if (GC_INTEGERP (p
->pid
) && XINT (p
->pid
) == -1)
5751 /* Change the status of the process that was found. */
5754 union { int i
; WAITTYPE wt
; } u
;
5755 int clear_desc_flag
= 0;
5757 XSETINT (p
->tick
, ++process_tick
);
5759 XSETINT (p
->raw_status_low
, u
.i
& 0xffff);
5760 XSETINT (p
->raw_status_high
, u
.i
>> 16);
5762 /* If process has terminated, stop waiting for its output. */
5763 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
5764 && XINT (p
->infd
) >= 0)
5765 clear_desc_flag
= 1;
5767 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
5768 if (clear_desc_flag
)
5770 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5771 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5774 /* Tell wait_reading_process_input that it needs to wake up and
5776 if (input_available_clear_time
)
5777 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
5780 /* There was no asynchronous process found for that id. Check
5781 if we have a synchronous process. */
5784 synch_process_alive
= 0;
5786 /* Report the status of the synchronous process. */
5788 synch_process_retcode
= WRETCODE (w
);
5789 else if (WIFSIGNALED (w
))
5791 int code
= WTERMSIG (w
);
5794 synchronize_system_messages_locale ();
5795 signame
= strsignal (code
);
5798 signame
= "unknown";
5800 synch_process_death
= signame
;
5803 /* Tell wait_reading_process_input that it needs to wake up and
5805 if (input_available_clear_time
)
5806 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
5809 /* On some systems, we must return right away.
5810 If any more processes want to signal us, we will
5812 Otherwise (on systems that have WNOHANG), loop around
5813 to use up all the processes that have something to tell us. */
5814 #if (defined WINDOWSNT \
5815 || (defined USG && !defined GNU_LINUX \
5816 && !(defined HPUX && defined WNOHANG)))
5817 #if defined (USG) && ! defined (POSIX_SIGNALS)
5818 signal (signo
, sigchld_handler
);
5822 #endif /* USG, but not HPUX with WNOHANG */
5828 exec_sentinel_unwind (data
)
5831 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
5836 exec_sentinel_error_handler (error
)
5839 cmd_error_internal (error
, "error in process sentinel: ");
5841 update_echo_area ();
5842 Fsleep_for (make_number (2), Qnil
);
5847 exec_sentinel (proc
, reason
)
5848 Lisp_Object proc
, reason
;
5850 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
5851 register struct Lisp_Process
*p
= XPROCESS (proc
);
5852 int count
= SPECPDL_INDEX ();
5853 int outer_running_asynch_code
= running_asynch_code
;
5854 int waiting
= waiting_for_user_input_p
;
5856 /* No need to gcpro these, because all we do with them later
5857 is test them for EQness, and none of them should be a string. */
5858 odeactivate
= Vdeactivate_mark
;
5859 XSETBUFFER (obuffer
, current_buffer
);
5860 okeymap
= current_buffer
->keymap
;
5862 sentinel
= p
->sentinel
;
5863 if (NILP (sentinel
))
5866 /* Zilch the sentinel while it's running, to avoid recursive invocations;
5867 assure that it gets restored no matter how the sentinel exits. */
5869 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
5870 /* Inhibit quit so that random quits don't screw up a running filter. */
5871 specbind (Qinhibit_quit
, Qt
);
5872 specbind (Qlast_nonmenu_event
, Qt
);
5874 /* In case we get recursively called,
5875 and we already saved the match data nonrecursively,
5876 save the same match data in safely recursive fashion. */
5877 if (outer_running_asynch_code
)
5880 tem
= Fmatch_data (Qnil
, Qnil
);
5881 restore_match_data ();
5882 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
5883 Fset_match_data (tem
);
5886 /* For speed, if a search happens within this code,
5887 save the match data in a special nonrecursive fashion. */
5888 running_asynch_code
= 1;
5890 internal_condition_case_1 (read_process_output_call
,
5892 Fcons (proc
, Fcons (reason
, Qnil
))),
5893 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5894 exec_sentinel_error_handler
);
5896 /* If we saved the match data nonrecursively, restore it now. */
5897 restore_match_data ();
5898 running_asynch_code
= outer_running_asynch_code
;
5900 Vdeactivate_mark
= odeactivate
;
5902 /* Restore waiting_for_user_input_p as it was
5903 when we were called, in case the filter clobbered it. */
5904 waiting_for_user_input_p
= waiting
;
5907 if (! EQ (Fcurrent_buffer (), obuffer
)
5908 || ! EQ (current_buffer
->keymap
, okeymap
))
5910 /* But do it only if the caller is actually going to read events.
5911 Otherwise there's no need to make him wake up, and it could
5912 cause trouble (for example it would make Fsit_for return). */
5913 if (waiting_for_user_input_p
== -1)
5914 record_asynch_buffer_change ();
5916 unbind_to (count
, Qnil
);
5919 /* Report all recent events of a change in process status
5920 (either run the sentinel or output a message).
5921 This is usually done while Emacs is waiting for keyboard input
5922 but can be done at other times. */
5927 register Lisp_Object proc
, buffer
;
5928 Lisp_Object tail
, msg
;
5929 struct gcpro gcpro1
, gcpro2
;
5933 /* We need to gcpro tail; if read_process_output calls a filter
5934 which deletes a process and removes the cons to which tail points
5935 from Vprocess_alist, and then causes a GC, tail is an unprotected
5939 /* Set this now, so that if new processes are created by sentinels
5940 that we run, we get called again to handle their status changes. */
5941 update_tick
= process_tick
;
5943 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
5946 register struct Lisp_Process
*p
;
5948 proc
= Fcdr (Fcar (tail
));
5949 p
= XPROCESS (proc
);
5951 if (XINT (p
->tick
) != XINT (p
->update_tick
))
5953 XSETINT (p
->update_tick
, XINT (p
->tick
));
5955 /* If process is still active, read any output that remains. */
5956 while (! EQ (p
->filter
, Qt
)
5957 && ! EQ (p
->status
, Qconnect
)
5958 && ! EQ (p
->status
, Qlisten
)
5959 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
5960 && XINT (p
->infd
) >= 0
5961 && read_process_output (proc
, XINT (p
->infd
)) > 0);
5965 /* Get the text to use for the message. */
5966 if (!NILP (p
->raw_status_low
))
5968 msg
= status_message (p
->status
);
5970 /* If process is terminated, deactivate it or delete it. */
5972 if (CONSP (p
->status
))
5973 symbol
= XCAR (p
->status
);
5975 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
5976 || EQ (symbol
, Qclosed
))
5978 if (delete_exited_processes
)
5979 remove_process (proc
);
5981 deactivate_process (proc
);
5984 /* The actions above may have further incremented p->tick.
5985 So set p->update_tick again
5986 so that an error in the sentinel will not cause
5987 this code to be run again. */
5988 XSETINT (p
->update_tick
, XINT (p
->tick
));
5989 /* Now output the message suitably. */
5990 if (!NILP (p
->sentinel
))
5991 exec_sentinel (proc
, msg
);
5992 /* Don't bother with a message in the buffer
5993 when a process becomes runnable. */
5994 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
5996 Lisp_Object ro
, tem
;
5997 struct buffer
*old
= current_buffer
;
5998 int opoint
, opoint_byte
;
5999 int before
, before_byte
;
6001 ro
= XBUFFER (buffer
)->read_only
;
6003 /* Avoid error if buffer is deleted
6004 (probably that's why the process is dead, too) */
6005 if (NILP (XBUFFER (buffer
)->name
))
6007 Fset_buffer (buffer
);
6010 opoint_byte
= PT_BYTE
;
6011 /* Insert new output into buffer
6012 at the current end-of-output marker,
6013 thus preserving logical ordering of input and output. */
6014 if (XMARKER (p
->mark
)->buffer
)
6015 Fgoto_char (p
->mark
);
6017 SET_PT_BOTH (ZV
, ZV_BYTE
);
6020 before_byte
= PT_BYTE
;
6022 tem
= current_buffer
->read_only
;
6023 current_buffer
->read_only
= Qnil
;
6024 insert_string ("\nProcess ");
6025 Finsert (1, &p
->name
);
6026 insert_string (" ");
6028 current_buffer
->read_only
= tem
;
6029 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6031 if (opoint
>= before
)
6032 SET_PT_BOTH (opoint
+ (PT
- before
),
6033 opoint_byte
+ (PT_BYTE
- before_byte
));
6035 SET_PT_BOTH (opoint
, opoint_byte
);
6037 set_buffer_internal (old
);
6042 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6043 redisplay_preserve_echo_area (13);
6049 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6050 Sset_process_coding_system
, 1, 3, 0,
6051 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6052 DECODING will be used to decode subprocess output and ENCODING to
6053 encode subprocess input. */)
6054 (proc
, decoding
, encoding
)
6055 register Lisp_Object proc
, decoding
, encoding
;
6057 register struct Lisp_Process
*p
;
6059 CHECK_PROCESS (proc
);
6060 p
= XPROCESS (proc
);
6061 if (XINT (p
->infd
) < 0)
6062 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6063 if (XINT (p
->outfd
) < 0)
6064 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6066 p
->decode_coding_system
= Fcheck_coding_system (decoding
);
6067 p
->encode_coding_system
= Fcheck_coding_system (encoding
);
6068 setup_coding_system (decoding
,
6069 proc_decode_coding_system
[XINT (p
->infd
)]);
6070 setup_coding_system (encoding
,
6071 proc_encode_coding_system
[XINT (p
->outfd
)]);
6076 DEFUN ("process-coding-system",
6077 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6078 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6080 register Lisp_Object proc
;
6082 CHECK_PROCESS (proc
);
6083 return Fcons (XPROCESS (proc
)->decode_coding_system
,
6084 XPROCESS (proc
)->encode_coding_system
);
6087 /* The first time this is called, assume keyboard input comes from DESC
6088 instead of from where we used to expect it.
6089 Subsequent calls mean assume input keyboard can come from DESC
6090 in addition to other places. */
6092 static int add_keyboard_wait_descriptor_called_flag
;
6095 add_keyboard_wait_descriptor (desc
)
6098 if (! add_keyboard_wait_descriptor_called_flag
)
6099 FD_CLR (0, &input_wait_mask
);
6100 add_keyboard_wait_descriptor_called_flag
= 1;
6101 FD_SET (desc
, &input_wait_mask
);
6102 FD_SET (desc
, &non_process_wait_mask
);
6103 if (desc
> max_keyboard_desc
)
6104 max_keyboard_desc
= desc
;
6107 /* From now on, do not expect DESC to give keyboard input. */
6110 delete_keyboard_wait_descriptor (desc
)
6114 int lim
= max_keyboard_desc
;
6116 FD_CLR (desc
, &input_wait_mask
);
6117 FD_CLR (desc
, &non_process_wait_mask
);
6119 if (desc
== max_keyboard_desc
)
6120 for (fd
= 0; fd
< lim
; fd
++)
6121 if (FD_ISSET (fd
, &input_wait_mask
)
6122 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6123 max_keyboard_desc
= fd
;
6126 /* Return nonzero if *MASK has a bit set
6127 that corresponds to one of the keyboard input descriptors. */
6130 keyboard_bit_set (mask
)
6135 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6136 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6137 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6150 if (! noninteractive
|| initialized
)
6152 signal (SIGCHLD
, sigchld_handler
);
6155 FD_ZERO (&input_wait_mask
);
6156 FD_ZERO (&non_keyboard_wait_mask
);
6157 FD_ZERO (&non_process_wait_mask
);
6158 max_process_desc
= 0;
6160 FD_SET (0, &input_wait_mask
);
6162 Vprocess_alist
= Qnil
;
6163 for (i
= 0; i
< MAXDESC
; i
++)
6165 chan_process
[i
] = Qnil
;
6166 proc_buffered_char
[i
] = -1;
6168 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6169 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6170 #ifdef DATAGRAM_SOCKETS
6171 bzero (datagram_address
, sizeof datagram_address
);
6176 Lisp_Object subfeatures
= Qnil
;
6177 #define ADD_SUBFEATURE(key, val) \
6178 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6180 #ifdef NON_BLOCKING_CONNECT
6181 ADD_SUBFEATURE (QCnowait
, Qt
);
6183 #ifdef DATAGRAM_SOCKETS
6184 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6186 #ifdef HAVE_LOCAL_SOCKETS
6187 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6189 #ifdef HAVE_GETSOCKNAME
6190 ADD_SUBFEATURE (QCservice
, Qt
);
6192 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6193 ADD_SUBFEATURE (QCserver
, Qt
);
6195 #ifdef SO_BINDTODEVICE
6196 ADD_SUBFEATURE (QCoptions
, intern ("bindtodevice"));
6199 ADD_SUBFEATURE (QCoptions
, intern ("broadcast"));
6202 ADD_SUBFEATURE (QCoptions
, intern ("dontroute"));
6205 ADD_SUBFEATURE (QCoptions
, intern ("keepalive"));
6208 ADD_SUBFEATURE (QCoptions
, intern ("linger"));
6211 ADD_SUBFEATURE (QCoptions
, intern ("oobinline"));
6214 ADD_SUBFEATURE (QCoptions
, intern ("priority"));
6217 ADD_SUBFEATURE (QCoptions
, intern ("reuseaddr"));
6219 Fprovide (intern ("make-network-process"), subfeatures
);
6221 #endif /* HAVE_SOCKETS */
6227 Qprocessp
= intern ("processp");
6228 staticpro (&Qprocessp
);
6229 Qrun
= intern ("run");
6231 Qstop
= intern ("stop");
6233 Qsignal
= intern ("signal");
6234 staticpro (&Qsignal
);
6236 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
6239 Qexit = intern ("exit");
6240 staticpro (&Qexit); */
6242 Qopen
= intern ("open");
6244 Qclosed
= intern ("closed");
6245 staticpro (&Qclosed
);
6246 Qconnect
= intern ("connect");
6247 staticpro (&Qconnect
);
6248 Qfailed
= intern ("failed");
6249 staticpro (&Qfailed
);
6250 Qlisten
= intern ("listen");
6251 staticpro (&Qlisten
);
6252 Qlocal
= intern ("local");
6253 staticpro (&Qlocal
);
6254 Qdatagram
= intern ("datagram");
6255 staticpro (&Qdatagram
);
6257 QCname
= intern (":name");
6258 staticpro (&QCname
);
6259 QCbuffer
= intern (":buffer");
6260 staticpro (&QCbuffer
);
6261 QChost
= intern (":host");
6262 staticpro (&QChost
);
6263 QCservice
= intern (":service");
6264 staticpro (&QCservice
);
6265 QCtype
= intern (":type");
6266 staticpro (&QCtype
);
6267 QClocal
= intern (":local");
6268 staticpro (&QClocal
);
6269 QCremote
= intern (":remote");
6270 staticpro (&QCremote
);
6271 QCcoding
= intern (":coding");
6272 staticpro (&QCcoding
);
6273 QCserver
= intern (":server");
6274 staticpro (&QCserver
);
6275 QCnowait
= intern (":nowait");
6276 staticpro (&QCnowait
);
6277 QCsentinel
= intern (":sentinel");
6278 staticpro (&QCsentinel
);
6279 QClog
= intern (":log");
6281 QCnoquery
= intern (":noquery");
6282 staticpro (&QCnoquery
);
6283 QCstop
= intern (":stop");
6284 staticpro (&QCstop
);
6285 QCoptions
= intern (":options");
6286 staticpro (&QCoptions
);
6288 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
6289 staticpro (&Qlast_nonmenu_event
);
6291 staticpro (&Vprocess_alist
);
6293 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
6294 doc
: /* *Non-nil means delete processes immediately when they exit.
6295 nil means don't delete them until `list-processes' is run. */);
6297 delete_exited_processes
= 1;
6299 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
6300 doc
: /* Control type of device used to communicate with subprocesses.
6301 Values are nil to use a pipe, or t or `pty' to use a pty.
6302 The value has no effect if the system has no ptys or if all ptys are busy:
6303 then a pipe is used in any case.
6304 The value takes effect when `start-process' is called. */);
6305 Vprocess_connection_type
= Qt
;
6307 defsubr (&Sprocessp
);
6308 defsubr (&Sget_process
);
6309 defsubr (&Sget_buffer_process
);
6310 defsubr (&Sdelete_process
);
6311 defsubr (&Sprocess_status
);
6312 defsubr (&Sprocess_exit_status
);
6313 defsubr (&Sprocess_id
);
6314 defsubr (&Sprocess_name
);
6315 defsubr (&Sprocess_tty_name
);
6316 defsubr (&Sprocess_command
);
6317 defsubr (&Sset_process_buffer
);
6318 defsubr (&Sprocess_buffer
);
6319 defsubr (&Sprocess_mark
);
6320 defsubr (&Sset_process_filter
);
6321 defsubr (&Sprocess_filter
);
6322 defsubr (&Sset_process_sentinel
);
6323 defsubr (&Sprocess_sentinel
);
6324 defsubr (&Sset_process_window_size
);
6325 defsubr (&Sset_process_inherit_coding_system_flag
);
6326 defsubr (&Sprocess_inherit_coding_system_flag
);
6327 defsubr (&Sset_process_query_on_exit_flag
);
6328 defsubr (&Sprocess_query_on_exit_flag
);
6329 defsubr (&Sprocess_contact
);
6330 defsubr (&Slist_processes
);
6331 defsubr (&Sprocess_list
);
6332 defsubr (&Sstart_process
);
6334 defsubr (&Sset_network_process_options
);
6335 defsubr (&Smake_network_process
);
6336 defsubr (&Sformat_network_address
);
6337 #endif /* HAVE_SOCKETS */
6338 #ifdef DATAGRAM_SOCKETS
6339 defsubr (&Sprocess_datagram_address
);
6340 defsubr (&Sset_process_datagram_address
);
6342 defsubr (&Saccept_process_output
);
6343 defsubr (&Sprocess_send_region
);
6344 defsubr (&Sprocess_send_string
);
6345 defsubr (&Sinterrupt_process
);
6346 defsubr (&Skill_process
);
6347 defsubr (&Squit_process
);
6348 defsubr (&Sstop_process
);
6349 defsubr (&Scontinue_process
);
6350 defsubr (&Sprocess_running_child_p
);
6351 defsubr (&Sprocess_send_eof
);
6352 defsubr (&Ssignal_process
);
6353 defsubr (&Swaiting_for_user_input_p
);
6354 /* defsubr (&Sprocess_connection); */
6355 defsubr (&Sset_process_coding_system
);
6356 defsubr (&Sprocess_coding_system
);
6360 #else /* not subprocesses */
6362 #include <sys/types.h>
6366 #include "systime.h"
6367 #include "charset.h"
6369 #include "termopts.h"
6370 #include "sysselect.h"
6372 extern int frame_garbaged
;
6374 extern EMACS_TIME
timer_check ();
6375 extern int timers_run
;
6379 /* As described above, except assuming that there are no subprocesses:
6381 Wait for timeout to elapse and/or keyboard input to be available.
6384 timeout in seconds, or
6385 zero for no limit, or
6386 -1 means gobble data immediately available but don't wait for any.
6388 read_kbd is a Lisp_Object:
6389 0 to ignore keyboard input, or
6390 1 to return when input is available, or
6391 -1 means caller will actually read the input, so don't throw to
6393 a cons cell, meaning wait until its car is non-nil
6394 (and gobble terminal input into the buffer if any arrives), or
6395 We know that read_kbd will never be a Lisp_Process, since
6396 `subprocesses' isn't defined.
6398 do_display != 0 means redisplay should be done to show subprocess
6399 output that arrives.
6401 Return true iff we received input from any process. */
6404 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
6405 int time_limit
, microsecs
;
6406 Lisp_Object read_kbd
;
6410 EMACS_TIME end_time
, timeout
;
6411 SELECT_TYPE waitchannels
;
6413 /* Either nil or a cons cell, the car of which is of interest and
6414 may be changed outside of this routine. */
6415 Lisp_Object wait_for_cell
= Qnil
;
6417 /* If waiting for non-nil in a cell, record where. */
6418 if (CONSP (read_kbd
))
6420 wait_for_cell
= read_kbd
;
6421 XSETFASTINT (read_kbd
, 0);
6424 /* What does time_limit really mean? */
6425 if (time_limit
|| microsecs
)
6427 EMACS_GET_TIME (end_time
);
6428 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
6429 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
6432 /* Turn off periodic alarms (in case they are in use)
6433 and then turn off any other atimers,
6434 because the select emulator uses alarms. */
6436 turn_on_atimers (0);
6440 int timeout_reduced_for_timers
= 0;
6442 /* If calling from keyboard input, do not quit
6443 since we want to return C-g as an input character.
6444 Otherwise, do pending quit if requested. */
6445 if (XINT (read_kbd
) >= 0)
6448 /* Exit now if the cell we're waiting for became non-nil. */
6449 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6452 /* Compute time from now till when time limit is up */
6453 /* Exit if already run out */
6454 if (time_limit
== -1)
6456 /* -1 specified for timeout means
6457 gobble output available now
6458 but don't wait at all. */
6460 EMACS_SET_SECS_USECS (timeout
, 0, 0);
6462 else if (time_limit
|| microsecs
)
6464 EMACS_GET_TIME (timeout
);
6465 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
6466 if (EMACS_TIME_NEG_P (timeout
))
6471 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
6474 /* If our caller will not immediately handle keyboard events,
6475 run timer events directly.
6476 (Callers that will immediately read keyboard events
6477 call timer_delay on their own.) */
6478 if (NILP (wait_for_cell
))
6480 EMACS_TIME timer_delay
;
6484 int old_timers_run
= timers_run
;
6485 timer_delay
= timer_check (1);
6486 if (timers_run
!= old_timers_run
&& do_display
)
6487 /* We must retry, since a timer may have requeued itself
6488 and that could alter the time delay. */
6489 redisplay_preserve_echo_area (14);
6493 while (!detect_input_pending ());
6495 /* If there is unread keyboard input, also return. */
6496 if (XINT (read_kbd
) != 0
6497 && requeued_events_pending_p ())
6500 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
6502 EMACS_TIME difference
;
6503 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
6504 if (EMACS_TIME_NEG_P (difference
))
6506 timeout
= timer_delay
;
6507 timeout_reduced_for_timers
= 1;
6512 /* Cause C-g and alarm signals to take immediate action,
6513 and cause input available signals to zero out timeout. */
6514 if (XINT (read_kbd
) < 0)
6515 set_waiting_for_input (&timeout
);
6517 /* Wait till there is something to do. */
6519 if (! XINT (read_kbd
) && NILP (wait_for_cell
))
6520 FD_ZERO (&waitchannels
);
6522 FD_SET (0, &waitchannels
);
6524 /* If a frame has been newly mapped and needs updating,
6525 reprocess its display stuff. */
6526 if (frame_garbaged
&& do_display
)
6528 clear_waiting_for_input ();
6529 redisplay_preserve_echo_area (15);
6530 if (XINT (read_kbd
) < 0)
6531 set_waiting_for_input (&timeout
);
6534 if (XINT (read_kbd
) && detect_input_pending ())
6537 FD_ZERO (&waitchannels
);
6540 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
6545 /* Make C-g and alarm signals set flags again */
6546 clear_waiting_for_input ();
6548 /* If we woke up due to SIGWINCH, actually change size now. */
6549 do_pending_window_change (0);
6551 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
6552 /* We waited the full specified time, so return now. */
6557 /* If the system call was interrupted, then go around the
6559 if (xerrno
== EINTR
)
6560 FD_ZERO (&waitchannels
);
6562 error ("select error: %s", emacs_strerror (xerrno
));
6565 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
6566 /* System sometimes fails to deliver SIGIO. */
6567 kill (getpid (), SIGIO
);
6570 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
6571 kill (getpid (), SIGIO
);
6574 /* Check for keyboard input */
6576 if ((XINT (read_kbd
) != 0)
6577 && detect_input_pending_run_timers (do_display
))
6579 swallow_events (do_display
);
6580 if (detect_input_pending_run_timers (do_display
))
6584 /* If there is unread keyboard input, also return. */
6585 if (XINT (read_kbd
) != 0
6586 && requeued_events_pending_p ())
6589 /* If wait_for_cell. check for keyboard input
6590 but don't run any timers.
6591 ??? (It seems wrong to me to check for keyboard
6592 input at all when wait_for_cell, but the code
6593 has been this way since July 1994.
6594 Try changing this after version 19.31.) */
6595 if (! NILP (wait_for_cell
)
6596 && detect_input_pending ())
6598 swallow_events (do_display
);
6599 if (detect_input_pending ())
6603 /* Exit now if the cell we're waiting for became non-nil. */
6604 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6614 /* Don't confuse make-docfile by having two doc strings for this function.
6615 make-docfile does not pay attention to #if, for good reason! */
6616 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
6619 register Lisp_Object name
;
6624 /* Don't confuse make-docfile by having two doc strings for this function.
6625 make-docfile does not pay attention to #if, for good reason! */
6626 DEFUN ("process-inherit-coding-system-flag",
6627 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
6631 register Lisp_Object process
;
6633 /* Ignore the argument and return the value of
6634 inherit-process-coding-system. */
6635 return inherit_process_coding_system
? Qt
: Qnil
;
6638 /* Kill all processes associated with `buffer'.
6639 If `buffer' is nil, kill all processes.
6640 Since we have no subprocesses, this does nothing. */
6643 kill_buffer_processes (buffer
)
6656 QCtype
= intern (":type");
6657 staticpro (&QCtype
);
6659 defsubr (&Sget_buffer_process
);
6660 defsubr (&Sprocess_inherit_coding_system_flag
);
6664 #endif /* not subprocesses */